From 063602d8732e81bec1ac2673e2499ca84a137305 Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Fri, 13 Jan 2017 13:50:00 +0100 Subject: [PATCH 1/7] wp: more constrained behaviour - restrict to one goal (no fall-through) - apply a wp_pre rule if there is no schematic in the goal - apply trivial cleanup rules at the end --- lib/Monad_WP/wp/WP-method.ML | 111 +++++++++++++++++++++++++---------- lib/Monad_WP/wp/WP.thy | 8 ++- lib/Monad_WP/wp/WPI.thy | 1 - 3 files changed, 87 insertions(+), 33 deletions(-) diff --git a/lib/Monad_WP/wp/WP-method.ML b/lib/Monad_WP/wp/WP-method.ML index 7bc74ec4a..535f0d9cb 100644 --- a/lib/Monad_WP/wp/WP-method.ML +++ b/lib/Monad_WP/wp/WP-method.ML @@ -12,7 +12,8 @@ signature WP = sig type wp_rules = {trips: thm list * (theory -> term -> term), rules: (int * thm) Net.net * int * (int * thm) list, - splits: thm list, combs: thm list, unsafe_rules: thm list}; + splits: thm list, combs: thm list, unsafe_rules: thm list, + wp_pre: thm list}; val debug_get: Proof.context -> wp_rules; @@ -43,6 +44,8 @@ sig val combs_del: Thm.attribute; val wp_unsafe_add: Thm.attribute; val wp_unsafe_del: Thm.attribute; + val wp_pre_add: Thm.attribute; + val wp_pre_del: Thm.attribute; end; structure WeakestPre = @@ -50,7 +53,8 @@ struct type wp_rules = {trips: thm list * (theory -> term -> term), rules: (int * thm) Net.net * int * (int * thm) list, - splits: thm list, combs: thm list, unsafe_rules: thm list}; + splits: thm list, combs: thm list, unsafe_rules: thm list, + wp_pre: thm list}; fun accum_last_occurence' [] _ = ([], Termtab.empty) | accum_last_occurence' ((t, v) :: ts) tt1 = let @@ -107,13 +111,14 @@ fun rules_merge (wp_rules, wp_rules') = let rules = mk_rules trip_conv rules, splits = Thm.merge_thms (#splits wp_rules, #splits wp_rules'), combs = Thm.merge_thms (#combs wp_rules, #combs wp_rules'), - unsafe_rules = Thm.merge_thms (#unsafe_rules wp_rules, #unsafe_rules wp_rules')} end + unsafe_rules = Thm.merge_thms (#unsafe_rules wp_rules, #unsafe_rules wp_rules'), + wp_pre = Thm.merge_thms (#wp_pre wp_rules, #wp_pre wp_rules')} end structure WPData = Generic_Data (struct type T = wp_rules; val empty = {trips = ([], K I), rules = no_rules, - splits = [], combs = [], unsafe_rules = []}; + splits = [], combs = [], unsafe_rules = [], wp_pre = []}; val extend = I; val merge = rules_merge; @@ -142,63 +147,91 @@ fun get_combined_rules rules' combs' = fun add_rule rule rs = {trips = #trips rs, rules = add_rule_inner (snd (#trips rs)) rule (#rules rs), - splits = #splits rs, combs = #combs rs, - unsafe_rules = #unsafe_rules rs}; + splits = #splits rs, + combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = #wp_pre rs + } fun del_rule rule rs = {trips = #trips rs, rules = del_rule_inner (snd (#trips rs)) rule (#rules rs), - splits = #splits rs, combs = #combs rs, - unsafe_rules = #unsafe_rules rs}; + splits = #splits rs, + combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = #wp_pre rs + } fun add_trip rule (rs : wp_rules) = let val trips = Thm.add_thm rule (fst (#trips rs)); val trip_conv = mk_trip_conv trips in {trips = (trips, trip_conv), rules = mk_rules trip_conv (dest_rules (#rules rs)), - splits = #splits rs, combs = #combs rs, - unsafe_rules = #unsafe_rules rs} end; + splits = #splits rs, + combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = #wp_pre rs} + end fun del_trip rule (rs : wp_rules) = let val trips = Thm.del_thm rule (fst (#trips rs)); val trip_conv = mk_trip_conv trips in {trips = (trips, trip_conv), rules = mk_rules trip_conv (dest_rules (#rules rs)), - splits = #splits rs, combs = #combs rs, - unsafe_rules = #unsafe_rules rs} end; + splits = #splits rs, + combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = #wp_pre rs} + end fun add_split rule (rs : wp_rules) = - {trips = #trips rs, rules = #rules rs, - splits = Thm.add_thm rule (#splits rs), combs = #combs rs, - unsafe_rules = #unsafe_rules rs}; + {trips = #trips rs, + rules = #rules rs, + splits = Thm.add_thm rule (#splits rs), + combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = #wp_pre rs} fun add_comb rule (rs : wp_rules) = {trips = #trips rs, rules = #rules rs, splits = #splits rs, combs = Thm.add_thm rule (#combs rs), - unsafe_rules = #unsafe_rules rs}; + unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs} fun del_split rule rs = {trips = #trips rs, rules = #rules rs, splits = Thm.del_thm rule (#splits rs), combs = #combs rs, - unsafe_rules = #unsafe_rules rs}; + unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs} fun del_comb rule rs = {trips = #trips rs, rules = #rules rs, splits = #splits rs, combs = Thm.del_thm rule (#combs rs), - unsafe_rules = #unsafe_rules rs}; + unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs} fun add_unsafe_rule rule rs = {trips = #trips rs, rules = #rules rs, splits = #splits rs, combs = #combs rs, - unsafe_rules = Thm.add_thm rule (#unsafe_rules rs)}; + unsafe_rules = Thm.add_thm rule (#unsafe_rules rs), + wp_pre = #wp_pre rs} fun del_unsafe_rule rule rs = {trips = #trips rs, rules = #rules rs, splits = #splits rs, combs = #combs rs, - unsafe_rules = Thm.del_thm rule (#unsafe_rules rs)}; + unsafe_rules = Thm.del_thm rule (#unsafe_rules rs), + wp_pre = #wp_pre rs} -fun gen_att m = Thm.declaration_attribute (fn thm => fn context => - WPData.map (m thm) context); +fun add_wp_pre rule rs = + {trips = #trips rs, rules = #rules rs, + splits = #splits rs, combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = Thm.add_thm rule (#wp_pre rs)} + +fun del_wp_pre rule rs = + {trips = #trips rs, rules = #rules rs, + splits = #splits rs, combs = #combs rs, + unsafe_rules = #unsafe_rules rs, + wp_pre = Thm.del_thm rule (#wp_pre rs)} + +fun gen_att m = Thm.declaration_attribute (fn thm => fn context => WPData.map (m thm) context); val wp_add = gen_att add_rule; val wp_del = gen_att del_rule; @@ -210,6 +243,8 @@ val combs_add = gen_att add_comb; val combs_del = gen_att del_comb; val wp_unsafe_add = gen_att add_unsafe_rule; val wp_unsafe_del = gen_att del_unsafe_rule; +val wp_pre_add = gen_att add_wp_pre; +val wp_pre_del = gen_att del_wp_pre; val setup = Attrib.setup @{binding "wp"} @@ -227,6 +262,9 @@ val setup = #> Attrib.setup @{binding "wp_unsafe"} (Attrib.add_del wp_unsafe_add wp_unsafe_del) "unsafe monadic weakest precondition rules" + #> Attrib.setup @{binding "wp_pre"} + (Attrib.add_del wp_pre_add wp_pre_del) + "initial weakening rules for wp" fun debug_get ctxt = WPData.get (Context.Proof ctxt); @@ -294,23 +332,34 @@ fun apply_rules_tac_n trace ctxt extras extras_ref n = let val rules = get_rules ctxt extras; val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref + fun has_vars st = Term.exists_subterm Term.is_Var (Thm.concl_of st) + val wp_pre_tac = COND has_vars all_tac (TRY (resolve_tac ctxt (#wp_pre rules) 1)) + val cleanup_tac = TRY (REPEAT + (resolve_tac ctxt [@{thm TrueI}, @{thm conj_TrueI}, @{thm conj_TrueI2}] 1 + ORELSE assume_tac ctxt 1)) + val steps_tac = (CHANGED (REPEAT_DETERM (resolve_ruleset_tac ctxt rules used_rules 1))) + THEN cleanup_tac in + SELECT_GOAL ( (fn t => Seq.map (fn thm => (warn_unused_thms ctxt extras extras_ref used_rules; trace_used_thms trace used_rules ctxt; thm)) - (CHANGED (REPEAT_DETERM (resolve_ruleset_tac ctxt rules used_rules n)) t)) THEN_ELSE - (fn t => (warn_unsafe_thms (#unsafe_rules rules) n ctxt t; all_tac t), - fn t => (warn_unsafe_thms (#unsafe_rules rules) n ctxt t; no_tac t)) -end; + ((wp_pre_tac THEN steps_tac) t)) THEN_ELSE + (fn t => (warn_unsafe_thms (#unsafe_rules rules) 1 ctxt t; all_tac t), + fn t => (warn_unsafe_thms (#unsafe_rules rules) 1 ctxt t; no_tac t))) n +end + +fun apply_rules_tac trace ctxt extras extras_ref = + apply_rules_tac_n trace ctxt extras extras_ref 1; -fun apply_rules_tac trace ctxt extras extras_ref = apply_rules_tac_n trace ctxt extras extras_ref 1; fun apply_once_tac trace ctxt extras extras_ref t = - let val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref; + let + val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref; in Seq.map (fn thm => (warn_unused_thms ctxt extras extras_ref used_rules; trace_used_thms trace used_rules ctxt; thm)) - (resolve_ruleset_tac ctxt (get_rules ctxt extras) used_rules 1 t) end + (SELECT_GOAL (resolve_ruleset_tac ctxt (get_rules ctxt extras) used_rules 1) 1 t) end -fun clear_rules ({combs, rules, trips, splits, unsafe_rules}) = - {combs=combs, rules=no_rules, trips=trips, splits=splits, unsafe_rules=unsafe_rules} +fun clear_rules ({combs, rules, trips, splits, unsafe_rules, wp_pre}) = + {combs=combs, rules=no_rules, trips=trips, splits=splits, unsafe_rules=unsafe_rules, wp_pre=wp_pre} fun wp_modifiers extras_ref = [Args.add -- Args.colon >> K (I, fn att => (add_extra_rule (#2 att) extras_ref; wp_add att)), diff --git a/lib/Monad_WP/wp/WP.thy b/lib/Monad_WP/wp/WP.thy index 164656275..029b713bf 100644 --- a/lib/Monad_WP/wp/WP.thy +++ b/lib/Monad_WP/wp/WP.thy @@ -9,7 +9,9 @@ *) theory WP -imports "~~/src/HOL/Main" +imports + "~~/src/HOL/Main" + "~~/src/HOL/Eisbach/Eisbach_Tools" begin definition @@ -28,6 +30,9 @@ definition where "postconditions P Q = (\a b. P a b \ Q a b)" +lemma conj_TrueI: "P \ True \ P" by simp +lemma conj_TrueI2: "P \ P \ True" by simp + ML_file "WP-method.ML" declare [[wp_warn_unused = false]] @@ -46,4 +51,5 @@ method_setup wp_trace = {* WeakestPre.apply_rules_args true *} method_setup wp_once_trace = {* WeakestPre.apply_once_args true *} "applies one weakest precondition rule with tracing" + end diff --git a/lib/Monad_WP/wp/WPI.thy b/lib/Monad_WP/wp/WPI.thy index 1dcb1de87..720878153 100644 --- a/lib/Monad_WP/wp/WPI.thy +++ b/lib/Monad_WP/wp/WPI.thy @@ -430,7 +430,6 @@ notepad begin f x \\r s. D'' x \ (R D r s \ (Q s \ Q' s \ D \ (y x \ D''' y) \ (D'''' \ y x))) \ (\ R D r s \ (Q s \ Q'' s))\" - apply (rule hoare_pre) apply wp apply (wpi wpi: Q') apply (wpi wpi: Q) From c0919ad12023026ea1552d1ac03fd444ecb5c2d9 Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Fri, 13 Jan 2017 13:55:49 +0100 Subject: [PATCH 2/7] wp: wpsimp and bundle no_pre - small wpsimp method that wraps up the standard (wp|wpc|clarsimp)+ pattern - a bundle "no_pre" that removes the wp_pre rules for situations where the old wp behaviour is wanted. --- lib/Monad_WP/NonDetMonadVCG.thy | 200 +++++++++++--------------------- 1 file changed, 70 insertions(+), 130 deletions(-) diff --git a/lib/Monad_WP/NonDetMonadVCG.thy b/lib/Monad_WP/NonDetMonadVCG.thy index 055eb051c..1d53d28f0 100644 --- a/lib/Monad_WP/NonDetMonadVCG.thy +++ b/lib/Monad_WP/NonDetMonadVCG.thy @@ -16,6 +16,10 @@ imports "Strengthen" begin +(* Wrap up the standard usage pattern of wp/wpc/simp into its own command: *) +method wpsimp uses wp simp = + ((determ \wp add: wp|wpc|clarsimp simp: simp\)+)[1] + declare K_def [simp] section "Satisfiability" @@ -511,7 +515,7 @@ lemma exs_valid_get [wp]: lemma exs_valid_gets [wp]: "\ \s. Q (f s) s \ gets f \\ Q \" - by (clarsimp simp: gets_def, wp) + by (clarsimp simp: gets_def) wp lemma exs_valid_put [wp]: "\ Q v \ put v \\ Q \" @@ -878,62 +882,51 @@ lemma hoare_vcg_prop: lemma return_wp: "\P x\ return x \P\" - apply(simp add:valid_def return_def) -done + by(simp add:valid_def return_def) lemma get_wp: "\\s. P s s\ get \P\" - apply(simp add:valid_def split_def get_def) -done + by(simp add:valid_def split_def get_def) lemma gets_wp: - "\\s. P (f s) s\ gets f \P\" - apply(simp add:valid_def split_def gets_def return_def get_def bind_def) -done + "\\s. P (f s) s\ gets f \P\" + by(simp add:valid_def split_def gets_def return_def get_def bind_def) lemma modify_wp: - "\\s. P () (f s)\ modify f \P\" - apply(simp add:valid_def split_def modify_def get_def put_def bind_def) -done + "\\s. P () (f s)\ modify f \P\" + by(simp add:valid_def split_def modify_def get_def put_def bind_def) lemma put_wp: "\\s. P () x\ put x \P\" - apply(simp add:valid_def put_def) -done + by(simp add:valid_def put_def) lemma returnOk_wp: "\P x\ returnOk x \P\,\E\" - apply(simp add:validE_def2 returnOk_def return_def) -done + by(simp add:validE_def2 returnOk_def return_def) lemma throwError_wp: "\E e\ throwError e \P\,\E\" - apply(simp add:validE_def2 throwError_def return_def) -done + by(simp add:validE_def2 throwError_def return_def) lemma returnOKE_R_wp : "\P x\ returnOk x \P\, -" - by (simp add: validE_R_def validE_def valid_def - returnOk_def return_def) + by (simp add: validE_R_def validE_def valid_def returnOk_def return_def) lemma liftE_wp: "\P\ f \Q\ \ \P\ liftE f \Q\,\E\" - apply(clarsimp simp:valid_def validE_def2 liftE_def split_def Let_def bind_def return_def) -done + by(clarsimp simp:valid_def validE_def2 liftE_def split_def Let_def bind_def return_def) lemma catch_wp: "\ \x. \E x\ handler x \Q\; \P\ f \Q\,\E\ \ \ \P\ catch f handler \Q\" apply (unfold catch_def valid_def validE_def return_def) - apply (clarsimp simp: bind_def) - apply (fastforce split: sum.splits) + apply (fastforce simp: bind_def split: sum.splits) done lemma handleE'_wp: "\ \x. \F x\ handler x \Q\,\E\; \P\ f \Q\,\F\ \ \ \P\ f handler \Q\,\E\" apply (unfold handleE'_def valid_def validE_def return_def) - apply (clarsimp simp: bind_def) - apply (fastforce split: sum.splits) + apply (fastforce simp: bind_def split: sum.splits) done lemma handleE_wp: @@ -1214,12 +1207,9 @@ lemma hoare_vcg_all_lift: "\ \x. \P x\ f \Q x\ \ \ \\s. \x. P x s\ f \\rv s. \x. Q x rv s\" by (fastforce simp: valid_def) -(* - * hoare_vcg_all_lift_R - * - * \x. \?P x\ ?f \?Q x\, -) \ \\s. \x. ?P x s\ ?f \\rv s. \x. ?Q x rv s\, - - *) -lemmas hoare_vcg_all_lift_R = hoare_vcg_const_Ball_lift_R[where S=UNIV, simplified] +lemma hoare_vcg_all_lift_R: + "(\x. \P x\ f \Q x\, -) \ \\s. \x. P x s\ f \\rv s. \x. Q x rv s\, -" + by (rule hoare_vcg_const_Ball_lift_R[where S=UNIV, simplified]) lemma hoare_vcg_const_imp_lift: "\ P \ \Q\ m \R\ \ \ @@ -1379,6 +1369,7 @@ lemmas hoare_wp_splits [wp_split] = lemmas [wp_comb] = hoare_wp_state_combsE hoare_wp_combsE hoare_wp_combs lemmas [wp] = hoare_vcg_prop + wp_post_taut return_wp put_wp get_wp @@ -1393,6 +1384,7 @@ lemmas [wp] = hoare_vcg_prop lemmas [wp_trip] = valid_is_triple validE_is_triple validE_E_is_triple validE_R_is_triple + text {* Simplifications on conjunction *} lemma hoare_post_eq: "\ Q = Q'; \P\ f \Q'\ \ \ \P\ f \Q\" @@ -1431,8 +1423,7 @@ lemmas hoare_wp_simps [wp_split] = if_apply_reduct if_apply_reductE if_apply_reductE_R TrueI schematic_goal if_apply_test: "\?Q\ (if A then returnOk else K fail) x \P\,\E\" - apply (wp | unfold K_def)+ - done + by wpsimp lemma hoare_elim_pred_conj: "\P\ f \\r s. Q r s \ Q' r s\ \ \P\ f \\r. Q r and Q' r\" @@ -1456,12 +1447,16 @@ lemmas hoare_wp_pred_conj_elims = lemmas hoare_weaken_preE = hoare_vcg_precond_impE -lemmas hoare_pre = +lemmas hoare_pre [wp_pre] = hoare_weaken_pre hoare_weaken_preE hoare_vcg_precond_impE_R hoare_weaken_preE_E +declare no_fail_pre [wp_pre] + +bundle no_pre = hoare_pre [wp_pre del] no_fail_pre [wp_pre del] + text {* Miscellaneous lemmas on hoare triples *} lemma hoare_vcg_mp: @@ -1491,10 +1486,7 @@ lemma hoare_add_post: lemma hoare_whenE_wp: "(P \ \Q\ f \R\, \E\) \ \if P then Q else R ()\ whenE P f \R\, \E\" - unfolding whenE_def - apply clarsimp - apply wp - done + unfolding whenE_def by clarsimp wp lemma hoare_gen_asmE: "(P \ \P'\ f \Q\,-) \ \P' and K P\ f \Q\, -" @@ -1506,10 +1498,8 @@ lemma hoare_list_case: shows "\case xs of [] \ P1 | y#ys \ P2 y ys\ f (case xs of [] \ f1 | y#ys \ f2 y ys) \Q\" - apply (cases xs) - apply simp + apply (cases xs; simp) apply (rule P1) - apply simp apply (rule P2) apply simp done @@ -1524,8 +1514,7 @@ lemma hoare_use_eq: shows "\\s. P (f s) s\ m \\rv s. Q (f s :: 'c :: type) s \" apply (rule_tac Q="\rv s. \f'. f' = f s \ Q f' s" in hoare_post_imp) apply simp - apply (wp hoare_vcg_ex_lift x y) - apply simp + apply (wpsimp wp: hoare_vcg_ex_lift x y) done lemma hoare_return_sp: @@ -1590,11 +1579,7 @@ lemma in_liftM: apply (simp add: Bex_def) done -(* - * handy_liftM_lemma - * - * ((?r, ?s') \ fst (liftM ?t ?f ?s)) = (\r'. (r', ?s') \ fst (?f ?s) \ ?r = ?t r') - *) +(* FIXME: eliminate *) lemmas handy_liftM_lemma = in_liftM lemma hoare_fun_app_wp[wp]: @@ -1689,7 +1674,7 @@ lemma case_option_wp: assumes y: "\P'\ m' \Q\" shows "\\s. (x = None \ P' s) \ (x \ None \ P (the x) s)\ case_option m' m x \Q\" - apply (cases x, simp_all) + apply (cases x; simp) apply (rule y) apply (rule x) done @@ -1699,7 +1684,7 @@ lemma case_option_wpE: assumes y: "\P'\ m' \Q\,\E\" shows "\\s. (x = None \ P' s) \ (x \ None \ P (the x) s)\ case_option m' m x \Q\,\E\" - apply (cases x, simp_all) + apply (cases x; simp) apply (rule y) apply (rule x) done @@ -1742,11 +1727,7 @@ lemma list_cases_wp: (* FIXME: make wp *) lemma whenE_throwError_wp: "\\s. \Q \ P s\ whenE Q (throwError e) \\rv. P\, -" - apply (simp add: whenE_def split del: if_split) - apply (rule hoare_pre) - apply wp - apply simp - done + unfolding whenE_def by wpsimp lemma select_throwError_wp: "\\s. \x\S. Q x s\ select S >>= throwError -, \Q\" @@ -1760,16 +1741,13 @@ subsection "Basic validNF theorems" lemma validNF [intro?]: "\ \ P \ f \ Q \; no_fail P f \ \ \ P \ f \ Q \!" - apply (clarsimp simp: validNF_def) - done + by (clarsimp simp: validNF_def) lemma validNF_valid: "\ \ P \ f \ Q \! \ \ \ P \ f \ Q \" - apply (clarsimp simp: validNF_def) - done + by (clarsimp simp: validNF_def) lemma validNF_no_fail: "\ \ P \ f \ Q \! \ \ no_fail P f" - apply (clarsimp simp: validNF_def) - done + by (clarsimp simp: validNF_def) lemma snd_validNF: "\ \ P \ f \ Q \!; P s \ \ \ snd (f s)" @@ -1783,57 +1761,42 @@ subsection "validNF weakest pre-condition rules" lemma validNF_return [wp]: "\ P x \ return x \ P \!" - apply rule - apply wp - apply (clarsimp simp: no_fail_def return_def) - done + by (wp validNF)+ lemma validNF_get [wp]: "\ \s. P s s \ get \ P \!" - apply rule - apply wp - apply (clarsimp simp: no_fail_def get_def) - done + by (wp validNF)+ lemma validNF_put [wp]: "\ \s. P () x \ put x \ P \!" - apply rule - apply wp - apply (clarsimp simp: no_fail_def put_def) - done + by (wp validNF)+ lemma validNF_K_bind [wp]: "\ P \ x \ Q \! \ \ P \ K_bind x f \ Q \!" - apply (clarsimp simp: validNF_def) - done + by simp lemma validNF_fail [wp]: "\ \s. False \ fail \ Q \!" by (clarsimp simp: validNF_def fail_def no_fail_def) lemma validNF_prop [wp_unsafe]: - "\ no_fail (\s. P) f \ \ \ \s. P \ f \ \rv s. P \!" - apply rule - apply wp - apply simp - done + "\ no_fail (\s. P) f \ \ \ \s. P \ f \ \rv s. P \!" + by (wp validNF)+ lemma validNF_post_conj [intro!]: "\ \ P \ a \ Q \!; \ P \ a \ R \! \ \ \ P \ a \ Q And R \!" - apply (clarsimp simp: validNF_def) - done + by (clarsimp simp: validNF_def) + +lemma no_fail_or: + "\no_fail P a; no_fail Q a\ \ no_fail (P or Q) a" + by (clarsimp simp: no_fail_def) lemma validNF_pre_disj [intro!]: "\ \ P \ a \ R \!; \ Q \ a \ R \! \ \ \ P or Q \ a \ R \!" - apply rule - apply (drule validNF_valid)+ - apply auto[1] - apply (drule validNF_no_fail)+ - apply (clarsimp simp: no_fail_def) - done + by (rule validNF) (auto dest: validNF_valid validNF_no_fail intro: no_fail_or) (* - * Setup combination rules for WP, which also requires + * Set up combination rules for WP, which also requires * a "wp_trip" rule for validNF. *) @@ -1842,8 +1805,7 @@ definition "validNF_property Q s b \ \ snd (b s) \ (\(r lemma validNF_is_triple [wp_trip]: "validNF P f Q = triple_judgement P f (validNF_property Q)" apply (clarsimp simp: validNF_def triple_judgement_def validNF_property_def) - apply (clarsimp simp: no_fail_def valid_def) - apply auto + apply (auto simp: no_fail_def valid_def) done lemma validNF_weaken_pre [wp_comb]: @@ -1896,7 +1858,7 @@ lemma validNF_vcg_disj_lift: lemma validNF_vcg_all_lift [wp]: "\ \x. \P x\ f \Q x\! \ \ \\s. \x. P x s\ f \\rv s. \x. Q x rv s\!" apply atomize - apply rule + apply (rule validNF) apply (clarsimp simp: validNF_def) apply (rule hoare_vcg_all_lift) apply force @@ -1906,7 +1868,7 @@ lemma validNF_vcg_all_lift [wp]: lemma validNF_bind [wp_split]: "\ \x. \B x\ g x \C\!; \A\ f \B\! \ \ \A\ do x \ f; g x od \C\!" - apply rule + apply (rule validNF) apply (metis validNF_valid hoare_seq_ext) apply (clarsimp simp: no_fail_def validNF_def bind_def' valid_def) apply blast @@ -1918,9 +1880,8 @@ subsection "validNF compound rules" lemma validNF_state_assert [wp]: "\ \s. P () s \ G s \ state_assert G \ P \!" - apply rule - apply wp - apply simp + apply (rule validNF) + apply wpsimp apply (clarsimp simp: no_fail_def state_assert_def bind_def' assert_def return_def get_def) done @@ -1952,20 +1913,18 @@ lemma validNF_alt_def: lemma validNF_assert [wp]: "\ (\s. P) and (R ()) \ assert P \ R \!" - apply rule + apply (rule validNF) apply (clarsimp simp: valid_def in_return) apply (clarsimp simp: no_fail_def return_def) done lemma validNF_false_pre: "\ \_. False \ P \ Q \!" - apply (clarsimp simp: validNF_def no_fail_def) - done + by (clarsimp simp: validNF_def no_fail_def) lemma validNF_chain: "\\P'\ a \R'\!; \s. P s \ P' s; \r s. R' r s \ R r s\ \ \P\ a \R\!" - apply (fastforce simp: validNF_def valid_def no_fail_def Ball_def) - done + by (fastforce simp: validNF_def valid_def no_fail_def Ball_def) lemma validNF_case_prod [wp]: "\ \x y. validNF (P x y) (B x y) Q \ \ validNF (case_prod P v) (case_prod (\x y. B x y) v) Q" @@ -1979,8 +1938,7 @@ lemma validE_NF_case_prod [wp]: done lemma no_fail_is_validNF_True: "no_fail P s = (\ P \ s \ \_ _. True \!)" - apply (clarsimp simp: no_fail_def validNF_def valid_def) - done + by (clarsimp simp: no_fail_def validNF_def valid_def) subsection "validNF reasoning in the exception monad" @@ -2033,8 +1991,7 @@ lemma validE_NF_chain: \r' s'. R' r' s' \ R r' s'; \r'' s''. E' r'' s'' \ E r'' s''\ \ \\s. P s \ a \\r' s'. R r' s'\,\\r'' s''. E r'' s''\!" - apply (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits) - done + by (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits) lemma validE_NF_bind_wp [wp]: "\\x. \B x\ g x \C\, \E\!; \A\ f \B\, \E\!\ \ \A\ f >>=E (\x. g x) \C\, \E\!" @@ -2042,8 +1999,7 @@ lemma validE_NF_bind_wp [wp]: apply (rule validNF_bind [rotated]) apply assumption apply (clarsimp simp: lift_def throwError_def split: sum.splits) - apply wp - apply simp + apply wpsimp done lemma validNF_catch [wp]: @@ -2057,33 +2013,21 @@ lemma validNF_catch [wp]: lemma validNF_throwError [wp]: "\E e\ throwError e \P\, \E\!" - apply (unfold validE_NF_alt_def throwError_def o_def) - apply wp - apply simp - done + by (unfold validE_NF_alt_def throwError_def o_def) wpsimp lemma validNF_returnOk [wp]: "\P e\ returnOk e \P\, \E\!" - apply (clarsimp simp: validE_NF_alt_def returnOk_def) - apply wp - apply clarsimp - done + by (clarsimp simp: validE_NF_alt_def returnOk_def) wpsimp lemma validNF_whenE [wp]: "(P \ \Q\ f \R\, \E\!) \ \if P then Q else R ()\ whenE P f \R\, \E\!" - unfolding whenE_def - apply clarsimp - apply wp - done + unfolding whenE_def by clarsimp wp lemma validNF_nobindE [wp]: "\ \B\ g \C\,\E\!; \A\ f \\r s. B s\,\E\! \ \ \A\ doE f; g odE \C\,\E\!" - apply clarsimp - apply wp - apply auto - done + by clarsimp wp (* * Setup triple rules for validE_NF so that we can use the @@ -2110,10 +2054,7 @@ lemma validNF_cong: lemma validE_NF_liftE [wp]: "\P\ f \Q\! \ \P\ liftE f \Q\,\E\!" - apply (clarsimp simp: validE_NF_alt_def liftE_def) - apply wp - apply clarsimp - done + by (wpsimp simp: validE_NF_alt_def liftE_def) lemma validE_NF_handleE' [wp]: "\ \x. \F x\ handler x \Q\,\E\!; \P\ f \Q\,\F\! \ \ @@ -2122,8 +2063,7 @@ lemma validE_NF_handleE' [wp]: apply (rule validNF_bind [rotated]) apply assumption apply (clarsimp split: sum.splits) - apply wp - apply simp + apply wpsimp done lemma validE_NF_handleE [wp]: @@ -2138,7 +2078,7 @@ lemma validE_NF_condition [wp]: \ \\s. if C s then Q s else R s\ condition C A B \P\,\ E \!" apply rule apply (drule validE_NF_valid)+ - apply (wp, simp, simp) + apply wp apply (drule validE_NF_no_fail)+ apply (clarsimp simp: no_fail_def condition_def) done From 47119bf43e4128124ac65a5adc2a213d09dbb790 Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Fri, 13 Jan 2017 13:58:40 +0100 Subject: [PATCH 3/7] wp_cleanup: update proofs for new wp behaviour The things that usually go wrong: - wp fall through: add +, e.g. apply (wp select_wp) -> apply (wp select_wp)+ - precondition: you can remove most hoare_pre, but wpc still needs it, and sometimes the wp instance relies on being able to fit a rule to the current non-schematic precondition. In that case, use "including no_pre" to switch off the automatic hoare_pre application. - very rarely there is a schematic postcondition that interferes with the new trivial cleanup rules, because the rest of the script assumes some specific state afterwards (shouldn't happen in a reasonable proof, but not all proofs are reasonable..). In that case, (wp_once ...)+ should emulate the old behaviour precisely. --- camkes/glue-proofs/RPCFrom.thy | 12 +- camkes/glue-proofs/RPCTo.thy | 26 +- lib/BCorres_UL.thy | 36 +- lib/Bisim_UL.thy | 6 +- lib/Corres_UL.thy | 2 +- lib/EquivValid.thy | 10 +- lib/HaskellLemmaBucket.thy | 4 +- lib/MonadicRewrite.thy | 4 +- lib/NonDetMonadLemmaBucket.thy | 88 +-- lib/sep_algebra/MonadSep.thy | 1 + proof/access-control/ADT_AC.thy | 17 +- proof/access-control/Arch_AC.thy | 9 +- proof/access-control/CNode_AC.thy | 35 +- proof/access-control/DomainSepInv.thy | 51 +- proof/access-control/Finalise_AC.thy | 41 +- proof/access-control/Interrupt_AC.thy | 8 +- proof/access-control/Ipc_AC.thy | 74 ++- proof/access-control/Retype_AC.thy | 42 +- proof/access-control/Syscall_AC.thy | 40 +- proof/access-control/Tcb_AC.thy | 13 +- proof/bisim/Syscall_S.thy | 131 ++--- proof/capDL-api/Arch_DP.thy | 76 ++- proof/capDL-api/CNode_DP.thy | 30 +- proof/capDL-api/IRQ_DP.thy | 12 +- proof/capDL-api/Invocation_DP.thy | 47 +- proof/capDL-api/KHeap_DP.thy | 27 +- proof/capDL-api/Retype_DP.thy | 26 +- proof/capDL-api/Sep_Tactic_Examples.thy | 4 +- proof/capDL-api/TCB_DP.thy | 338 ++++++------ proof/crefine/Arch_C.thy | 16 +- proof/crefine/CLevityCatch.thy | 2 +- proof/crefine/CSpace_C.thy | 2 +- proof/crefine/CSpace_RAB_C.thy | 2 +- proof/crefine/Delete_C.thy | 4 +- proof/crefine/DetWP.thy | 4 +- proof/crefine/Fastpath_C.thy | 121 +++-- proof/crefine/Finalise_C.thy | 3 +- proof/crefine/Interrupt_C.thy | 8 +- proof/crefine/Invoke_C.thy | 19 +- proof/crefine/IpcCancel_C.thy | 22 +- proof/crefine/Ipc_C.thy | 55 +- proof/crefine/IsolatedThreadAction.thy | 37 +- proof/crefine/Machine_C.thy | 6 +- proof/crefine/Recycle_C.thy | 3 +- proof/crefine/Refine_C.thy | 2 +- proof/crefine/Retype_C.thy | 15 +- proof/crefine/Schedule_C.thy | 14 +- proof/crefine/SyscallArgs_C.thy | 30 +- proof/crefine/Syscall_C.thy | 20 +- proof/crefine/TcbAcc_C.thy | 2 +- proof/crefine/Tcb_C.thy | 38 +- proof/crefine/VSpace_C.thy | 30 +- proof/drefine/Arch_DR.thy | 100 ++-- proof/drefine/CNode_DR.thy | 99 ++-- proof/drefine/Corres_D.thy | 5 +- proof/drefine/Finalise_DR.thy | 392 +++++++------- proof/drefine/Intent_DR.thy | 215 ++++---- proof/drefine/Interrupt_DR.thy | 76 ++- proof/drefine/Ipc_DR.thy | 380 ++++++------- proof/drefine/KHeap_DR.thy | 67 ++- proof/drefine/Refine_D.thy | 2 +- proof/drefine/Schedule_DR.thy | 32 +- proof/drefine/Syscall_DR.thy | 326 ++++++------ proof/drefine/Tcb_DR.thy | 139 ++--- proof/drefine/Untyped_DR.thy | 33 +- proof/infoflow/ADT_IF.thy | 62 +-- proof/infoflow/ADT_IF_Refine.thy | 20 +- proof/infoflow/ADT_IF_Refine_C.thy | 21 +- proof/infoflow/Arch_IF.thy | 122 ++--- proof/infoflow/Decode_IF.thy | 28 +- proof/infoflow/FinalCaps.thy | 74 ++- proof/infoflow/Finalise_IF.thy | 55 +- proof/infoflow/IRQMasks_IF.thy | 24 +- proof/infoflow/InfoFlow.thy | 2 +- proof/infoflow/Ipc_IF.thy | 82 ++- proof/infoflow/Noninterference.thy | 18 +- proof/infoflow/PasUpdates.thy | 34 +- proof/infoflow/Retype_IF.thy | 12 +- proof/infoflow/Scheduler_IF.thy | 87 ++- proof/infoflow/Syscall_IF.thy | 37 +- proof/infoflow/Tcb_IF.thy | 59 +-- proof/invariant-abstract/AInvs.thy | 3 +- proof/invariant-abstract/ARM/ArchAcc_AI.thy | 223 +++----- proof/invariant-abstract/ARM/ArchArch_AI.thy | 18 +- .../ARM/ArchCNodeInv_AI.thy | 22 +- .../invariant-abstract/ARM/ArchCSpace_AI.thy | 4 +- .../ARM/ArchDetSchedAux_AI.thy | 25 +- .../ARM/ArchEmptyFail_AI.thy | 3 +- .../ARM/ArchFinalise_AI.thy | 33 +- .../ARM/ArchInterrupt_AI.thy | 1 - .../ARM/ArchInvariants_AI.thy | 10 +- proof/invariant-abstract/ARM/ArchIpc_AI.thy | 18 +- proof/invariant-abstract/ARM/ArchKHeap_AI.thy | 27 +- .../invariant-abstract/ARM/ArchRetype_AI.thy | 22 +- .../ARM/ArchSchedule_AI.thy | 2 +- .../ARM/ArchVSpaceEntries_AI.thy | 32 +- .../invariant-abstract/ARM/ArchVSpace_AI.thy | 80 +-- proof/invariant-abstract/ARM/Machine_AI.thy | 16 +- proof/invariant-abstract/Arch_AI.thy | 5 +- proof/invariant-abstract/BCorres2_AI.thy | 31 +- proof/invariant-abstract/Bits_AI.thy | 5 +- proof/invariant-abstract/CNodeInv_AI.thy | 134 ++--- proof/invariant-abstract/CSpaceInv_AI.thy | 117 ++-- proof/invariant-abstract/CSpace_AI.thy | 463 ++++++++-------- proof/invariant-abstract/DetSchedAux_AI.thy | 43 +- .../DetSchedDomainTime_AI.thy | 12 +- proof/invariant-abstract/DetSchedInvs_AI.thy | 20 +- .../DetSchedSchedule_AI.thy | 159 +++--- proof/invariant-abstract/Deterministic_AI.thy | 334 +++++------- proof/invariant-abstract/EmptyFail_AI.thy | 2 +- proof/invariant-abstract/Finalise_AI.thy | 50 +- proof/invariant-abstract/Interrupt_AI.thy | 9 +- proof/invariant-abstract/Invariants_AI.thy | 6 +- proof/invariant-abstract/IpcCancel_AI.thy | 120 ++--- proof/invariant-abstract/Ipc_AI.thy | 222 +++----- proof/invariant-abstract/KHeap_AI.thy | 159 ++---- proof/invariant-abstract/LevityCatch_AI.thy | 1 - proof/invariant-abstract/Retype_AI.thy | 55 +- proof/invariant-abstract/Schedule_AI.thy | 15 +- proof/invariant-abstract/Syscall_AI.thy | 70 +-- proof/invariant-abstract/TcbAcc_AI.thy | 126 ++--- proof/invariant-abstract/Tcb_AI.thy | 127 ++--- proof/invariant-abstract/Untyped_AI.thy | 154 ++---- proof/invariant-abstract/VSpaceEntries_AI.thy | 12 - proof/invariant-abstract/VSpacePre_AI.thy | 5 +- proof/refine/ArchAcc_R.thy | 38 +- proof/refine/Arch_R.thy | 106 ++-- proof/refine/Bits_R.thy | 24 +- proof/refine/CNodeInv_R.thy | 126 +++-- proof/refine/CSpace1_R.thy | 118 ++--- proof/refine/CSpace_I.thy | 18 +- proof/refine/CSpace_R.thy | 269 +++++----- proof/refine/Detype_R.thy | 101 ++-- proof/refine/DomainTime_R.thy | 2 +- proof/refine/Finalise_R.thy | 101 ++-- proof/refine/Interrupt_R.thy | 53 +- proof/refine/Invariants_H.thy | 20 +- proof/refine/IpcCancel_R.thy | 199 ++++--- proof/refine/Ipc_R.thy | 217 ++++---- proof/refine/KHeap_R.thy | 97 ++-- proof/refine/Orphanage.thy | 65 ++- proof/refine/PageTableDuplicates.thy | 76 ++- proof/refine/Refine.thy | 20 +- proof/refine/Retype_R.thy | 159 +++--- proof/refine/Schedule_R.thy | 126 +++-- proof/refine/SubMonad_R.thy | 4 +- proof/refine/Syscall_R.thy | 265 ++++------ proof/refine/TcbAcc_R.thy | 500 ++++++++---------- proof/refine/Tcb_R.thy | 194 +++---- proof/refine/Untyped_R.thy | 91 ++-- proof/refine/VSpace_R.thy | 209 ++++---- proof/sep-capDL/Frame_SD.thy | 2 +- proof/sep-capDL/Helpers_SD.thy | 2 +- sys-init/CreateIRQCaps_SI.thy | 1 + sys-init/CreateObjects_SI.thy | 2 +- sys-init/DuplicateCaps_SI.thy | 4 +- sys-init/InitCSpace_SI.thy | 18 +- sys-init/InitVSpace_SI.thy | 9 +- tools/autocorres/ExceptionRewrite.thy | 1 + tools/autocorres/ExecConcrete.thy | 8 +- tools/autocorres/HeapLift.thy | 4 +- tools/autocorres/L1Defs.thy | 2 +- tools/autocorres/L1Valid.thy | 1 + tools/autocorres/tests/examples/Factorial.thy | 1 - tools/autocorres/tests/examples/Memcpy.thy | 2 +- .../proof-tests/heap_lift_force_prevent.thy | 2 +- 166 files changed, 4628 insertions(+), 5892 deletions(-) mode change 100755 => 100644 proof/drefine/Interrupt_DR.thy diff --git a/camkes/glue-proofs/RPCFrom.thy b/camkes/glue-proofs/RPCFrom.thy index 981c37ca6..ce9af2ecb 100644 --- a/camkes/glue-proofs/RPCFrom.thy +++ b/camkes/glue-proofs/RPCFrom.thy @@ -384,7 +384,7 @@ lemma RPCFrom_echo_int_nf: apply (simp add:RPCFrom_echo_int'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done @@ -402,7 +402,7 @@ lemma RPCFrom_echo_parameter_nf: apply (simp add:RPCFrom_echo_parameter'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done @@ -420,7 +420,7 @@ lemma RPCFrom_echo_char_nf: apply (simp add:RPCFrom_echo_char'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done @@ -438,7 +438,7 @@ lemma RPCFrom_increment_char_nf: apply (simp add:RPCFrom_increment_char'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done @@ -458,7 +458,7 @@ lemma RPCFrom_increment_parameter_nf: apply (simp add:RPCFrom_increment_parameter'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done @@ -476,7 +476,7 @@ lemma RPCFrom_increment_64_nf: apply (simp add:RPCFrom_increment_64'_def) apply (wp seL4_Call_wp) apply (simp add:seL4_MessageInfo_new'_def) - apply wp + apply wp+ apply (simp add:globals_frame_intact_def ipc_buffer_valid_def setMRs_def setMR_def) done diff --git a/camkes/glue-proofs/RPCTo.thy b/camkes/glue-proofs/RPCTo.thy index 0eebd83c0..8bc6c3453 100644 --- a/camkes/glue-proofs/RPCTo.thy +++ b/camkes/glue-proofs/RPCTo.thy @@ -461,8 +461,8 @@ lemma echo_int_internal_wp[wp_unsafe]: \P48'\!" apply (simp add:echo_int_internal'_def) apply wp - apply (wp RPCTo_echo_int_wp) - apply (wp get_echo_int_i_wp) + apply (wp RPCTo_echo_int_wp)+ + apply (wp get_echo_int_i_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w32_def) @@ -492,9 +492,9 @@ lemma echo_parameter_internal_wp[wp_unsafe]: \P51'\!" apply (simp add:echo_parameter_internal'_def) apply wp - apply (wp RPCTo_echo_parameter_wp) + apply (wp RPCTo_echo_parameter_wp)+ apply (wp get_echo_parameter_pout_wp) - apply (wp get_echo_parameter_pin_wp) + apply (wp get_echo_parameter_pin_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w32_def) @@ -519,8 +519,8 @@ lemma echo_char_internal_wp[wp_unsafe]: \P54'\!" apply (simp add:echo_char_internal'_def) apply wp - apply (wp RPCTo_echo_char_wp) - apply (wp get_echo_char_i_wp) + apply (wp RPCTo_echo_char_wp)+ + apply (wp get_echo_char_i_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w8_def) @@ -546,8 +546,8 @@ lemma increment_char_internal_wp[wp_unsafe]: \P57'\!" apply (simp add:increment_char_internal'_def) apply wp - apply (wp RPCTo_increment_char_wp) - apply (wp get_increment_char_x_wp) + apply (wp RPCTo_increment_char_wp)+ + apply (wp get_increment_char_x_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w8_def) @@ -573,8 +573,8 @@ lemma increment_parameter_internal_wp[wp_unsafe]: \P60'\!" apply (simp add:increment_parameter_internal'_def) apply wp - apply (wp RPCTo_increment_parameter_wp) - apply (wp get_increment_parameter_x_wp) + apply (wp RPCTo_increment_parameter_wp)+ + apply (wp get_increment_parameter_x_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w32_def) @@ -601,8 +601,8 @@ lemma increment_64_internal_wp[wp_unsafe]: \P63'\!" apply (simp add:increment_64_internal'_def) apply wp - apply (wp RPCTo_increment_64_wp) - apply (wp get_increment_64_x_wp) + apply (wp RPCTo_increment_64_wp)+ + apply (wp get_increment_64_x_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id update_global_w64_def update_global_w64_high_def) @@ -682,7 +682,7 @@ lemma RPCTo_run_internal_wp[wp_unsafe]: apply (simp add:seL4_MessageInfo_new'_def) apply wp apply (wp increment_64_internal_wp) - apply (wp seL4_Wait_wp) + apply (wp seL4_Wait_wp)+ apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def tls_valid_def tls_def tls_ptr_def ucast_id seL4_GetIPCBuffer'_def thread_count_def setMR_def setMRs_def update_global_w32_def diff --git a/lib/BCorres_UL.thy b/lib/BCorres_UL.thy index fb427442d..45f3f2208 100644 --- a/lib/BCorres_UL.thy +++ b/lib/BCorres_UL.thy @@ -145,21 +145,18 @@ lemma fail_bcorres_underlying[wp]: "bcorres_underlying t fail fail" lemma assertE_bcorres_underlying[wp]: "bcorres_underlying t (assertE P) (assertE P)" apply (clarsimp simp add: assertE_def returnOk_def) - apply (intro impI conjI) - apply wp + apply (intro impI conjI; wp) done lemmas assertE_s_bcorres_underlying[wp] = drop_sbcorres_underlying[OF assertE_bcorres_underlying] -lemma when_s_bcorres_underlying[wp]: "(P \ s_bcorres_underlying t f f' s) \ s_bcorres_underlying t (when P f) (when P f') s" - apply (simp add: when_def) - apply (intro impI conjI) - apply wp - done +lemma when_s_bcorres_underlying[wp]: + "(P \ s_bcorres_underlying t f f' s) \ s_bcorres_underlying t (when P f) (when P f') s" + by (simp add: return_s_bcorres_underlying when_def) -lemma when_bcorres_underlying[wp]: "(P \ bcorres_underlying t f f') \ bcorres_underlying t (when P f) (when P f')" - apply (simp add: bcorres_underlying_def when_s_bcorres_underlying) - done +lemma when_bcorres_underlying[wp]: + "(P \ bcorres_underlying t f f') \ bcorres_underlying t (when P f) (when P f')" + by (simp add: bcorres_underlying_def when_s_bcorres_underlying) lemma put_bcorres_underlying[wp]: "t f = f' \ bcorres_underlying t (put f) (put f')" @@ -200,31 +197,26 @@ lemma mapM_x_bcorres_underlying[wp]: lemma mapM_bcorres_underlying[wp]: "(\x. bcorres_underlying t (f x) (f' x)) \ bcorres_underlying t (mapM f xs) (mapM f' xs)" - apply (simp add: mapM_def | wp)+ - done - + by (simp add: mapM_def | wp)+ + lemma gets_s_bcorres_underlyingE': "s_bcorres_underlying t (f (x s)) (f' (x' (t s))) s \ s_bcorres_underlying t (liftE (gets x) >>=E f) (liftE (gets x') >>=E f') s" - apply (simp add: gets_def liftE_def lift_def bindE_def) - apply wp - apply simp - done + by (simp add: gets_def liftE_def lift_def bindE_def) wp lemma bcorres_underlying_filterM[wp]: "(\x. bcorres_underlying t (a x) (a' x)) \ bcorres_underlying t (filterM a b) (filterM a' b)" apply (induct b) - apply (simp add: filterM_def) - apply (wp | simp)+ + apply (simp add: filterM_def) + apply (wp | simp)+ done lemma option_rec_bcorres_underlying[wp_split]: "(\x y. bcorres_underlying t (g x y) (g' x y)) \ (\x. bcorres_underlying t (f x) (f' x)) \ bcorres_underlying t (rec_option f g a b) (rec_option f' g' a b)" - apply (cases a,simp+) - done + by (cases a,simp+) lemma bcorres_underlying_mapME[wp]: "(\x. bcorres_underlying t (f x) (f' x)) \ bcorres_underlying t (mapME f r) (mapME f' r)" apply (induct r) - apply (simp add: mapME_def sequenceE_def | wp)+ + apply (simp add: mapME_def sequenceE_def | wp)+ done lemma handle2_bcorres_underlying[wp]: "bcorres_underlying t f f' \ (\x. bcorres_underlying t (g x) (g' x)) \ bcorres_underlying t (f g) (f' g')" diff --git a/lib/Bisim_UL.thy b/lib/Bisim_UL.thy index ae4858a57..f46e51396 100644 --- a/lib/Bisim_UL.thy +++ b/lib/Bisim_UL.thy @@ -366,7 +366,7 @@ lemma bisim_symb_exec_r_det_on: apply fastforce apply (rule nf) apply (rule z) - apply (wp y) + apply (wp y)+ apply simp+ done @@ -472,8 +472,8 @@ lemma bisim_symb_exec_r: apply fastforce apply (rule ne) apply (rule z) - apply (wp y) - apply simp+ + apply (wp y)+ + apply simp+ done lemma bisim_not_empty: diff --git a/lib/Corres_UL.thy b/lib/Corres_UL.thy index 3099db010..6bf3eb3d7 100644 --- a/lib/Corres_UL.thy +++ b/lib/Corres_UL.thy @@ -802,7 +802,7 @@ lemma corres_returnOk: apply (rule corres_noopE) apply wp apply clarsimp - apply (rule no_fail_pre, wp) + apply wp done lemmas corres_returnOkTT = corres_trivial [OF corres_returnOk] diff --git a/lib/EquivValid.thy b/lib/EquivValid.thy index d335883a9..3873df099 100644 --- a/lib/EquivValid.thy +++ b/lib/EquivValid.thy @@ -286,7 +286,7 @@ lemma get_bind_ev2: apply(rule_tac R'="I And A" in equiv_valid_2_bind_general) apply(rule assms, simp+) apply(rule get_evrv) - apply(wp get_sp) + apply(wp get_sp)+ by(auto) @@ -900,8 +900,8 @@ lemma mapM_ev'': assumes inv: "\ x. x \ set lst \ \ \s. \x\set lst. P x s \ m x \ \_ s. \x\set lst. P x s \" shows "equiv_valid_inv D A (\ s. \x\set lst. P x s) (mapM m lst)" apply(rule mapM_ev) - apply(rule equiv_valid_guard_imp[OF reads_res], simp+) - apply(wp inv, simp) + apply(rule equiv_valid_guard_imp[OF reads_res]; simp) + apply(wpsimp wp: inv) done lemma mapM_x_ev'': @@ -909,8 +909,8 @@ lemma mapM_x_ev'': assumes inv: "\ x. x \ set lst \ \ \s. \x\set lst. P x s \ m x \ \_ s. \x\set lst. P x s \" shows "equiv_valid_inv D A (\ s. \x\set lst. P x s) (mapM_x m lst)" apply(rule mapM_x_ev) - apply(rule equiv_valid_guard_imp[OF reads_res], simp+) - apply(wp inv, simp) + apply(rule equiv_valid_guard_imp[OF reads_res]; simp) + apply(wpsimp wp: inv) done lemma catch_ev[wp]: diff --git a/lib/HaskellLemmaBucket.thy b/lib/HaskellLemmaBucket.thy index 0cf85624f..295354290 100644 --- a/lib/HaskellLemmaBucket.thy +++ b/lib/HaskellLemmaBucket.thy @@ -209,8 +209,8 @@ lemma findM_on_outcome': apply (induct xs) apply (simp, wp) apply (simp, wp) - apply assumption - apply (rule x) + apply (rule x) + apply simp done diff --git a/lib/MonadicRewrite.thy b/lib/MonadicRewrite.thy index 17952e83a..e608af7f1 100644 --- a/lib/MonadicRewrite.thy +++ b/lib/MonadicRewrite.thy @@ -363,11 +363,11 @@ lemma monadic_rewrite_gets_the_walk: apply (rule monadic_rewrite_trans) apply (erule(1) monadic_rewrite_bind_tail) apply (simp add: gets_the_def bind_assoc) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_bind_tail) apply (rule_tac rv=rv in monadic_rewrite_symb_exec_l_known, - wp empty_fail_gets) + (wp empty_fail_gets)+) apply (rule monadic_rewrite_refl) apply wp apply assumption diff --git a/lib/NonDetMonadLemmaBucket.thy b/lib/NonDetMonadLemmaBucket.thy index d2d1f3e95..08d0e9503 100644 --- a/lib/NonDetMonadLemmaBucket.thy +++ b/lib/NonDetMonadLemmaBucket.thy @@ -176,11 +176,7 @@ next have IH: "\P\ zipWithM_x m as bs \\rv. P\" by fact show ?case - apply (simp add: zipWithM_x_Cons) - apply wp - apply (rule IH) - apply (rule x) - done + by (simp add: zipWithM_x_Cons) (wp IH x) qed lemma K_valid[wp]: @@ -193,10 +189,9 @@ lemma mapME_wp: apply (induct xs) apply (simp add: mapME_def sequenceE_def) apply wp - apply (simp add: mapME_Cons) - apply wp apply simp - apply (simp add: x) + apply (simp add: mapME_Cons) + apply (wp x|simp)+ done lemmas mapME_wp' = mapME_wp [OF _ subset_refl] @@ -229,8 +224,8 @@ lemma mapM_wp: apply (simp add: mapM_def sequence_def) apply (simp add: mapM_Cons) apply wp - apply assumption - apply (simp add: x) + apply (rule x, clarsimp) + apply simp done lemma mapM_x_mapM: @@ -242,12 +237,7 @@ lemma mapM_x_mapM: lemma mapM_x_wp: assumes x: "\x. x \ S \ \P\ f x \\rv. P\" shows "set xs \ S \ \P\ mapM_x f xs \\rv. P\" - apply (subst mapM_x_mapM) - apply wp - apply (rule mapM_wp) - apply (rule x) - apply assumption+ - done + by (subst mapM_x_mapM) (wp mapM_wp x) lemma mapM_x_Nil: "mapM_x f [] = return ()" @@ -282,8 +272,7 @@ next thus ?case apply (simp add: mapM_x_Cons) apply wp - apply assumption - apply (wp hr) + apply (wp hr) apply assumption done qed @@ -321,12 +310,12 @@ proof (induct xs rule: rev_induct) next case (snoc x xs) show ?case - apply - apply (simp add: mapM_append_single) apply (wp snoc.prems) - apply simp - apply (rule snoc.hyps [OF snoc.prems]) - apply simp + apply simp + apply (rule snoc.hyps [OF snoc.prems]) + apply simp + apply assumption done qed @@ -351,8 +340,8 @@ lemma mapME_x_inv_wp: apply (simp add: mapME_x_def sequenceE_x_def) apply (fold mapME_x_def sequenceE_x_def) apply wp - apply assumption - apply (rule x) + apply (rule x) + apply assumption done lemma liftM_return [simp]: @@ -632,10 +621,7 @@ lemma no_fail_throwError [wp]: lemma no_fail_liftE [wp]: "no_fail P f \ no_fail P (liftE f)" - apply (simp add: liftE_def) - apply (rule no_fail_pre, (wp | assumption)+) - apply simp - done + unfolding liftE_def by wpsimp lemma bind_return_eq: "(a >>= return) = (b >>= return) \ a = b" @@ -733,8 +719,7 @@ lemma in_returns [monad_eq]: lemma assertE_sp: "\P\ assertE Q \\rv s. Q \ P s\,\E\" - by (clarsimp simp: assertE_def, wp) - + by (clarsimp simp: assertE_def) wp lemma catch_liftE: "catch (liftE g) h = g" @@ -957,8 +942,7 @@ next case (Cons z zs) show ?case apply (clarsimp simp: mapM_Cons) - apply (rule no_fail_pre) - apply (wp Cons.prems Cons.hyps hoare_vcg_const_Ball_lift|simp)+ + apply (wp Cons.prems Cons.hyps hoare_vcg_const_Ball_lift|simp)+ done qed @@ -1103,13 +1087,7 @@ lemma no_fail_mapM: apply (induct xs) apply (simp add: mapM_def sequence_def) apply (simp add: mapM_Cons) - apply (rule no_fail_pre) - apply (rule no_fail_bind) - apply fastforce - apply (erule no_fail_bind) - apply (rule no_fail_return) - apply wp - apply simp + apply (wp|fastforce)+ done lemma gets_inv [simp]: @@ -1151,8 +1129,7 @@ lemma injection_wp: "\ t = injection_handler f; \P\ m \Q\,\\ft. E (f ft)\ \ \ \P\ t m \Q\,\E\" apply (simp add: injection_handler_def) - apply wp - apply simp + apply (wp|simp)+ done lemma injection_wp_E: @@ -1374,10 +1351,7 @@ lemma whenE_whenE_same: apply simp done -lemma gets_the_inv: "\P\ gets_the V \\rv. P\" - apply wp - apply simp - done +lemma gets_the_inv: "\P\ gets_the V \\rv. P\" by wpsimp lemma select_f_inv: "\P\ select_f S \\_. P\" @@ -1393,7 +1367,7 @@ lemma validI: lemma opt_return_pres_lift: assumes x: "\v. \P\ f v \\rv. P\" shows "\P\ case x of None \ return () | Some v \ f v \\rv. P\" - by (rule hoare_pre, wpcw, wp x, simp) + by (rule hoare_pre, (wpcw; wp x), simp) lemma exec_select_f_singleton: "(select_f ({v},False) >>= f) = f v" @@ -1431,8 +1405,9 @@ lemma filterM_preserved: "\ \x. x \ set xs \ \P\ m x \\rv. P\ \ \ \P\ filterM m xs \\rv. P\" apply (induct xs) - apply (wp | simp | erule meta_mp)+ + apply (wp | simp | erule meta_mp | drule meta_spec)+ done + lemma filterM_append: "filterM f (xs @ ys) = (do xs' \ filterM f xs; @@ -2057,14 +2032,12 @@ next show ?case apply (simp add: mapME_Cons) apply (wp) - apply (rule_tac Q' = "\xs s. (R s \ (\x \ set xs. P x s)) \ P x s" in - hoare_post_imp_R) + apply (rule_tac Q' = "\xs s. (R s \ (\x \ set xs. P x s)) \ P x s" in hoare_post_imp_R) apply (wp Cons.hyps minvp) apply simp apply (fold validE_R_def) apply simp - apply (rule hoare_pre) - apply (wp invr est) + apply (wp invr est) apply simp done qed clarsimp @@ -2126,7 +2099,7 @@ lemma list_case_throw_validE_R: "\ \y ys. xs = y # ys \ \P\ f y ys \Q\,- \ \ \P\ case xs of [] \ throwError e | x # xs \ f x xs \Q\,-" apply (case_tac xs, simp_all) - apply (rule hoare_pre, wp) + apply wp done lemma validE_R_sp: @@ -2145,8 +2118,7 @@ lemma valid_set_take_helper: lemma whenE_throwError_sp: "\P\ whenE Q (throwError e) \\rv s. \ Q \ P s\, -" apply (simp add: whenE_def validE_R_def) - apply (intro conjI impI) - apply wp + apply (intro conjI impI; wp) done lemma no_fail_bindE [wp]: @@ -2164,10 +2136,6 @@ lemma no_fail_bindE [wp]: apply clarsimp done -lemma when_False: - "when False f = return ()" - by (simp add: when_def) - lemma empty_fail_mapM_x [simp]: "(\x. empty_fail (a x)) \ empty_fail (mapM_x a xs)" apply (induct_tac xs) @@ -2631,7 +2599,9 @@ lemma no_throw_bindE_simple: "\ no_throw \ L; \x. no_throw \ \x. no_throw \ L \ no_throw \ (R x) \ \ no_throw \ (L R)" +lemma no_throw_handleE_simple: + notes hoare_pre [wp_pre del] + shows "\ \x. no_throw \ L \ no_throw \ (R x) \ \ no_throw \ (L R)" apply (clarsimp simp: no_throw_def) apply atomize apply clarsimp diff --git a/lib/sep_algebra/MonadSep.thy b/lib/sep_algebra/MonadSep.thy index d786fbe86..c92076520 100644 --- a/lib/sep_algebra/MonadSep.thy +++ b/lib/sep_algebra/MonadSep.thy @@ -28,6 +28,7 @@ lemma hoare_gen_lifted_asm: by (auto intro: hoare_assume_pre) lemma mapM_x_sep_inv': + includes no_pre assumes f: "\R x. x \ S \ \\s.

* I \* R> s \ I' s\ diff --git a/proof/access-control/ADT_AC.thy b/proof/access-control/ADT_AC.thy index 37d584493..6f18fb2bb 100644 --- a/proof/access-control/ADT_AC.thy +++ b/proof/access-control/ADT_AC.thy @@ -304,6 +304,7 @@ lemma dmo_um_upd_machine_state: "\\s. P (device_state (machine_state s))\ do_machine_op (user_memory_update ms) \\_ s. P (device_state (machine_state s))\" + including no_pre apply (wp dmo_wp) by (simp add:user_memory_update_def simpler_modify_def valid_def) @@ -313,20 +314,20 @@ lemma do_user_op_respects: \\rv. integrity aag X st\" apply (simp add: do_user_op_def) apply (wp | simp | wpc)+ - apply (rule dmo_device_update_respects_Write) - apply (wp dmo_um_upd_machine_state - dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift - | wpc | clarsimp)+ - apply (rule hoare_pre_cont) - apply (wp select_wp | wpc | clarsimp)+ + apply (rule dmo_device_update_respects_Write) + apply (wp dmo_um_upd_machine_state + dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift + | wpc | clarsimp)+ + apply (rule hoare_pre_cont) + apply (wp select_wp | wpc | clarsimp)+ apply (simp add: restrict_map_def split:if_splits) apply (rule conjI) apply (clarsimp split: if_splits) apply (drule_tac auth=Write in user_op_access') - apply (simp add: vspace_cap_rights_to_auth_def)+ + apply (simp add: vspace_cap_rights_to_auth_def)+ apply (rule conjI,simp) apply (clarsimp split: if_splits) - apply (drule_tac auth=Write in user_op_access') + apply (drule_tac auth=Write in user_op_access') apply (simp add: vspace_cap_rights_to_auth_def)+ done diff --git a/proof/access-control/Arch_AC.thy b/proof/access-control/Arch_AC.thy index a9455fd6e..10ba374e3 100644 --- a/proof/access-control/Arch_AC.thy +++ b/proof/access-control/Arch_AC.thy @@ -622,7 +622,7 @@ lemma set_mrs_integrity_autarch: apply (fastforce simp add: le_eq_less_or_eq) apply (simp add: msg_max_length_def msg_align_bits) apply simp - apply (wp set_object_integrity_autarch hoare_drop_imps hoare_vcg_all_lift) + apply (wp set_object_integrity_autarch hoare_drop_imps hoare_vcg_all_lift)+ apply simp done @@ -1264,11 +1264,8 @@ lemma delete_asid_respects: "\integrity aag X st and pas_refined aag and invs and K (is_subject aag pd)\ delete_asid asid pd \\rv. integrity aag X st\" - apply (simp add: delete_asid_def) - apply (wp set_asid_pool_respects_clear | simp | wpc)+ - apply (wp hoare_vcg_all_lift) - apply (clarsimp simp: obj_at_def pas_refined_refl) - done + by (wpsimp wp: set_asid_pool_respects_clear hoare_vcg_all_lift + simp: obj_at_def pas_refined_refl delete_asid_def) end diff --git a/proof/access-control/CNode_AC.thy b/proof/access-control/CNode_AC.thy index 9ee8a8139..60b8f518c 100644 --- a/proof/access-control/CNode_AC.thy +++ b/proof/access-control/CNode_AC.thy @@ -99,13 +99,13 @@ lemma list_integ_lift: assumes rq: "\P. \ \s. P (ready_queues s) \ f \ \rv s. P (ready_queues s) \" shows "\integrity aag X st and Q\ f \\_. integrity aag X st\" apply (rule hoare_pre) - apply (unfold integrity_def[abs_def]) - apply (simp only: integrity_cdt_list_as_list_integ) - apply (rule hoare_lift_Pf2[where f="ekheap"]) - apply (simp add: tcb_states_of_state_def get_tcb_def) - apply (wp li ekh rq) + apply (unfold integrity_def[abs_def]) apply (simp only: integrity_cdt_list_as_list_integ) - apply (simp add: tcb_states_of_state_def get_tcb_def) + apply (rule hoare_lift_Pf2[where f="ekheap"]) + apply (simp add: tcb_states_of_state_def get_tcb_def) + apply (wp li ekh rq)+ + apply (simp only: integrity_cdt_list_as_list_integ) + apply (simp add: tcb_states_of_state_def get_tcb_def) done end @@ -157,7 +157,7 @@ proof (induct arbitrary: s rule: resolve_address_bits'.induct) apply (cases cap', simp_all add: P split del: if_split) apply (rule hoare_pre_spec_validE) apply (wp "1.hyps", (assumption | simp add: in_monad | rule conjI)+) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (auto simp: cte_wp_at_caps_of_state is_cap_simps cap_auth_conferred_def dest: caps_of_state_pasObjectAbs_eq) done @@ -562,11 +562,11 @@ interpretation Arch . (*FIXME: arch_split*) lemma pas_refined_tcb_domain_map_wellformed[wp]: assumes tdmw: "\tcb_domain_map_wellformed aag\ f \\_. tcb_domain_map_wellformed aag\" shows "\pas_refined aag\ f \\_. pas_refined aag\" -apply (simp add: pas_refined_def) -apply (wp tdmw) -apply (wp lift_inv) -apply simp -done + apply (simp add: pas_refined_def) + apply (wp tdmw) + apply (wp lift_inv) + apply simp+ + done end @@ -1207,8 +1207,7 @@ crunch integrity_autarch: set_asid_pool "integrity aag X st" (* FIXME: move *) lemma a_type_arch_object_not_tcb[simp]: "a_type (ArchObj arch_kernel_obj) \ ATCB" - apply (auto simp: a_type_def) - done + by auto crunch cur_domain[wp]: cap_swap_for_delete, empty_slot, finalise_cap "\s. P (cur_domain s)" (wp: crunch_wps select_wp hoare_vcg_if_lift2 simp: unless_def) @@ -1219,17 +1218,13 @@ lemma preemption_point_cur_domain[wp]: lemma rec_del_cur_domain[wp]: "\\s. P (cur_domain s)\ rec_del call \\_ s. P (cur_domain s)\" - apply (rule rec_del_preservation) - apply wp - done + by (rule rec_del_preservation; wp) crunch cur_domain[wp]: cap_delete "\s. P (cur_domain s)" lemma cap_revoke_cur_domain[wp]: "\\s. P (cur_domain s)\ cap_revoke slot \\_ s. P (cur_domain s)\" - apply (rule cap_revoke_preservation2) - apply wp - done + by (rule cap_revoke_preservation2; wp) lemma cnode_inv_auth_derivations_If_Insert_Move: "cnode_inv_auth_derivations ((if P then MoveCall else InsertCall) cap src_slot dest_slot) diff --git a/proof/access-control/DomainSepInv.thy b/proof/access-control/DomainSepInv.thy index 2c22b3a3f..ae9ffe535 100644 --- a/proof/access-control/DomainSepInv.thy +++ b/proof/access-control/DomainSepInv.thy @@ -222,11 +222,11 @@ lemma weak_derived_DomainCap: lemma cte_wp_at_weak_derived_domain_sep_inv_cap: "\domain_sep_inv irqs st s; cte_wp_at (weak_derived cap) slot s\ \ domain_sep_inv_cap irqs cap" -apply (cases slot) -apply (force simp: domain_sep_inv_def domain_sep_inv_cap_def - split: cap.splits - dest: cte_wp_at_eqD weak_derived_irq_handler weak_derived_DomainCap) -done + apply (cases slot) + apply (force simp: domain_sep_inv_def domain_sep_inv_cap_def + split: cap.splits + dest: cte_wp_at_eqD weak_derived_irq_handler weak_derived_DomainCap) + done lemma is_derived_IRQHandlerCap: "is_derived m src (IRQHandlerCap irq) cap \ (cap = IRQHandlerCap irq)" @@ -313,7 +313,7 @@ lemma deleted_irq_handler_domain_sep_inv: apply(simp add: deleted_irq_handler_def) apply(simp add: set_irq_state_def) apply wp - apply(rule domain_sep_inv_triv, wp) + apply(rule domain_sep_inv_triv, wp+) apply(simp add: domain_sep_inv_def) done @@ -321,12 +321,9 @@ lemma empty_slot_domain_sep_inv: "\\s. domain_sep_inv irqs st s \ (\ irqs \ b = None)\ empty_slot a b \\_ s. domain_sep_inv irqs st s\" - apply(simp add: empty_slot_def) - apply (wp | wpc)+ - - apply(wp get_cap_wp set_cap_domain_sep_inv set_original_wp dxo_wp_weak static_imp_wp deleted_irq_handler_domain_sep_inv | simp | blast)+ - done - + unfolding empty_slot_def + by (wpsimp wp: get_cap_wp set_cap_domain_sep_inv set_original_wp dxo_wp_weak static_imp_wp + deleted_irq_handler_domain_sep_inv) lemma set_endpoint_neg_cte_wp_at[wp]: "\\s. \ cte_wp_at P slot s\ set_endpoint a b \\_ s. \ cte_wp_at P slot s\" @@ -486,6 +483,7 @@ crunch domain_sep_inv[wp]: finalise_cap "domain_sep_inv irqs st" lemma finalise_cap_domain_sep_inv_cap: "\\s. domain_sep_inv_cap irqs cap\ finalise_cap cap b \\rv s. domain_sep_inv_cap irqs (fst rv)\" + including no_pre apply(case_tac cap) apply(wp | simp add: o_def split del: if_split split: cap.splits arch_cap.splits | fastforce split: if_splits simp: domain_sep_inv_cap_def)+ apply(rule hoare_pre, wp, fastforce) @@ -589,7 +587,7 @@ lemma cap_revoke_domain_sep_inv': show ?case apply(subst cap_revoke.simps) apply(rule hoare_pre_spec_validE) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply(wp spec_valid_conj_liftE2 | simp)+ apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_domain_sep_inv]] drop_spec_validE[OF valid_validE[OF cap_delete_domain_sep_inv]] @@ -916,6 +914,7 @@ lemma invoke_control_domain_sep_inv: "\domain_sep_inv irqs st and irq_control_inv_valid blah\ invoke_irq_control blah \\_. domain_sep_inv irqs st\" + including no_pre apply(case_tac blah) apply(wp cap_insert_domain_sep_inv' | simp )+ apply(case_tac irqs) @@ -965,13 +964,9 @@ lemma transfer_caps_domain_sep_inv: real_cte_at (snd x) s))\ transfer_caps mi caps endpoint receiver receive_buffer \\_. domain_sep_inv irqs st\" - apply (simp add: transfer_caps_def) - apply (wpc | wp)+ - apply(rule transfer_caps_loop_pres_dest) - apply(wp cap_insert_domain_sep_inv | simp )+ - apply(wp hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+ - apply(fastforce elim: cte_wp_at_weakenE) - apply simp + unfolding transfer_caps_def + apply (wpsimp wp: transfer_caps_loop_pres_dest cap_insert_domain_sep_inv hoare_vcg_all_lift hoare_vcg_imp_lift) + apply (fastforce elim: cte_wp_at_weakenE) done @@ -1014,8 +1009,8 @@ lemma send_ipc_domain_sep_inv: apply (wp setup_caller_cap_domain_sep_inv | wpc | simp)+ apply(rule_tac Q="\ r s. domain_sep_inv irqs st s" in hoare_strengthen_post) apply(wp do_ipc_transfer_domain_sep_inv dxo_wp_weak | wpc | simp)+ - apply(wp_once hoare_drop_imps) - apply (wp get_endpoint_wp) + apply (wp_once hoare_drop_imps) + apply (wp get_endpoint_wp)+ apply clarsimp apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def ep_q_refs_of_def ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong @@ -1120,9 +1115,7 @@ lemma thread_set_tcb_ipc_buffer_update_domain_sep_inv[wp]: "\domain_sep_inv irqs st\ thread_set (tcb_ipc_buffer_update f) t \\_. domain_sep_inv irqs st\" - apply(rule domain_sep_inv_triv) - apply wp - done + by (rule domain_sep_inv_triv; wp) lemma thread_set_tcb_fault_handler_update_neg_cte_wp_at[wp]: "\\s. \ cte_wp_at P slot s\ @@ -1147,9 +1140,7 @@ lemma thread_set_tcb_fault_handler_update_domain_sep_inv[wp]: "\domain_sep_inv irqs st\ thread_set (tcb_fault_handler_update blah) t \\_. domain_sep_inv irqs st\" - apply(rule domain_sep_inv_triv) - apply wp - done + by (rule domain_sep_inv_triv; wp) lemma thread_set_tcb_tcb_mcpriority_update_neg_cte_wp_at[wp]: "\\s. \ cte_wp_at P slot s\ @@ -1174,9 +1165,7 @@ lemma thread_set_tcb_tcp_mcpriority_update_domain_sep_inv[wp]: "\domain_sep_inv irqs st\ thread_set (tcb_mcpriority_update blah) t \\_. domain_sep_inv irqs st\" - apply(rule domain_sep_inv_triv) - apply wp - done + by (rule domain_sep_inv_triv; wp) lemma same_object_as_domain_sep_inv_cap: "\same_object_as a cap; domain_sep_inv_cap irqs cap\ diff --git a/proof/access-control/Finalise_AC.thy b/proof/access-control/Finalise_AC.thy index 5d99dca4c..e99ced307 100644 --- a/proof/access-control/Finalise_AC.thy +++ b/proof/access-control/Finalise_AC.thy @@ -78,7 +78,7 @@ lemma cancel_badged_sends_respects[wp]: apply (wp sts_respects_restart_ep hoare_vcg_const_Ball_lift sts_st_tcb_at_neq|simp)+ apply clarsimp apply fastforce - apply (wp set_endpoinintegrity hoare_vcg_const_Ball_lift get_endpoint_wp) + apply (wp set_endpoinintegrity hoare_vcg_const_Ball_lift get_endpoint_wp)+ apply clarsimp apply (frule(1) sym_refs_ko_atD) apply (frule ko_at_state_refs_ofD) @@ -137,9 +137,9 @@ lemma gbn_pas_refined[wp]: lemma set_bound_notification_ekheap[wp]: "\\s. P (ekheap s)\ set_bound_notification t st \\rv s. P (ekheap s)\" -apply (simp add: set_bound_notification_def) -apply (wp set_scheduler_action_wp | simp)+ -done + apply (simp add: set_bound_notification_def) + apply (wp set_scheduler_action_wp | simp)+ + done lemma sbn_thread_states[wp]: "\\s. P (thread_states s)\ set_bound_notification t ntfn \\rv s. P (thread_states s)\" @@ -191,6 +191,7 @@ crunch pas_refined[wp]: set_vm_root "pas_refined aag" lemma reply_cancel_ipc_pas_refined[wp]: "\pas_refined aag and K (is_subject aag t)\ reply_cancel_ipc t \\rv. pas_refined aag\" + including no_pre apply (rule hoare_gen_asm) apply (simp add: reply_cancel_ipc_def) apply (wp select_wp) @@ -451,7 +452,8 @@ lemma finalise_cap_respects[wp]: aag_cap_auth_def unbind_maybe_notification_def elim!: pas_refined_Control[symmetric])+)[3] (* tcb cap *) - apply (wp unbind_notification_respects unbind_notification_invs + including no_pre + apply (wp unbind_notification_respects unbind_notification_invs | clarsimp simp: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def unbind_maybe_notification_def elim!: pas_refined_Control[symmetric] @@ -501,6 +503,7 @@ lemma finalise_cap_auth': "\pas_refined aag and K (pas_cap_cur_auth aag cap)\ finalise_cap cap final \\rv s. pas_cap_cur_auth aag (fst rv)\" + including no_pre apply (rule hoare_gen_asm) apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split) apply (wp @@ -517,11 +520,7 @@ lemma finalise_cap_auth': lemma finalise_cap_obj_refs: "\\s. \x \ obj_refs cap. P x\ finalise_cap cap slot \\rv s. \x \ obj_refs (fst rv). P x\" apply (cases cap) - apply (wp | simp add: o_def | rule impI TrueI conjI)+ - apply (simp add: arch_finalise_cap_def) - apply (rule hoare_pre) - apply (wp | wpc)+ - apply simp + apply (wpsimp simp: arch_finalise_cap_def o_def|rule conjI)+ done lemma zombie_ptr_emptyable: @@ -609,7 +608,7 @@ next apply (subst rec_del.simps) apply (simp only: split_def) apply (rule hoare_pre_spec_validE) - apply (wp set_cap_integrity_autarch "2.hyps" static_imp_wp, assumption+) + apply (wp set_cap_integrity_autarch "2.hyps" static_imp_wp) apply ((wp preemption_point_inv' | simp add: integrity_subjects_def pas_refined_def)+)[1] apply (simp(no_asm)) apply (rule spec_strengthen_postE) @@ -653,7 +652,7 @@ next apply (erule_tac s = "{r}" in subst) apply simp apply (simp add: is_final_cap_def) - apply (wp get_cap_auth_wp [where aag = aag]) + apply (wp get_cap_auth_wp [where aag = aag])+ apply (clarsimp simp: pas_refined_wellformed cte_wp_at_caps_of_state conj_comms) apply (frule (1) caps_of_state_valid) apply (frule if_unsafe_then_capD [OF caps_of_state_cteD], clarsimp+) @@ -666,7 +665,7 @@ next case (3 ptr bits n slot s) show ?case apply (simp add: rec_del_call.simps simp_thms spec_validE_def) - apply (rule hoare_pre, wp static_imp_wp) + apply (wp static_imp_wp) apply clarsimp done @@ -803,10 +802,7 @@ lemma pas_refined_set_asid_table_empty_strg: lemma set_asid_pool_ko_at[wp]: "\\\ set_asid_pool ptr pool \\rv. ko_at (ArchObj (arch_kernel_obj.ASIDPool pool)) ptr\" - apply (simp add: set_asid_pool_def set_object_def) - apply wp - apply (simp add: obj_at_def hoare_post_taut) - done + by (wpsimp simp: obj_at_def set_asid_pool_def set_object_def) (* The contents of the delete_access_control locale *) @@ -840,7 +836,7 @@ proof (induct rule: cap_revoke.induct[where ?a1.0=s]) apply (subst cap_revoke.simps) apply (rule hoare_pre_spec_validE) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply ((wp preemption_point_inv' | simp add: integrity_subjects_def pas_refined_def)+)[1] apply (wp select_ext_weak_wp cap_delete_respects cap_delete_pas_refined | simp split del: if_split | wp_once hoare_vcg_const_imp_lift hoare_drop_imps)+ @@ -873,6 +869,7 @@ lemma valid_specE_validE: lemma deleting_irq_handler_caps_of_state_nullinv: "\\s. \p. P (caps_of_state s(p \ cap.NullCap))\ deleting_irq_handler irq \\rv s. P (caps_of_state s)\" unfolding deleting_irq_handler_def + including no_pre apply (wp cap_delete_one_caps_of_state hoare_drop_imps) apply (rule hoare_post_imp [OF _ get_irq_slot_inv]) apply fastforce @@ -882,6 +879,7 @@ lemma finalise_cap_caps_of_state_nullinv: "\\s. P (caps_of_state s) \ (\p. P (caps_of_state s(p \ cap.NullCap)))\ finalise_cap cap final \\rv s. P (caps_of_state s)\" + including no_pre apply (cases cap, simp_all split del: if_split) apply (wp suspend_caps_of_state unbind_notification_caps_of_state unbind_notification_cte_wp_at @@ -903,6 +901,7 @@ lemma finalise_cap_cte_wp_at_nullinv: lemma finalise_cap_fst_ret: "\\s. P cap.NullCap \ (\a b c. P (cap.Zombie a b c)) \ finalise_cap cap is_final\\rv s. P (fst rv)\" + including no_pre apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split) apply (wp | simp add: comp_def split del: if_split | fastforce)+ apply (rule hoare_pre) @@ -944,13 +943,13 @@ next rec_del_call.simps) apply (wp static_imp_wp) apply (wp set_cap_cte_wp_at')[1] - apply (wp "2.hyps"[simplified without_preemption_def rec_del_call.simps], assumption+) + apply (wp "2.hyps"[simplified without_preemption_def rec_del_call.simps]) apply ((wp preemption_point_inv | simp)+)[1] apply simp apply (rule "2.hyps"[simplified exposed_rdcall.simps slot_rdcall.simps simp_thms disj_not1], simp_all)[1] apply (simp add: cte_wp_at_caps_of_state) - apply wp + apply wp+ apply (rule_tac Q = "\rv' s. (slot \ p \ exposed \ cte_wp_at P p s) \ P (fst rv') \ cte_at slot s" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_caps_of_state) @@ -972,7 +971,7 @@ next apply (subst rec_del.simps) apply wp apply (simp add: cte_wp_at_caps_of_state) - apply wp + apply wp+ apply simp apply (wp get_cap_wp)[1] apply (rule spec_strengthen_postE) diff --git a/proof/access-control/Interrupt_AC.thy b/proof/access-control/Interrupt_AC.thy index 56dd26821..d5f82be62 100644 --- a/proof/access-control/Interrupt_AC.thy +++ b/proof/access-control/Interrupt_AC.thy @@ -30,10 +30,8 @@ lemma invoke_irq_control_pas_refined: invoke_irq_control irq_ctl_inv \\rv. pas_refined aag\" apply (cases irq_ctl_inv, simp_all add: arch_invoke_irq_control_def) - apply (wp cap_insert_pas_refined | simp)+ - apply (clarsimp simp add: clas_no_asid cap_links_irq_def - authorised_irq_ctl_inv_def aag_cap_auth_def) - apply simp + apply (wpsimp wp: cap_insert_pas_refined) + apply (clarsimp simp: clas_no_asid cap_links_irq_def authorised_irq_ctl_inv_def aag_cap_auth_def) done definition @@ -90,7 +88,7 @@ lemma decode_irq_control_invocation_authorised [wp]: apply (simp add: Let_def split del: if_split cong: if_cong) apply (wp whenE_throwError_wp hoare_vcg_imp_lift hoare_drop_imps | strengthen aag_Control_owns_strg - | simp add: o_def del: hoare_post_taut hoare_True_E_R)+ + | simp add: o_def del: hoare_True_E_R)+ apply (cases args, simp_all) apply (cases caps, simp_all) apply (simp add: ucast_mask_drop) diff --git a/proof/access-control/Ipc_AC.thy b/proof/access-control/Ipc_AC.thy index a99cc0d69..a3d05a834 100644 --- a/proof/access-control/Ipc_AC.thy +++ b/proof/access-control/Ipc_AC.thy @@ -213,13 +213,11 @@ lemma store_word_offs_respects: done - - lemma ipc_buffer_has_auth_None [simp]: "ipc_buffer_has_auth aag receiver None" unfolding ipc_buffer_has_auth_def by simp -(* MOVE *) +(* FIXME: MOVE *) lemma cap_auth_caps_of_state: "\ caps_of_state s p = Some cap; pas_refined aag s\ \ aag_cap_auth aag (pasObjectAbs aag (fst p)) cap" @@ -338,7 +336,7 @@ lemma set_mrs_respects_in_signalling': apply (wp mapM_x_wp' dmo_storeWord_respects_ipc [where thread = thread and ep = ep]) apply (fastforce simp add: set_zip nth_append simp: msg_align_bits msg_max_length_def split: if_split_asm) - apply wp + apply wp+ apply (rule impI) apply (subgoal_tac "\c'. integrity aag X st (s\kheap := kheap s(thread \ @@ -705,7 +703,7 @@ next | assumption | simp split del: if_split)+ apply (rule cap_insert_assume_null) - apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at) + apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at)+ (* cannot blindly use derive_cap_is_derived_foo here , need to first hoist out of the postcondition the conjunct that the return value is derived, and solve this using derived_cap_is_derived, and then solve the rest @@ -716,7 +714,7 @@ next prefer 2 apply clarsimp apply assumption - apply(wp derive_cap_is_derived_foo) + apply(wp derive_cap_is_derived_foo)+ apply (simp only: tl_drop_1[symmetric]) apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_to_cnode_always_appropriate_strg @@ -802,7 +800,7 @@ lemma get_receive_slots_authorised: | rule hoare_drop_imps | simp add: add: lookup_cap_def split_def)+ apply (strengthen cnode_cap_all_auth_owns, simp add: aag_cap_auth_def) - apply (wp hoare_vcg_all_lift_R hoare_drop_imps) + apply (wp hoare_vcg_all_lift_R hoare_drop_imps)+ apply clarsimp apply (fastforce simp: is_cap_simps) done @@ -858,15 +856,14 @@ next show ?case using Cons.prems apply (cases c) apply (simp split del: if_split cong: if_cong) - apply (rule hoare_pre) apply (wp) - apply (elim conjE, erule subst, rule Cons.hyps) - apply fastforce - apply (wp hoare_vcg_ball_lift Cons.hyps) - apply (fastforce dest: in_set_dropD in_set_dropD[where n=1, folded tl_drop_1]) - apply (wp cap_insert_pas_refined hoare_vcg_ball_lift hoare_whenE_wp hoare_drop_imps - derive_cap_aag_caps - | simp split del: if_split add: if_apply_def2)+ + apply (elim conjE, erule subst, rule Cons.hyps) + apply fastforce + apply (wp hoare_vcg_ball_lift Cons.hyps)+ + apply (fastforce dest: in_set_dropD in_set_dropD[where n=1, folded tl_drop_1]) + apply (wp cap_insert_pas_refined hoare_vcg_ball_lift hoare_whenE_wp hoare_drop_imps + derive_cap_aag_caps + | simp split del: if_split add: if_apply_def2)+ done qed @@ -941,10 +938,7 @@ lemma lcs_valid': lemma lec_valid_cap': "\valid_objs\ lookup_extra_caps thread xa mi \\rv s. (\x\set rv. s \ fst x)\, -" unfolding lookup_extra_caps_def - apply (wp mapME_set lcs_valid') - apply clarsimp - apply wp - done + by (wpsimp wp: mapME_set lcs_valid') lemma do_normal_transfer_pas_refined: @@ -1010,29 +1004,22 @@ lemma send_ipc_pas_refined: apply (simp add: send_ipc_def) apply (rule hoare_seq_ext[OF _ get_endpoint_sp]) apply (rule hoare_pre) - - apply wpc - apply wpc - apply (wp set_thread_state_pas_refined) - apply wpc - apply (wp set_thread_state_pas_refined) - apply wpc - apply (wp set_thread_state_pas_refined) - apply (simp add: hoare_if_r_and split del:if_split) - apply (rename_tac list x xs recv_state) - apply (rule_tac Q="\rv. pas_refined aag and K (can_grant \ is_subject aag (hd list))" + apply (wpc | wp set_thread_state_pas_refined)+ + apply (simp add: hoare_if_r_and split del:if_split) + apply (rename_tac list x xs recv_state) + apply (rule_tac Q="\rv. pas_refined aag and K (can_grant \ is_subject aag (hd list))" in hoare_strengthen_post[rotated]) - apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid) - apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp - | wpc - | simp add: hoare_if_r_and)+ - apply (rename_tac list x xs) - apply (rule_tac Q="\rv. valid_objs and pas_refined aag and K (can_grant \ is_subject aag (hd list))" in hoare_strengthen_post[rotated]) - apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid) - apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp - | wpc - | simp add: hoare_if_r_and - | rule hoare_drop_imps)+ + apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid) + apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp + | wpc + | simp add: hoare_if_r_and)+ + apply (rename_tac list x xs) + apply (rule_tac Q="\rv. valid_objs and pas_refined aag and K (can_grant \ is_subject aag (hd list))" in hoare_strengthen_post[rotated]) + apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid) + apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp + | wpc + | simp add: hoare_if_r_and + | rule hoare_drop_imps)+ apply clarsimp apply (rule obj_at_valid_objsE, assumption+) apply (clarsimp cong: conj_cong imp_cong simp: tcb_at_st_tcb_at conj_comms) @@ -1264,7 +1251,7 @@ lemma get_mi_valid': "\\\ get_message_info a \\rv s. valid_message_info rv\" apply (simp add: get_message_info_def) apply (wp, rule hoare_post_imp, rule data_to_message_info_valid) - apply wp + apply wp+ done lemma lookup_extra_caps_length: @@ -1728,6 +1715,7 @@ lemma cap_insert_ext_integrity_in_ipc: apply (clarsimp simp: integrity_tcb_in_ipc_def integrity_def tcb_states_of_state_def get_tcb_def split del: if_split cong: if_cong) + including no_pre apply wp apply (rule hoare_vcg_conj_lift) apply (simp add: list_integ_def del: split_paired_All) @@ -1855,7 +1843,7 @@ lemma set_mrs_respects_in_ipc: apply (simp add: length_msg_registers) apply arith apply simp - apply wp + apply wp+ apply (fastforce intro: update_tcb_context_in_ipc [unfolded fun_upd_def]) done diff --git a/proof/access-control/Retype_AC.thy b/proof/access-control/Retype_AC.thy index 860740427..e6431ff78 100644 --- a/proof/access-control/Retype_AC.thy +++ b/proof/access-control/Retype_AC.thy @@ -152,9 +152,9 @@ lemma copy_global_mappings_integrity: apply (rule hoare_gen_asm) apply (simp add: copy_global_mappings_def) apply (wp mapM_x_wp[OF _ subset_refl] store_pde_integrity) - apply (drule subsetD[OF copy_global_mappings_index_subset]) - apply (fastforce simp: pd_shifting') - apply(wp) + apply (drule subsetD[OF copy_global_mappings_index_subset]) + apply (fastforce simp: pd_shifting') + apply wpsimp+ done lemma dmo_mol_respects: @@ -164,7 +164,7 @@ lemma dmo_mol_respects: apply wp apply clarsimp apply (erule use_valid) - apply (wp mol_respects) + apply (wp mol_respects) apply simp done @@ -182,11 +182,8 @@ lemma dmo_mapM_wp: shows "set xs \ S \ \P\ do_machine_op (mapM f xs) \\rv. P\" apply (induct xs) apply (simp add: mapM_def sequence_def) - apply (simp add: mapM_Cons) - apply (simp add: dmo_bind_valid dmo_bind_valid') - apply wp - apply assumption - apply (simp add: x) + apply (simp add: mapM_Cons dmo_bind_valid dmo_bind_valid') + apply (wpsimp | rule x)+ done lemma dmo_mapM_x_wp: @@ -207,7 +204,7 @@ lemma dmo_cacheRangeOp_lift: \ \P\ do_machine_op (cacheRangeOp oper x y z) \\_. P\" apply (simp add: cacheRangeOp_def) apply (wp dmo_mapM_x_wp_inv) - apply (simp add: split_def) + apply (simp add: split_def)+ done lemma dmo_cleanCacheRange_PoU_respects [wp]: @@ -428,7 +425,7 @@ lemma dmo_clearMemory_respects': apply (erule use_valid) apply wp apply (simp add: cleanByVA_PoU_def) - apply (wp mol_respects mapM_x_wp' storeWord_respects) + apply (wp mol_respects mapM_x_wp' storeWord_respects)+ apply simp apply (clarsimp simp add: word_size_def upto_enum_step_shift_red [where us = 2, simplified]) apply (erule bspec) @@ -476,7 +473,7 @@ lemma reset_untyped_cap_integrity: apply (simp add: word_bits_def) apply clarsimp apply (simp add: if_apply_def2) - apply (wp hoare_vcg_const_imp_lift get_cap_wp) + apply (wp hoare_vcg_const_imp_lift get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule caps_of_state_valid_cap, clarsimp+) apply (clarsimp simp: cap_aligned_def is_cap_simps valid_cap_simps bits_of_def) @@ -791,6 +788,7 @@ context begin interpretation Arch . (*FIXME: arch_split*) lemma retype_region_ext_pas_refined: "\pas_refined aag and pas_cur_domain aag and K (\x\ set xs. is_subject aag x)\ retype_region_ext xs ty \\_. pas_refined aag\" + including no_pre apply (subst and_assoc[symmetric]) apply (wp retype_region_ext_extended.pas_refined_tcb_domain_map_wellformed') apply (simp add: retype_region_ext_def, wp) @@ -817,12 +815,12 @@ lemma retype_region_pas_refined: \\rv. pas_refined aag\" apply (rule hoare_gen_asm) apply (rule hoare_pre) - apply(rule use_retype_region_proofs_ext) - apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro]) - apply (wp retype_region_ext_pas_refined) - apply simp - apply auto - done + apply(rule use_retype_region_proofs_ext) + apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro]) + apply (wp retype_region_ext_pas_refined) + apply simp + apply auto + done (* MOVE *) lemma retype_region_aag_bits: @@ -919,8 +917,8 @@ lemma freeMemory_vms: apply (simp add: freeMemory_def machine_op_lift_def machine_rest_lift_def split_def) apply (wp hoare_drop_imps | simp | wp mapM_x_wp_inv)+ - apply (simp add: storeWord_def | wp)+ - apply (simp add: word_rsplit_0) + apply (simp add: storeWord_def | wp)+ + apply (simp add: word_rsplit_0)+ done @@ -1481,7 +1479,7 @@ lemma decode_untyped_invocation_authorised: apply (fastforce simp: nonzero_unat_simp) apply(clarsimp simp: K_def) apply(wp lookup_slot_for_cnode_op_authorised - lookup_slot_for_cnode_op_inv whenE_throwError_wp) + lookup_slot_for_cnode_op_inv whenE_throwError_wp)+ apply(rule hoare_drop_imps)+ apply(clarsimp) apply(rule_tac Q'="\rv s. rv \ ArchObject ASIDPoolObj \ @@ -1495,7 +1493,7 @@ lemma decode_untyped_invocation_authorised: in hoare_post_imp_R) apply(wp data_to_obj_type_ret_not_asid_pool data_to_obj_type_inv2) apply(case_tac "excaps ! 0", simp_all, fastforce simp: nonzero_unat_simp)[1] - apply(wp whenE_throwError_wp) + apply(wp whenE_throwError_wp)+ apply(auto dest!: bang_0_in_set simp: valid_cap_def cap_aligned_def obj_ref_of_def is_cap_simps cap_auth_conferred_def pas_refined_all_auth_is_owns diff --git a/proof/access-control/Syscall_AC.thy b/proof/access-control/Syscall_AC.thy index 906cd9d45..3356e14c3 100644 --- a/proof/access-control/Syscall_AC.thy +++ b/proof/access-control/Syscall_AC.thy @@ -1161,6 +1161,7 @@ lemma dxo_current_ipc_buffer_register[wp]: lemma dxo_current_ipc_buffer_register_kheap_upd: "\\s. P (current_ipc_buffer_register (s\kheap:=kh\))\ do_extended_op eop \\r s. P (current_ipc_buffer_register (s\kheap:=kh\))\" + including no_pre apply (simp | wp dxo_wp_weak)+ apply (rule arg_cong[where f = P]) apply (simp add: trans_state_def current_ipc_buffer_register_def get_tcb_def) @@ -1224,6 +1225,7 @@ lemma retype_region_current_ipc_buffer_register: lemma cancel_signal_current_ipc_buffer_register[wp]: "\\s. P (current_ipc_buffer_register s)\ cancel_signal a b \\r s. P (current_ipc_buffer_register s)\" + including no_pre apply (clarsimp simp: cancel_signal_def get_notification_def) apply (wp | wpc)+ apply (clarsimp simp: get_object_def set_object_def valid_def put_def @@ -1237,6 +1239,7 @@ crunch current_ipc_buffer_register [wp]: blocked_cancel_ipc "\s. P (curr lemma reply_cancel_ipc_current_ipc_buffer_register[wp]: "\\s. P (current_ipc_buffer_register s)\ reply_cancel_ipc a \\r s. P (current_ipc_buffer_register s)\" + including no_pre apply (clarsimp simp: reply_cancel_ipc_def) apply (wp select_wp| wpc)+ apply (rule_tac Q = "\r s. P (current_ipc_buffer_register s)" in hoare_post_imp) @@ -1275,11 +1278,7 @@ abbreviation (input) lemma rec_del_current_ipc_buffer_register [wp]: "invariant (rec_del call) (\s. P (current_ipc_buffer_register s))" - apply (rule rec_del_preservation) - apply wp - apply (wp preemption_point_inv) - apply simp+ - done + by (rule rec_del_preservation; wpsimp wp: preemption_point_inv) crunch current_ipc_buffer_register [wp]: cap_delete "\s. P (current_ipc_buffer_register s)" (wp: crunch_wps simp: crunch_simps) @@ -1287,9 +1286,7 @@ crunch current_ipc_buffer_register [wp]: cap_delete "\s. P (current_ipc_ lemma cap_revoke_current_ipc_buffer_register [wp]: "invariant (cap_revoke slot) (\s. P (current_ipc_buffer_register s))" apply (rule validE_valid) - apply (rule cap_revoke_preservation) - apply (wp preemption_point_inv) - apply simp+ + apply (rule cap_revoke_preservation; wpsimp wp: preemption_point_inv) done end @@ -1510,12 +1507,11 @@ lemma cancel_all_ipc_ct_active[wp]: "\ct_active\ cancel_all_ipc ptr \\_. ct_active \" - apply (rule hoare_pre) - apply (wp mapM_x_wp | wps | simp add: cancel_all_ipc_def | wpc)+ + apply (wp mapM_x_wp | wps | simp add: cancel_all_ipc_def | wpc)+ apply force - apply (wp mapM_x_wp) + apply (wp mapM_x_wp)+ apply force - apply (wp hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift) + apply (wp hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift)+ apply simp done @@ -1596,9 +1592,7 @@ crunch idle_thread[wp]: cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_d ignore: without_preemption filterM rec_del check_cap_at cap_revoke ) lemma cap_revoke_idle_thread[wp]:"\\s. P (idle_thread s)\ cap_revoke a \\r s. P (idle_thread s)\" - apply (rule cap_revoke_preservation2) - apply wp - done + by (rule cap_revoke_preservation2; wp) lemma invoke_cnode_idle_thread[wp]: "\\s. P (idle_thread s)\ invoke_cnode a \\r s. P (idle_thread s)\" apply (simp add: invoke_cnode_def) @@ -1643,6 +1637,7 @@ lemma call_kernel_integrity': and K (pasMayActivate aag \ pasMayEditReadyQueues aag)\ call_kernel ev \\_. integrity aag X st\" + including no_pre apply (simp add: call_kernel_def getActiveIRQ_def ) apply (simp add: spec_valid_def) apply (wp activate_thread_respects schedule_integrity_pasMayEditReadyQueues @@ -1653,10 +1648,9 @@ lemma call_kernel_integrity': rule_tac Q = "integrity aag X st and pas_refined aag and einvs and guarded_pas_domain aag and domain_sep_inv (pasMaySendIrqs aag) st' and is_subject aag \ cur_thread and (\_. pasMayActivate aag \ pasMayEditReadyQueues aag)" in valid_validE) - apply (rule hoare_pre) - apply ((wp handle_event_integrity he_invs handle_event_pas_refined - handle_event_cur_thread handle_event_cur_domain - handle_event_domain_sep_inv handle_event_valid_sched | simp)+)[1] + apply (wp handle_event_integrity he_invs handle_event_pas_refined + handle_event_cur_thread handle_event_cur_domain + handle_event_domain_sep_inv handle_event_valid_sched | simp)+ apply (fastforce simp: domain_sep_inv_def)+ apply(fastforce simp: domain_sep_inv_def guarded_pas_domain_def) done @@ -1687,10 +1681,10 @@ lemma call_kernel_pas_refined: apply (simp add: call_kernel_def getActiveIRQ_def) apply (wp activate_thread_pas_refined schedule_pas_refined handle_interrupt_pas_refined do_machine_op_pas_refined dmo_wp alternative_wp select_wp) - apply simp - apply (rule hoare_post_impErr [OF valid_validE [where Q = "pas_refined aag and invs"]]) - apply (wp he_invs handle_event_pas_refined) - apply auto + apply simp + apply (rule hoare_post_impErr [OF valid_validE [where Q = "pas_refined aag and invs"]]) + apply (wp he_invs handle_event_pas_refined) + apply auto done end diff --git a/proof/access-control/Tcb_AC.thy b/proof/access-control/Tcb_AC.thy index a897ff6dd..b4530de7c 100644 --- a/proof/access-control/Tcb_AC.thy +++ b/proof/access-control/Tcb_AC.thy @@ -228,6 +228,7 @@ lemma invoke_tcb_tc_respects_aag: and K (authorised_tcb_inv aag (ThreadControl t sl ep mcp priority croot vroot buf))\ invoke_tcb (ThreadControl t sl ep mcp priority croot vroot buf) \\rv. integrity aag X st and pas_refined aag\" + including no_pre apply (rule hoare_gen_asm)+ apply (subst invoke_tcb.simps) apply (subst set_priority_extended.dxo_eq) @@ -272,7 +273,7 @@ lemma invoke_tcb_tc_respects_aag: checked_insert_no_cap_to out_no_cap_to_trivial[OF ball_tcb_cap_casesI] thread_set_ipc_tcb_cap_valid - cap_delete_pas_refined[THEN valid_validE_E]) + cap_delete_pas_refined[THEN valid_validE_E])+ | simp add: ran_tcb_cap_cases dom_tcb_cap_cases[simplified] emptyable_def del: hoare_post_taut hoare_True_E_R @@ -349,7 +350,7 @@ lemma invoke_tcb_ntfn_control_respects[wp]: invoke_tcb (tcb_invocation.NotificationControl t ntfn) \\rv. integrity aag X st\" apply (case_tac ntfn, simp_all del: invoke_tcb.simps Tcb_AI.tcb_inv_wf.simps K_def) - apply (wp invoke_tcb_bind_notification_respects invoke_tcb_unbind_notification_respects) + apply (wp invoke_tcb_bind_notification_respects invoke_tcb_unbind_notification_respects)+ done lemma invoke_tcb_respects: @@ -504,7 +505,7 @@ lemma decode_set_priority_authorised: \\rv s. authorised_tcb_inv aag rv\, -" unfolding decode_set_priority_def check_prio_def authorised_tcb_inv_def apply (cases msg; simp add: Let_def) - apply (wp validE_validE_R[OF throwError_wp]) + apply (wp validE_validE_R[OF throwError_wp])+ by simp lemma decode_set_mcpriority_authorised: @@ -513,7 +514,7 @@ lemma decode_set_mcpriority_authorised: \\rv s. authorised_tcb_inv aag rv\, -" unfolding decode_set_mcpriority_def check_prio_def authorised_tcb_inv_def apply (cases msg; simp) - apply (wp validE_validE_R[OF throwError_wp]) + apply (wp validE_validE_R[OF throwError_wp])+ by simp lemma decode_unbind_notification_authorised: @@ -545,12 +546,12 @@ lemma decode_tcb_invocation_authorised: \\rv s. authorised_tcb_inv aag rv\,-" unfolding decode_tcb_invocation_def apply (rule hoare_pre) - apply wpc + apply wpc apply (wp decode_registers_authorised decode_tcb_configure_authorised decode_set_priority_authorised decode_set_mcpriority_authorised decode_set_ipc_buffer_authorised decode_set_space_authorised decode_bind_notification_authorised - decode_unbind_notification_authorised) + decode_unbind_notification_authorised)+ by (auto iff: authorised_tcb_inv_def) text{* diff --git a/proof/bisim/Syscall_S.thy b/proof/bisim/Syscall_S.thy index ac06c1b2e..427becf6e 100644 --- a/proof/bisim/Syscall_S.thy +++ b/proof/bisim/Syscall_S.thy @@ -278,7 +278,7 @@ lemma send_fault_ipc_bisim: apply (rule hoare_vcg_seqE) apply (rule hoare_vcg_seqE) apply wpc - apply wp + apply wp+ apply simp apply (rule hoare_post_imp_R [OF lc_sep]) apply (clarsimp simp: separate_cap_def) @@ -293,7 +293,7 @@ lemma send_fault_ipc_bisim: apply (wp not_empty_lc) apply (rule_tac P = "separate_cap xa" in not_empty_gen_asm) apply (erule separate_capE, simp_all)[1] - apply wp + apply wp+ apply simp done @@ -304,11 +304,7 @@ lemma handle_fault_bisim: apply (rule bisim_symb_exec_r [where Pe = \]) apply simp apply (rule send_fault_ipc_bisim) - apply wp - apply simp - apply (simp add: gets_the_def) - apply wp - apply (simp add: tcb_at_def) + apply (wpsimp simp: gets_the_def tcb_at_def)+ done lemmas bisim_throwError_dc = bisim_throwError [where f = dc, OF dc_refl] @@ -414,14 +410,14 @@ lemma handle_invocation_bisim: apply (rule syscall_bisim) apply (rule bisim_split_reflE_dc [where Q = "\_. \" and Q' = "\_. \"])+ apply (rule bisim_reflE_dc) - apply wp + apply wp+ apply (rule bisim_when [OF _ refl]) apply (rule handle_fault_bisim) apply simp apply (rule bisim_split_reflE_eq) apply simp apply (rule decode_invocation_bisim) - apply wp + apply wp+ apply (simp, rule bisim_refl') apply simp apply (rule bisim_split_reflE_dc) @@ -491,15 +487,7 @@ lemma bisim_injection: apply (simp add: z) apply clarsimp apply (rule bisim_return) - apply simp - apply wp - apply simp+ - done - -lemma cap_fault_injection: - "cap_fault_on_failure addr b = injection_handler (ExceptionTypes_A.CapFault addr b)" - apply (rule ext) - apply (simp add: cap_fault_on_failure_def injection_handler_def o_def) + apply wpsimp+ done lemma separate_state_cdt [simp]: @@ -563,14 +551,14 @@ lemma cap_delete_one_sep [wp]: apply (wps set_cdt_typ_at) apply (wp) apply assumption - apply (wp get_cap_inv hoare_drop_imps) + apply (wp get_cap_inv hoare_drop_imps)+ apply (simp add: conj_comms) apply (rule separate_state_pres) apply (rule hoare_pre) - apply (wps ) + apply (wps) apply wp apply simp - apply (wp get_cap_wp') + apply (wp get_cap_wp')+ apply simp done @@ -582,7 +570,7 @@ lemma bisim_caller_cap: apply (rule_tac F = "rv = NullCap" in bisim_gen_asm_r) apply simp apply (rule bs) - apply (wp get_cap_wp') + apply (wp get_cap_wp')+ apply fastforce apply wp apply simp @@ -653,62 +641,57 @@ lemma handle_event_bisim: handle_reply_def cong: syscall.case_cong) - apply (rename_tac syscall) - apply (case_tac syscall, simp_all)[1] + apply (rename_tac syscall) + apply (case_tac syscall, simp_all)[1] - apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) - apply (rule bisim_guard_imp_both) - apply (rule bisim_symb_exec_r_bs) - apply (rule handle_reply_bisim) - apply (rule handle_recv_bisim) - apply simp + apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) + apply (rule bisim_guard_imp_both) + apply (rule bisim_symb_exec_r_bs) + apply (rule handle_reply_bisim) + apply (rule handle_recv_bisim) + apply simp - apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) - apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) - apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp) - apply (rule bisim_guard_imp_both, rule handle_reply_bisim, simp) + apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) + apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp) + apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp) + apply (rule bisim_guard_imp_both, rule handle_reply_bisim, simp) + apply (simp add: handle_yield_def Syscall_A.handle_yield_def) + apply (rule bisim_guard_imp_both, rule bisim_refl', simp) - - apply (simp add: handle_yield_def Syscall_A.handle_yield_def) - apply (rule bisim_guard_imp_both, rule bisim_refl', simp) - - apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp) + apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp) - apply (rule bisim_split_refl) - apply (rule handle_fault_bisim) - apply wp - apply (simp add: cur_tcb_def) + apply (rule bisim_split_refl) + apply (rule handle_fault_bisim) + apply wp+ + apply (simp add: cur_tcb_def) - apply (rule bisim_split_refl) - apply (rule handle_fault_bisim) - apply wp - apply (simp add: cur_tcb_def) - - apply (rule bisim_refl) - apply simp + apply (rule bisim_split_refl) + apply (rule handle_fault_bisim) + apply wp+ + apply (simp add: cur_tcb_def) + + apply (rule bisim_refl) + apply simp apply (rename_tac vmfault_type) apply (rule bisim_guard_imp_both) - apply (rule bisim_split_refl) - apply (rule bisim_split_catch_req) - apply (rule bisim_reflE) - apply (rule handle_fault_bisim) - apply wp - apply (case_tac vmfault_type, simp_all)[1] - apply (wp separate_state_pres) - apply (rule hoare_pre, wps, wp, simp) - apply wp - apply (rule hoare_pre, wps, wp, simp) - apply simp + apply (rule bisim_split_refl) + apply (rule bisim_split_catch_req) + apply (rule bisim_reflE) + apply (rule handle_fault_bisim) + apply wp + apply (case_tac vmfault_type, simp_all)[1] + apply (wp separate_state_pres) + apply (rule hoare_pre, wps, wp, simp) + apply wp + apply (rule hoare_pre, wps, wp, simp) + apply simp - apply (wp separate_state_pres) - apply (rule hoare_pre, wps, wp, simp) - apply wp - apply simp - - apply wp - apply (simp_all add: cur_tcb_def) + apply (wp separate_state_pres)+ + apply (rule hoare_pre, wps, wp+, simp) + apply wp+ + apply (simp add: cur_tcb_def) done lemma call_kernel_bisim: @@ -721,10 +704,9 @@ lemma call_kernel_bisim: apply (rule handle_event_bisim) apply simp apply (rule bisim_refl') - apply wp - apply (rule bisim_refl') - apply wp - apply simp + apply wp+ + apply (rule bisim_refl') + apply wpsimp+ done @@ -787,10 +769,7 @@ lemma decode_invocation_separate_state [wp]: "\ separate_state \ Decode_SA.decode_invocation param_a param_b param_c param_d param_e param_f \ \_. separate_state \" - unfolding decode_invocation_def - apply (rule hoare_pre, wpc, wp) - apply simp - done + unfolding decode_invocation_def by wpsimp lemma separate_state_machine_state: "separate_state (s\machine_state := ms\) = separate_state s" diff --git a/proof/capDL-api/Arch_DP.thy b/proof/capDL-api/Arch_DP.thy index de50998e8..ed7b167f2 100644 --- a/proof/capDL-api/Arch_DP.thy +++ b/proof/capDL-api/Arch_DP.thy @@ -202,7 +202,7 @@ lemma seL4_Page_Table_Map: [where check = True and Perror = \,simplified]) apply fastforce apply (rule set_cap_wp) - apply wp[4] + apply (wp+)[4] apply (rule_tac P = "\asid'. iv = InvokePageTable (PageTableMap (PageTableCap ptr Real asid') (PageTableCap ptr Fake None) (cnode_id,pt_offset) (cdl_lookup_pd_slot pd_ptr vaddr))" @@ -243,7 +243,7 @@ lemma seL4_Page_Table_Map: apply assumption apply clarsimp apply (rule hoare_vcg_E_elim) - apply wp[1] + apply wp apply wp apply (rule validE_validE_R) apply (rule hoare_weaken_preE[where P = \]) @@ -254,7 +254,7 @@ lemma seL4_Page_Table_Map: apply (sep_solve) apply (simp add:lookup_extra_caps_def conj_comms mapME_singleton) apply (rule wp_no_exception_seq) - apply wp[1] + apply wp apply (rule lookup_cap_and_slot_rvu[where r = root_size and cap' = "PageDirectoryCap pd_ptr real_type None"]) apply (rule hoare_pre) @@ -268,35 +268,28 @@ lemma seL4_Page_Table_Map: hoare_vcg_imp_lift) apply clarsimp defer - apply clarsimp - using misc sz - apply (intro conjI impI allI, - simp_all add: - reset_cap_asid_simps2) + apply clarsimp + using misc sz + apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2) apply (sep_solve) apply simp apply sep_solve - apply (clarsimp simp:user_pointer_at_def Let_def - word_bits_def sep_conj_assoc) + apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc) apply sep_solve - apply (clarsimp dest!:reset_cap_asid_simps2 - simp:ep_related_cap_def) - apply (clarsimp simp:user_pointer_at_def Let_def - word_bits_def sep_conj_assoc) + apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def) + apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc) apply (sep_solve) - apply (clarsimp dest!:reset_cap_asid_simps2 - simp:ep_related_cap_def) - apply (clarsimp simp:user_pointer_at_def Let_def - word_bits_def sep_conj_assoc) - apply (sep_solve) + apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def) + apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc) + apply (sep_solve) apply (drule_tac x = "PageTableCap ptr Real None" in spec) - apply clarsimp + apply clarsimp apply (erule impE) apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI) apply simp apply clarsimp - apply (sep_solve) -done + apply (sep_solve) + done lemma seL4_Section_Map_wp: notes split_paired_Ex[simp del] @@ -326,8 +319,7 @@ lemma seL4_Section_Map_wp: \* (cnode_id, pd_offset) \c (PageDirectoryCap pd_ptr real_type None) \* cnode_id \f CNode (empty_cnode root_size) \* R \ s \" - apply (simp add:seL4_Page_Map_def sep_state_projection2_def - del:split_paired_Ex) + apply (simp add:seL4_Page_Map_def sep_state_projection2_def) apply (rule hoare_name_pre_state) apply (rule hoare_pre) apply (rule do_kernel_op_pull_back) @@ -335,7 +327,7 @@ lemma seL4_Section_Map_wp: [where check = True and Perror = \,simplified]) apply fastforce apply (rule set_cap_wp) - apply wp[4] + apply (wp+)[4] apply (rule_tac P = "\asid'. iv = InvokePage (PageMap (FrameCap dev frame_ptr rights n Real asid') (FrameCap False frame_ptr (validate_vm_rights (rights \ perms)) n Fake None) (cnode_id,frame_offset) @@ -380,7 +372,7 @@ lemma seL4_Section_Map_wp: in hoare_post_impErr[rotated -1]) apply assumption apply (rule hoare_vcg_E_elim) - apply wp[1] + apply wp apply wp apply (rule validE_validE_R) apply (rule hoare_weaken_preE[where P = \]) @@ -474,7 +466,7 @@ lemma seL4_Page_Map_wp: [where check = True and Perror = \,simplified]) apply fastforce apply (rule set_cap_wp) - apply wp[4] + apply (wp+)[4] apply (rule_tac P = "\asid'. iv = InvokePage (PageMap (FrameCap dev frame_ptr rights n Real asid') (FrameCap False frame_ptr (validate_vm_rights (rights \ perms)) n Fake None) (cnode_id,frame_offset) @@ -521,7 +513,7 @@ lemma seL4_Page_Map_wp: in hoare_post_impErr[rotated -1]) apply assumption apply (rule hoare_vcg_E_elim) - apply wp[1] + apply wp apply wp apply (rule validE_validE_R) apply (rule_tac P = "

" for P in hoare_weaken_preE) @@ -543,32 +535,30 @@ lemma seL4_Page_Map_wp: hoare_vcg_imp_lift) apply clarsimp defer - apply clarsimp - using misc sz - apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2) + apply clarsimp + using misc sz + apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2) apply (sep_solve) apply (simp add:cdl_lookup_pd_slot_def) apply sep_solve apply simp apply sep_solve - apply (clarsimp simp:user_pointer_at_def Let_def - word_bits_def sep_conj_assoc) + apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc) apply sep_solve - apply (clarsimp dest!:reset_cap_asid_simps2 - simp:ep_related_cap_def) + apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def) apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc) apply (sep_solve) apply sep_solve apply clarsimp apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec) - apply clarsimp + apply clarsimp apply (erule impE) apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI) apply simp apply clarsimp - apply (sep_solve) -done + apply (sep_solve) + done lemma decode_invocation_asid_pool_assign: "\ \s. (c = AsidPoolCap p base) \ @@ -622,9 +612,9 @@ lemma invoke_asid_pool_wp: apply simp apply (rule hoare_strengthen_post[OF set_cap_wp]) apply (sep_solve) - apply wp + apply wp+ apply clarsimp - apply (safe,fastforce+) + apply (safe; fastforce?) apply (subst (asm) set_split_single[where A = "(Collect (\off. off < 2 ^ asid_low_bits))"]) apply simp apply (subst (asm) sep.prod.union_disjoint) @@ -675,7 +665,7 @@ lemma seL4_ASIDPool_Assign_wp: apply (rule call_kernel_with_intent_allow_error_helper[where check = True and Perror = \,simplified]) apply fastforce apply (rule set_cap_wp) - apply wp[4] + apply (wp+)[4] apply (rule_tac P = "\x. x < 2 ^ asid_low_bits \ iv = (InvokeAsidPool (Assign (base, x) (cnode_id,pd_offset) (p, x)))" in hoare_gen_asmEx) @@ -703,7 +693,7 @@ lemma seL4_ASIDPool_Assign_wp: apply (rule decode_invocation_asid_pool_assign) apply (clarsimp simp:conj_comms lookup_extra_caps_def mapME_singleton) apply (rule wp_no_exception_seq) - apply wp[1] + apply wp apply (rule lookup_cap_and_slot_rvu[where r = root_size and cap' = "PageDirectoryCap pd Real None"]) apply (rule hoare_pre) @@ -727,7 +717,7 @@ lemma seL4_ASIDPool_Assign_wp: apply (sep_solve) apply clarsimp apply (drule_tac x = "AsidPoolCap p base" in spec) - apply clarsimp + apply clarsimp apply (erule impE) apply (rule_tac x = "PageDirectoryCap pd Real None" in exI) apply simp diff --git a/proof/capDL-api/CNode_DP.thy b/proof/capDL-api/CNode_DP.thy index 76bd1cea5..1292cae65 100644 --- a/proof/capDL-api/CNode_DP.thy +++ b/proof/capDL-api/CNode_DP.thy @@ -36,15 +36,15 @@ lemma decode_cnode_copy_same_parent_rvu: apply (clarsimp simp:user_pointer_at_def Let_def) apply (clarsimp simp: decode_cnode_invocation_def split_def split: sum.splits) apply (wp hoare_whenE_wp | simp)+ - apply (rule validE_validE_R) - apply (wp derive_cap_invE) - apply (rule validE_validE_R) - apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap]) - apply simp - apply wp + apply (rule validE_validE_R) + apply (wp derive_cap_invE)+ + apply (rule validE_validE_R) + apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap]) + apply simp + apply wp+ apply (rule validE_validE_R) - apply (rule lookup_slot_for_cnode_op_rvu'[where r=sz and cap=NullCap]) - apply (simp, wp throw_on_none_rv validE_R_validE) + apply (rule lookup_slot_for_cnode_op_rvu'[where r=sz and cap=NullCap]) + apply (simp, wp throw_on_none_rv validE_R_validE) apply (clarsimp split: option.splits) apply (intro conjI) apply (clarsimp dest!: mapu_dest_opt_cap simp:conj_comms) @@ -332,7 +332,8 @@ lemma seL4_CNode_Mutate_sep: apply (rule hoare_post_imp[OF _ set_cap_wp]) apply (sep_select 5,assumption) - apply wp[2] + apply wp + apply wp apply (rule_tac P = "\dcap. reset_cap_asid dcap = reset_cap_asid src_cap \ iv = InvokeCNode @@ -372,7 +373,7 @@ lemma seL4_CNode_Mutate_sep: apply (clarsimp simp:sep_any_exist sep_conj_assoc sep_map_c_conj sep_map_f_conj Let_def split:if_splits option.splits,fastforce) - apply (wp set_cap_wp set_cap_all_scheduable_tcbs)[1] + apply (wp set_cap_wp set_cap_all_scheduable_tcbs) apply (rule_tac P = "is_cnode_cap c" in hoare_gen_asmEx) apply (simp add:decode_invocation_simps) apply (rule liftME_wp) @@ -380,7 +381,7 @@ lemma seL4_CNode_Mutate_sep: apply (simp add:lookup_extra_caps_def Let_def mapME_def sequenceE_def get_index_def) apply (rule wp_no_exception_seq) - apply wp[1] + apply wp apply (rule lookup_cap_and_slot_rvu[where r = root_size]) apply (rule lookup_cap_and_slot_rvu[where r = root_size]) apply (rule validE_validE_R) @@ -495,7 +496,8 @@ lemma seL4_CNode_Move_sep: apply (clarsimp simp:sep_conj_assoc) apply (rule hoare_post_imp[OF _ set_cap_wp]) apply (sep_select 5,assumption) - apply wp[2] + apply wp + apply wp apply (rule_tac P = "\dcap. reset_cap_asid dcap = reset_cap_asid src_cap \ iv = InvokeCNode (MoveCall dcap (cap_object cnode_cap', offset src_index root_size) @@ -529,7 +531,7 @@ lemma seL4_CNode_Move_sep: in hoare_strengthen_post[rotated]) apply (clarsimp) apply (sep_select 3,assumption) - apply (wp set_cap_wp set_cap_all_scheduable_tcbs)[1] + apply (wp set_cap_wp set_cap_all_scheduable_tcbs) apply (rule_tac P = "is_cnode_cap c" in hoare_gen_asmEx) apply (simp add:decode_invocation_simps) apply (rule liftME_wp) @@ -537,7 +539,7 @@ lemma seL4_CNode_Move_sep: apply (simp add:lookup_extra_caps_def Let_def mapME_def sequenceE_def get_index_def) apply (rule wp_no_exception_seq) - apply wp[1] + apply wp apply (rule lookup_cap_and_slot_rvu[where r = root_size]) apply (rule lookup_cap_and_slot_rvu[where r = root_size]) apply (rule validE_validE_R) diff --git a/proof/capDL-api/IRQ_DP.thy b/proof/capDL-api/IRQ_DP.thy index d487df98c..bd90072dd 100644 --- a/proof/capDL-api/IRQ_DP.thy +++ b/proof/capDL-api/IRQ_DP.thy @@ -36,29 +36,31 @@ lemma invoke_irq_handler_clear_handler_wp: "\< irq \irq obj \* (obj, 0) \c cap \* R> and K (\ ep_related_cap cap)\ invoke_irq_handler (ClearIrqHandler irq) \\_. < irq \irq obj \* (obj, 0) \c NullCap \* R> \" - apply (clarsimp simp: invoke_irq_handler_def, wp ) + including no_pre + apply (clarsimp simp: invoke_irq_handler_def, wp) apply (sep_wp delete_cap_simple_format[where cap=cap]) apply (safe) apply (frule sep_map_i_cdl_irq, clarsimp simp: get_irq_slot_def) apply (sep_solve) apply (clarsimp) -done + done lemma invoke_irq_handler_set_handler_wp: "\< irq \irq obj \* (obj, 0) \c cap' \* R> and K (\ ep_related_cap cap' \ \ is_untyped_cap cap)\ invoke_irq_handler (SetIrqHandler irq cap slot) \\_. < irq \irq obj \* (obj, 0) \c cap \* R> \" + including no_pre apply (clarsimp simp: invoke_irq_handler_def, wp) apply (wp alternative_wp) - apply (wp sep_wp: insert_cap_child_wp insert_cap_sibling_wp) + apply (wp sep_wp: insert_cap_child_wp insert_cap_sibling_wp)+ apply (sep_wp delete_cap_simple_format[where cap=cap']) apply (safe) apply (clarsimp) apply (frule sep_map_i_cdl_irq, clarsimp simp: get_irq_slot_def) apply (sep_solve) apply (clarsimp) -done + done lemma invoke_irq_control_issue_handler_wp: "\ <(dest_slot) \c cap \* R> \ @@ -111,7 +113,7 @@ decode_irq_handler_invocation cap cap_ref caps (IrqHandlerSetEndpointIntent) apply (clarsimp simp: decode_irq_handler_invocation_def) apply (wp alternativeE_R_wp | wpc)+ apply (clarsimp split: cdl_cap.splits, safe) - apply (wp throw_on_none_rv, clarsimp simp: get_index_def) + apply ((wp throw_on_none_rv)+, clarsimp simp: get_index_def) apply simp done diff --git a/proof/capDL-api/Invocation_DP.thy b/proof/capDL-api/Invocation_DP.thy index 423266f6e..a07d83468 100644 --- a/proof/capDL-api/Invocation_DP.thy +++ b/proof/capDL-api/Invocation_DP.thy @@ -139,9 +139,7 @@ lemma corrupt_tcb_intent_sep_inv[wp]: "\\s. < P > s\ corrupt_tcb_intent thread \\rv s. < P > s\" - apply (rule sep_nonimpact_valid_lift) - apply wp - done + by (rule sep_nonimpact_valid_lift; wp) lemma corrupt_frame_sep_helper[wp]: "\\s. A (object_at (\obj. P (object_clean obj)) ptr s)\ @@ -185,7 +183,7 @@ lemma update_thread_intent_update: lemma liftE_wp_no_exception: "\\r. \P' r\ g r \Q\,\\r s. False\;\P\f\\r. P' r\\ \ \P\ liftE f >>=E g \Q\,\\r s. False\" apply (simp add:liftE_bindE validE_def) - apply wp + including no_pre apply wp apply assumption apply simp done @@ -194,7 +192,7 @@ lemma handle_event_no_exception: "\P\ handle_event (SyscallEvent SysCall) \\r. Q\,\\r s. False\ \ \P\ handle_event (SyscallEvent SysCall) handler \\r. Q\" apply (rule validE_cases_valid) - apply (wp) + including no_pre apply (wp) apply (rule hoare_FalseE) apply simp done @@ -306,6 +304,7 @@ lemma decode_invocation_nonep: "\\s. \ ep_related_cap cap \ decode_invocation cap cap_ref extra_caps intent \\rv s. nonep_invocation rv\, -" + including no_pre apply (case_tac cap,simp_all add:ep_related_cap_def decode_invocation_def) apply wp[1] apply wp @@ -313,21 +312,21 @@ lemma decode_invocation_nonep: apply (simp add:nonep_invocation_def) apply wp apply (intro conjI impI) - apply (wp hoare_FalseE) - apply (intro conjI impI,wp hoare_FalseE)[2] - apply wp[1] + apply (wp hoare_FalseE)+ + apply (intro conjI impI,(wp hoare_FalseE)+)[2] + apply wp apply wp apply (rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI]) apply (simp add:nonep_invocation_def) - apply wp[1] + apply wp apply (wp,rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI], - simp add:nonep_invocation_def,wp)+ + simp add:nonep_invocation_def,wp+)+ apply (rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI]) apply (simp add:nonep_invocation_def) - apply wp[1] - apply (wp,rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI], + apply wp + apply (wp+, rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI], simp add:nonep_invocation_def)+ - apply wp + apply wp+ done lemma ep_related_cap_reset_simp[simp]: @@ -339,6 +338,7 @@ lemma ep_related_cap_reset_simp[simp]: lemma liftE_wp_split_r: "\\r. \P' r\ g r \Q\,\\r. R\;\P\f\\r. P' r\\ \ \P\ liftE f >>=E g \Q\,\\r. R\" apply (simp add:liftE_bindE validE_def) + including no_pre apply wp apply assumption apply simp @@ -396,7 +396,7 @@ lemma handle_event_syscall_no_decode_exception: apply (rule wp_no_exception_seq_r) apply (rule liftE_wp_no_exception) apply (rule hoare_whenE_wp) - apply (simp add:liftE_validE) + apply simp apply wp apply (rule_tac P = "y = cur_thread" in hoare_gen_asm) apply simp @@ -509,9 +509,9 @@ lemma send_signal_no_pending: apply (rule hoare_pre_cont) apply (rule_tac P = "waiters = {}" in hoare_gen_asm) apply (clarsimp simp: option_select_def) - apply wp + apply wp+ apply (rule hoare_pre_cont) - apply wp + apply wp+ apply (clarsimp simp: get_waiting_ntfn_recv_threads_def get_waiting_sync_bound_ntfn_threads_def no_pending_def opt_cap_def) apply (intro allI impI conjI) @@ -638,7 +638,7 @@ lemma call_kernel_with_intent_no_fault_helper: apply (clarsimp simp: isLeft_def) apply (rule_tac P = "thread_ptr = root_tcb_id" in hoare_gen_asm) apply simp - apply (wp upd_thread update_thread_wp) + apply (wp upd_thread update_thread_wp)+ apply auto done @@ -677,7 +677,8 @@ lemma decode_invocation_simps: lemma liftME_wp: "\P\ m \\r. Q (f r)\,\Q'\ \ \P\ liftME f m \Q\,\Q'\" apply wp - apply (simp add:Fun.comp_def) + apply (simp add:Fun.comp_def) + apply assumption done lemma sep_normal_conj_absorb: @@ -886,10 +887,10 @@ lemma syscall_valid_helper_allow_error: apply simp apply (rule hoare_vcg_handle_elseE) apply assumption - apply wp + including no_pre apply wp apply (wp mark_tcb_intent_error_no_error) apply (rule hoare_drop_imp,simp) - apply simp + apply simp apply (rule hoare_post_impErr) apply fastforce apply simp @@ -967,7 +968,7 @@ lemma handle_event_syscall_allow_error: apply (rule wp_no_exception_seq_r) apply (rule liftE_wp_no_exception) apply (rule hoare_whenE_wp) - apply (simp add:liftE_validE) + apply (simp) apply wp apply (rule_tac P = "y = cur_thread" in hoare_gen_asm) apply simp @@ -1094,7 +1095,7 @@ lemma call_kernel_with_intent_allow_error_helper: apply (rule hoare_pre,(wp hoare_vcg_imp_lift|wpc|simp cong: if_cong)+)[1] apply (wp | wpc | simp)+ apply (rule hoare_pre_cont) - apply (wp has_restart_cap_sep_wp[where cap = RunningCap]) + apply (wp has_restart_cap_sep_wp[where cap = RunningCap])+ apply simp apply (rule_tac current_thread1=root_tcb_id and current_domain1=minBound in hoare_strengthen_post[OF schedule_no_choice_wp]) @@ -1153,7 +1154,7 @@ lemma call_kernel_with_intent_allow_error_helper: apply (clarsimp simp: isLeft_def) apply (rule_tac P = "thread_ptr = root_tcb_id" in hoare_gen_asm) apply simp - apply (wp upd_thread update_thread_wp) + apply (wp upd_thread update_thread_wp)+ apply (clarsimp) apply (clarsimp simp:sep_map_c_conj sep_map_f_conj object_at_def object_project_def sep_state_projection_def diff --git a/proof/capDL-api/KHeap_DP.thy b/proof/capDL-api/KHeap_DP.thy index 8cdd50f95..91e1f2fad 100644 --- a/proof/capDL-api/KHeap_DP.thy +++ b/proof/capDL-api/KHeap_DP.thy @@ -445,7 +445,7 @@ lemma lookup_slot_for_cnode_op_wp [wp]: apply (clarsimp simp: fault_to_except_def) apply (wp) apply (clarsimp simp: gets_the_resolve_cap[symmetric]) - apply (wp gets_the_wpE hoare_whenE_wp) + apply (wp gets_the_wpE hoare_whenE_wp)+ apply (clarsimp split: option.splits sum.splits) done @@ -457,7 +457,7 @@ lemma lookup_slot_for_cnode_op_wpE: apply (wp) apply (clarsimp simp: gets_the_resolve_cap[symmetric]) apply (clarsimp simp: fault_to_except_def) - apply (wp gets_the_wpE hoare_whenE_wp) + apply (wp gets_the_wpE hoare_whenE_wp)+ apply (clarsimp split: option.splits split: sum.splits) done @@ -734,7 +734,7 @@ lemma decode_cnode_move_rvu: apply wp apply (rule_tac P = "src_capa \ NullCap" in hoare_gen_asmEx) apply (simp add:whenE_def) - apply (wp derive_cap_non_exclusive) + apply (wp derive_cap_non_exclusive)+ apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap and R="\ (sz', (unat dest_depth)): target dest_index \u NullCap \* R"]) apply simp @@ -760,6 +760,7 @@ crunch preserve [wp]: decode_cnode_invocation "P" lemma decode_invocation_wp: "\P\ decode_invocation (CNodeCap x y z sz) ref caps (CNodeIntent intent) \\_. P\, -" apply (clarsimp simp: decode_invocation_def) + including no_pre apply (wp) apply (clarsimp simp: comp_def) apply (wp) @@ -853,6 +854,7 @@ lemma lookup_cap_rvu : lookup_cap thread cap_ptr \Q\, \\_ _. False\" apply (clarsimp simp: lookup_cap_def) + including no_pre apply (wp lookup_slot_rvu [where cnode_cap=cnode_cap] get_cap_rv) apply (clarsimp) apply safe @@ -866,11 +868,12 @@ lemma lookup_cap_wp: "\P\ lookup_cap thread cap_ptr \\_. P\, \\_ .P \ " - apply (clarsimp simp: lookup_cap_def) - apply (wp lookup_slot_wp get_cap_wp) - apply (clarsimp) - apply (wp lookup_slot_wp) -done + apply (clarsimp simp: lookup_cap_def) + apply (wp lookup_slot_wp get_cap_wp) + apply (clarsimp) + apply (wp lookup_slot_wp) + apply assumption + done lemma lookup_cap_and_slot_rvu: @@ -1004,8 +1007,8 @@ lemma decode_cnode_mint_rvu: split: sum.splits) apply wp apply (simp add:whenE_def split del:if_splits) - apply (wp derive_cap_invE) - apply (wp update_cap_data) + apply (wp derive_cap_invE)+ + apply (wp update_cap_data)+ apply (rule validE_validE_R) apply (rule lookup_slot_for_cnode_op_rvu' [where r=src_sz and cap=src_cap and R="\ (dest_sz, (unat dest_depth)): target dest_index \u NullCap \* R"]) @@ -1069,7 +1072,7 @@ lemma decode_cnode_mutate_rvu: apply wp apply (rule_tac P = "cap \ NullCap" in hoare_gen_asmEx) apply (simp add:whenE_def) - apply (wp update_cap_data) + apply (wp update_cap_data)+ apply (rule lookup_slot_for_cnode_op_rvu' [where r=src_sz and cap=src_cap and R="\ (dest_sz, (unat dest_depth)): target dest_index \u NullCap \* R"]) apply simp @@ -1138,7 +1141,7 @@ lemma has_restart_cap_sep_wp: apply (rule hoare_name_pre_state) apply (clarsimp simp: object_at_def) apply (simp add: object_at_def get_thread_def has_restart_cap_def - | wp | wpc | intro conjI)+ + | wp+ | wpc | intro conjI)+ apply (clarsimp dest!: opt_cap_sep_imp simp: opt_object_def opt_cap_def slots_of_def) apply (clarsimp simp: object_slots_def) diff --git a/proof/capDL-api/Retype_DP.thy b/proof/capDL-api/Retype_DP.thy index 1aeea840b..a02832005 100644 --- a/proof/capDL-api/Retype_DP.thy +++ b/proof/capDL-api/Retype_DP.thy @@ -237,6 +237,7 @@ lemma mapME_x_wp: using Cons.prems apply (simp add: mapME_x_def sequenceE_x_def) apply (fold mapME_x_def sequenceE_x_def) + including no_pre apply wp apply (rule Cons.hyps) apply fastforce @@ -346,7 +347,7 @@ lemma invoke_untyped_wp: apply (elim conjE) apply (sep_select 3,sep_select 3) apply assumption - apply wp + apply wp+ apply (rule hoare_vcg_conj_lift) apply (rule hoare_vcg_ex_lift) apply (wp hoare_vcg_conj_lift) @@ -466,9 +467,9 @@ lemma invoke_untyped_one_has_children: apply wp apply simp apply (clarsimp simp:neq_Nil_conv) - apply auto[1] - apply wp - apply (rule hoare_strengthen_post[OF generate_object_ids_rv]) + apply auto[1] + apply wp+ + apply (rule hoare_strengthen_post[OF generate_object_ids_rv]) apply (clarsimp simp:zip_is_empty) apply (wp unlessE_wp hoare_drop_imps | simp)+ done @@ -492,7 +493,7 @@ lemma invoke_untyped_exception: | wpc | simp add: reset_untyped_cap_def)+ apply (rule_tac P = "available_range cap = cap_objects cap" in hoare_gen_asmEx) apply (simp add: whenE_def) - apply wp + apply wp+ apply clarsimp apply (cut_tac p = "(a,b)" in opt_cap_sep_imp) apply sep_solve @@ -626,7 +627,7 @@ lemma seL4_Untyped_Retype_sep: [where check= False and tcb = tcb,simplified,rotated -1]) apply assumption apply fastforce - apply (wp hoare_vcg_ex_lift set_cap_wp)[5] + apply ((wp hoare_vcg_ex_lift set_cap_wp)+)[5] apply (rule_tac P = "\has_kids. iv = InvokeUntyped (Retype (root_cnode,ucptr_slot) nt (unat ts) [(root_cnode, ncptr_slot)] has_kids 1)" @@ -735,6 +736,7 @@ lemma unify_failure_cdt_lift: \ \\s. P (cdl_cdt s)\ unify_failure f \\r s. Q r s \ P (cdl_cdt s)\, \\r s. Q' r s \ P (cdl_cdt s)\" apply (simp add:unify_failure_def) + including no_pre apply (wp hoare_drop_imps) apply (clarsimp simp:validE_def valid_def) apply (case_tac a,fastforce+) @@ -790,6 +792,7 @@ crunch cdt_inc[wp]: handle_pending_interrupts "\s. P (cdl_cdt s)" lemma unify_failure_valid: "\\s. P s\ f \\r s. P s\ \ \\s. P s\ unify_failure f \\r s. P s\" + including no_pre apply (simp add:unify_failure_def) apply (wp hoare_drop_imps) apply (clarsimp simp:validE_def valid_def) @@ -899,8 +902,7 @@ lemma update_thread_no_pending: K(\x. (case cdl_tcb_caps x tcb_pending_op_slot of Some cap \ \ is_pending_cap cap | _ \ True)\ (case cdl_tcb_caps (t x) tcb_pending_op_slot of Some cap \ \ is_pending_cap cap | _ \ True))\ update_thread thread_ptr t \\rv. no_pending\" - apply (rule hoare_pre) - apply (simp add: update_thread_def set_object_def | wp modify_wp | wpc)+ + apply (simp add: update_thread_def set_object_def | (wp modify_wp)+ | wpc)+ apply (clarsimp simp: no_pending_def) apply (intro conjI impI allI, simp_all) apply (drule_tac x = oid in spec) @@ -1007,7 +1009,7 @@ lemma invoke_untyped_preempt: apply simp apply simp apply sep_solve - apply (wp select_wp) + apply (wp select_wp)+ apply clarsimp apply (frule opt_cap_sep_imp) apply (clarsimp dest!: reset_cap_asid_untyped_cap_eqD) @@ -1147,7 +1149,7 @@ lemma reset_untyped_cap_no_pending[wp]: apply (wp hoare_whenE_wp) apply (rule_tac P = "snd cref = tcb_pending_op_slot \ \ is_pending_cap cap" in hoare_gen_asmEx) apply (wp mapME_x_inv_wp alternativeE_wp | simp)+ - apply (wp select_wp) + apply (wp select_wp)+ apply (clarsimp simp: detype_no_pending) apply (cases cref, clarsimp simp: no_pending_def) done @@ -1197,7 +1199,7 @@ lemma reset_untyped_cap_not_pending_cap[wp]: apply (rule_tac P = " \ is_pending_cap cap" in hoare_gen_asmEx) apply (wp mapME_x_inv_wp alternativeE_wp set_cap_opt_cap) apply simp - apply (wp select_wp) + apply (wp select_wp)+ apply (clarsimp simp: detype_no_pending) apply (cases cref) apply (clarsimp simp: detype_def opt_cap_def slots_of_def opt_object_def object_slots_def @@ -1270,7 +1272,7 @@ lemma seL4_Untyped_Retype_inc_no_preempt: [where check= False and tcb = tcb and Q = Q and Perror = Q for Q , simplified]) apply fastforce - apply (wp hoare_vcg_ex_lift set_cap_wp)[5] + apply ((wp hoare_vcg_ex_lift set_cap_wp)+)[5] apply (rule_tac P = "\has_kids. iv = InvokeUntyped (Retype (root_cnode,ucptr_slot) nt (unat ts) [(root_cnode, ncptr_slot)] has_kids 1)" diff --git a/proof/capDL-api/Sep_Tactic_Examples.thy b/proof/capDL-api/Sep_Tactic_Examples.thy index 59060e3fe..1356fe21d 100644 --- a/proof/capDL-api/Sep_Tactic_Examples.thy +++ b/proof/capDL-api/Sep_Tactic_Examples.thy @@ -104,9 +104,9 @@ lemma move_cap_wp_old: "\c - \* src \c cap \* R>\ move_cap cap' src dest \\_. c cap' \* src \c NullCap \* R>\" + including no_pre apply (simp add: move_cap_def) apply (wp swap_parents_wp) -thm set_cap_wp[no_vars] apply (rule hoare_strengthen_post) apply (wp set_cap_wp) apply (sep_select 2) @@ -124,6 +124,7 @@ lemma invoke_cnode_rotate2_wp_old: invoke_cnode (RotateCall cap1 cap2 dest src rnd) \\_. c NullCap \* src \c cap1 \* rnd \c cap2 \* R>\" + including no_pre apply (clarsimp simp: invoke_cnode_def) apply (wp) apply (rule hoare_strengthen_post) @@ -296,5 +297,4 @@ schematic_goal "(P \* ?A) s \ (A \* B \* P) s" done - end diff --git a/proof/capDL-api/TCB_DP.thy b/proof/capDL-api/TCB_DP.thy index f0ee1c371..58d4e152c 100644 --- a/proof/capDL-api/TCB_DP.thy +++ b/proof/capDL-api/TCB_DP.thy @@ -54,19 +54,19 @@ lemma restart_wp: \ < (tcb,tcb_pending_op_slot) \c cap \* R > \ restart tcb \\_. < (tcb,tcb_pending_op_slot) \c cap \* R > \" - apply (clarsimp simp: restart_def) - apply (wp alternative_wp) - apply (wp set_cap_wp[sep_wand_wp]) + apply (clarsimp simp: restart_def) + apply (wp alternative_wp) + apply (wp set_cap_wp[sep_wand_wp])+ apply (clarsimp) apply (rule hoare_pre_cont) apply wp - apply (clarsimp) - apply (sep_select_asm 2) - apply (sep_drule (direct) opt_cap_sep_imp) - apply (clarsimp) - apply (erule disjE) + apply (clarsimp) + apply (sep_select_asm 2) + apply (sep_drule (direct) opt_cap_sep_imp) + apply (clarsimp) + apply (erule disjE) apply (clarsimp simp: reset_cap_asid_def split:cdl_cap.split_asm)+ -done + done lemma invoke_tcb_write: "cap = RunningCap \ cap = RestartCap @@ -100,7 +100,7 @@ lemma tcb_update_thread_slot_wp: apply (wp) apply (wp alternative_wp) apply (wp insert_cap_child_wp) - apply (wp insert_cap_sibling_wp get_cap_rv) + apply (wp insert_cap_sibling_wp get_cap_rv)+ apply (safe) apply (sep_solve) apply (drule not_memory_cap_reset_asid') @@ -110,21 +110,23 @@ done lemma tcb_empty_thread_slot_wp: "\<(target_tcb,slot) \c NullCap \* R>\ tcb_empty_thread_slot target_tcb slot \\_. <(target_tcb,slot) \c NullCap \* R>\ " apply (simp add:tcb_empty_thread_slot_def whenE_def | wp)+ - apply (rule valid_validE) - apply (rule hoare_pre_cont) - apply simp - apply wp + apply (rule valid_validE) + apply (rule hoare_pre_cont) + apply simp + apply wp+ apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2) done -lemma tcb_empty_thread_slot_wpE: "\<(target_tcb,slot) \c NullCap \* R>\ tcb_empty_thread_slot target_tcb slot \\_. <(target_tcb,slot) \c NullCap \* R>\, -\E\ " - apply (clarsimp simp: tcb_empty_thread_slot_def | wp)+ - apply (rule hoare_whenE_wp) - apply (simp add:validE_def) - apply (rule hoare_pre_cont) - apply simp - apply wp +lemma tcb_empty_thread_slot_wpE: + "\<(target_tcb,slot) \c NullCap \* R>\ + tcb_empty_thread_slot target_tcb slot + \\_. <(target_tcb,slot) \c NullCap \* R>\, \E\" + apply (clarsimp simp: tcb_empty_thread_slot_def | wp)+ + apply (rule hoare_whenE_wp) + apply (simp add:validE_def) + apply (rule hoare_pre_cont) + apply simp + apply wp apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2) done @@ -136,17 +138,17 @@ lemma tcb_update_ipc_buffer_wp: apply (clarsimp simp: tcb_update_ipc_buffer_def sep_any_All) apply (rule hoare_name_pre_stateE) apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE]) - apply (clarsimp) - apply (wp get_cap_rv'[where cap=cap]) - apply (clarsimp) - apply (wp) - apply (wp tcb_empty_thread_slot_wpE[sep_wandise]) + apply (clarsimp) + apply (wp get_cap_rv'[where cap=cap]) + apply (clarsimp) + apply (wp) + apply (wp tcb_empty_thread_slot_wpE[sep_wandise]) apply (clarsimp simp: pred_conj_def) apply (sep_cancel) - apply (sep_cancel) - apply (safe) - apply (sep_solve)+ -done + apply (sep_cancel) + apply (safe) + apply (sep_solve)+ + done lemma tcb_update_ipc_buffer_wp': "\< (ipc_buffer_slot) \c cap \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* tcb_cap_slot \c (TcbCap target_tcb) \* R> @@ -156,20 +158,20 @@ lemma tcb_update_ipc_buffer_wp': apply (rule hoare_name_pre_stateE) apply (clarsimp simp: tcb_update_ipc_buffer_def sep_any_All) apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wandise] get_cap_rv[where cap=cap]) - apply (rule hoare_allI) - apply (rule hoare_impI) - apply (clarsimp) - apply (safe) - apply (wp) - apply (clarsimp simp: cdl_same_arch_obj_as_def) - apply (clarsimp simp: cap_type_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type) - apply (wp tcb_empty_thread_slot_wpE[sep_wandise]) + apply (rule hoare_allI) + apply (rule hoare_impI) + apply (clarsimp) + apply (safe) + apply (wp) + apply (clarsimp simp: cdl_same_arch_obj_as_def) + apply (clarsimp simp: cap_type_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type) + apply (wp tcb_empty_thread_slot_wpE[sep_wandise]) apply (clarsimp) apply (sep_cancel)+ apply (safe) apply (sep_solve)+ apply (clarsimp simp: cdl_same_arch_obj_as_def cap_type_def reset_cap_asid_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type) -done + done lemma tcb_update_vspace_root_wp: @@ -180,14 +182,13 @@ lemma tcb_update_vspace_root_wp: apply (rule hoare_name_pre_stateE) apply (clarsimp simp: tcb_update_vspace_root_def sep_any_All) apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv) - apply (assumption) - apply (wp get_cap_rv'[where cap=cap]) - apply (clarsimp) - apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE]) + apply (wp get_cap_rv'[where cap=cap]) + apply (clarsimp) + apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE]) apply (clarsimp) apply (sep_cancel) apply (sep_cancel, safe, sep_solve+) -done + done lemma tcb_update_vspace_root_wp': "\< (vrt_slot) \c cap \* (target_tcb, tcb_vspace_slot) \c NullCap \* tcb_cap_slot \c (TcbCap target_tcb) \* R> @@ -196,6 +197,7 @@ lemma tcb_update_vspace_root_wp': \\_. < (target_tcb, tcb_vspace_slot) \c vrt_cap \* tcb_cap_slot \c (TcbCap target_tcb) \* (vrt_slot) \c cap \* R>\, \E\" apply (rule hoare_name_pre_stateE) apply (clarsimp simp: tcb_update_vspace_root_def sep_any_All) + including no_pre apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE'] get_cap_rv) apply (intro validE_allI hoare_validE_conj validE_impI) @@ -238,16 +240,16 @@ lemma tcb_update_cspace_root_wp: and K (\ is_untyped_cap (crt_cap) \ is_cnode_cap cap \ cap_object cap = cap_object crt_cap)\ tcb_update_cspace_root target_tcb tcb_cap_slot (crt_cap, crt_slot) \\_. < (target_tcb, tcb_cspace_slot) \c crt_cap \* tcb_cap_slot \c (TcbCap target_tcb) \* (crt_slot) \c cap \* R>\, \E\" - apply (rule hoare_name_pre_stateE) + including no_pre + apply (rule hoare_name_pre_stateE) apply (clarsimp simp: tcb_update_cspace_root_def sep_any_All_side cong:cap_type_bad_cong) - apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv )+ - apply (assumption) + apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv ) apply (wp get_cap_rv) apply (intro hoare_validE_conj) apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE]) apply (clarsimp simp: sep_conj_assoc) apply (sep_cancel+) - apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE]) + apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])+ apply (clarsimp, sep_cancel+) apply (rule validE_allI) apply (rule validE_impI) @@ -259,7 +261,7 @@ lemma tcb_update_cspace_root_wp: apply clarsimp apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE]) apply (clarsimp simp: sep_conj_assoc pred_conj_def | sep_solve)+ -done + done lemma invoke_tcb_threadcontrol_wp: "\< target_tcb \f Tcb tcb \* @@ -334,7 +336,8 @@ lemma invoke_tcb_threadcontrol_wp': (vrt_slot) \c vrt_cap \* (target_tcb, tcb_cspace_slot) \c crt_cap \* (crt_slot) \c crt_cap' \* - target_tcb \f Tcb (tcb\cdl_tcb_fault_endpoint := fltep\) \* R >\, \E\ " + target_tcb \f Tcb (tcb\cdl_tcb_fault_endpoint := fltep\) \* R >\, \E\" + including no_pre apply (rule hoare_name_pre_stateE) apply (clarsimp simp: invoke_tcb_def) apply (wp set_cdl_tcb_fault_endpoint_wp[sep_wand_wp] tcb_update_ipc_buffer_wp'[sep_wand_side_wpE] @@ -387,7 +390,7 @@ decode_tcb_invocation cap cap_ref caps (TcbConfigureIntent fault_ep priority csp \P\, -" apply (clarsimp simp: decode_tcb_invocation_def) apply (wp alternativeE_R_wp) - apply (wp throw_on_none_rvR) + apply (wp throw_on_none_rvR)+ apply (safe) apply (clarsimp simp: get_index_def) done @@ -475,7 +478,7 @@ lemma tcb_empty_thread_slot_wp_inv: "\<(target_tcb,slot) \c Null apply (rule valid_validE) apply (rule hoare_pre_cont) apply simp - apply wp + apply wp+ apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2) done @@ -490,60 +493,63 @@ lemma insert_cap_sibling_current_thread_inv: \\_ s. P (cdl_current_thread s)\" apply (clarsimp simp: insert_cap_sibling_def) apply (wp | wpc)+ + apply (clarsimp) + apply (intro hoare_conjI hoare_impI) + apply (rule hoare_drop_imp) + apply (wp) + apply (rule hoare_drop_imp) + apply (wp)+ apply (clarsimp) - apply (intro hoare_conjI hoare_impI) - apply (rule hoare_drop_imp) - apply (wp) - apply (rule hoare_drop_imp) - apply (wp) - apply (clarsimp) -done + done lemma tcb_update_vspace_root_inv: "\\s. <(a, tcb_vspace_slot) \c NullCap \* R> s \ P (cdl_current_thread s)\ tcb_update_vspace_root a b c \\_ s. P (cdl_current_thread s)\" - apply (clarsimp simp: tcb_update_vspace_root_def) - apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp + including no_pre + apply (clarsimp simp: tcb_update_vspace_root_def) + apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp | simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+ - apply (intro hoare_drop_impE hoare_validE_conj) + apply (intro hoare_drop_impE hoare_validE_conj) apply (wp tcb_empty_thread_slot_wp_inv) -apply (clarsimp) -defer - apply (wp tcb_empty_thread_slot_wp_inv) apply (clarsimp) -apply (sep_solve) -apply (sep_solve) -done + defer + apply (wp tcb_empty_thread_slot_wp_inv) + apply (clarsimp) + apply (sep_solve) + apply (sep_solve) + done lemma tcb_update_cspace_root_inv: "\\s. <(a, tcb_cspace_slot) \c NullCap \* R> s \ P (cdl_current_thread s)\ tcb_update_cspace_root a b c \\_ s. P (cdl_current_thread s)\" - apply (clarsimp simp: tcb_update_cspace_root_def) - apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp + including no_pre + apply (clarsimp simp: tcb_update_cspace_root_def) + apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp | simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+ - apply (intro hoare_drop_impE hoare_validE_conj) + apply (intro hoare_drop_impE hoare_validE_conj) apply (wp tcb_empty_thread_slot_wp_inv) apply (clarsimp) apply (sep_solve) - apply (wp tcb_empty_thread_slot_wp_inv) - apply (clarsimp) - apply (sep_solve) -done + apply (wp tcb_empty_thread_slot_wp_inv) + apply (clarsimp) + apply (sep_solve) + done lemma tcb_update_ipc_buffer_inv: "\\s. <(a, tcb_ipcbuffer_slot) \c NullCap \* R> s \ P (cdl_current_thread s)\ tcb_update_ipc_buffer a b c \\_ s. P (cdl_current_thread s)\" - apply (clarsimp simp: tcb_update_ipc_buffer_def) - apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp + including no_pre + apply (clarsimp simp: tcb_update_ipc_buffer_def) + apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp | simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+ apply (wp tcb_empty_thread_slot_wp_inv) -apply (clarsimp) -apply (sep_solve) -done + apply (clarsimp) + apply (sep_solve) + done lemma invoke_tcb_ThreadControl_cur_thread: @@ -556,6 +562,7 @@ lemma invoke_tcb_ThreadControl_cur_thread: target_tcb \f Tcb tcb \* R > \ invoke_tcb (ThreadControl target_tcb tcb_cap_slot faultep croot vroot ipc_buffer) \\_ s. P (cdl_current_thread s) \" + including no_pre apply (simp add:invoke_tcb_def comp_def) apply (wp alternative_wp hoare_whenE_wp tcb_empty_thread_slot_wp_inv @@ -583,7 +590,7 @@ lemma invoke_tcb_ThreadControl_cur_thread: \* target_tcb \f - \* R> s) " in hoare_post_imp) apply (clarsimp simp:sep_conj_ac) - apply wp + apply wp+ apply (rule_tac Q = "\r s. P (cdl_current_thread s) \ (<(target_tcb, tcb_vspace_slot) \c - \* (target_tcb,tcb_cspace_slot) \c - @@ -613,7 +620,7 @@ lemma invoke_tcb_ThreadControl_cur_thread: \* R> s) " in hoare_post_imp) apply (clarsimp simp:sep_conj_ac) - apply wp + apply wp+ apply (rule_tac Q = "\r s. P (cdl_current_thread s) \ (<(target_tcb, tcb_vspace_slot) \c - \* (target_tcb, tcb_cspace_slot) \c - @@ -645,7 +652,7 @@ lemma invoke_tcb_ThreadControl_cur_thread: \* target_tcb \f - \* R> s) \ cap_type (fst x2) \ Some UntypedType" in hoare_post_imp) apply (clarsimp simp:sep_conj_ac, sep_solve) - apply wp + apply wp+ apply (rule_tac P = "cap_type (fst x2) \ Some UntypedType" in hoare_gen_asmEx) apply (rule_tac Q = "\r s. P (cdl_current_thread s) \ (<(target_tcb, tcb_vspace_slot) \c NullCap @@ -848,75 +855,75 @@ lemma invoke_tcb_ThreadControl_cdl_current_domain: \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_imp) - apply (clarsimp simp: sep_conj_ac, sep_solve) - apply wp - apply (rule_tac Q = "\r s. P (cdl_current_domain s) + apply (clarsimp simp: sep_conj_ac, sep_solve) + apply wp+ + apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c - \* (target_tcb,tcb_cspace_slot) \c - \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_impErr[rotated -1]) - apply assumption - apply (wp tcb_empty_thread_slot_wp_inv) - apply clarsimp - apply (sep_solve) - apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp + apply assumption + apply (wp tcb_empty_thread_slot_wp_inv) + apply clarsimp + apply (sep_solve) + apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp | simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+ - apply (rule hoare_post_imp[OF _ insert_cap_child_wp]) + apply (rule hoare_post_imp[OF _ insert_cap_child_wp]) + apply (sep_select 2) + apply (drule sep_map_c_any) + apply assumption + apply wp + apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp]) apply (sep_select 2) apply (drule sep_map_c_any) apply assumption - apply wp - apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp]) - apply (sep_select 2) - apply (drule sep_map_c_any) - apply assumption - apply (rule_tac Q = "\r s. P (cdl_current_domain s) + apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c - \* (target_tcb,tcb_cspace_slot) \c - \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_imp) - apply (clarsimp simp:sep_conj_ac) - apply wp + apply (clarsimp simp:sep_conj_ac) + apply wp+ apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c - \* (target_tcb, tcb_cspace_slot) \c - \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_impErr[rotated -1]) - apply assumption - apply (wp tcb_empty_thread_slot_wp_inv) - apply clarsimp - apply sep_solve + apply assumption + apply (wp tcb_empty_thread_slot_wp_inv) + apply clarsimp + apply sep_solve apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c NullCap \* (target_tcb,tcb_cspace_slot) \c - \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_impErr[rotated -1]) - apply assumption - apply (wp hoare_whenE_wp |wpc|simp add:tcb_update_cspace_root_def)+ - apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp + apply assumption + apply (wp hoare_whenE_wp |wpc|simp add:tcb_update_cspace_root_def)+ + apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp | simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+ - apply (rule hoare_post_imp[OF _ insert_cap_child_wp]) + apply (rule hoare_post_imp[OF _ insert_cap_child_wp]) + apply (sep_select 2) + apply (drule sep_map_c_any) + apply assumption + apply wp + apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp]) apply (sep_select 2) apply (drule sep_map_c_any) apply assumption - apply wp - apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp]) - apply (sep_select 2) - apply (drule sep_map_c_any) - apply assumption - apply (rule_tac Q = "\r s. P (cdl_current_domain s) + apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c NullCap \* (target_tcb,tcb_cspace_slot) \c - \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) \ cap_type (fst x2) \ Some UntypedType" in hoare_post_imp) - apply (clarsimp simp:sep_conj_ac) - apply wp + apply (clarsimp simp:sep_conj_ac) + apply wp+ apply (rule_tac P = "cap_type (fst x2) \ Some UntypedType" in hoare_gen_asmEx) apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c NullCap @@ -924,34 +931,34 @@ lemma invoke_tcb_ThreadControl_cdl_current_domain: \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s) " in hoare_post_impErr[rotated -1]) - apply clarsimp - apply assumption - apply (wp tcb_empty_thread_slot_wp_inv) + apply clarsimp + apply assumption + apply (wp tcb_empty_thread_slot_wp_inv) + apply clarsimp apply clarsimp - apply clarsimp - apply (intro conjI impI impI allI) - apply sep_solve+ - apply (rule hoare_pre) - apply (wp|wpc|simp)+ - apply (rule_tac Q = "\r s. P (cdl_current_domain s) + apply (intro conjI impI impI allI) + apply sep_solve+ + apply (rule hoare_pre) + apply (wp|wpc|simp)+ + apply (rule_tac Q = "\r s. P (cdl_current_domain s) \ (<(target_tcb, tcb_vspace_slot) \c NullCap \* (target_tcb,tcb_cspace_slot) \c NullCap \* (target_tcb, tcb_ipcbuffer_slot) \c NullCap \* target_tcb \f - \* R> s)" in hoare_post_imp) - apply clarsimp - apply (sep_select_asm 2) - apply (intro conjI impI allI) - apply sep_solve - apply assumption+ - apply sep_solve - apply wp - apply (rule hoare_post_imp[OF _ set_cdl_tcb_fault_endpoint_wp[where tcb = tcb]]) + apply clarsimp + apply (sep_select_asm 2) + apply (intro conjI impI allI) + apply sep_solve + apply assumption+ + apply sep_solve + apply wp + apply (rule hoare_post_imp[OF _ set_cdl_tcb_fault_endpoint_wp[where tcb = tcb]]) apply (drule sep_map_anyD) apply (sep_select 4) - apply assumption - apply clarsimp - apply (auto, sep_solve+) - done + apply assumption+ + apply clarsimp + apply (auto, sep_solve+) + done lemma TCB_Configure_wp: assumes unify: "cnode_id = cap_object cnode_cap \ @@ -1058,7 +1065,7 @@ shows apply (fastforce) apply (rule hoare_strengthen_post[OF set_cap_wp]) apply (sep_schem) - apply wp[4] + apply (wp+)[4] apply (rule_tac P= " \cspace_cap' vspace_cap' buffer_frame_cap'. iv = (InvokeTcb $ @@ -1138,19 +1145,15 @@ shows apply wp[1] apply (rule no_exception_conjE) apply (wp decode_invocation_tcb_rv''[simplified, where xs="[]" and - croot_slot="(cnode_id, cspace_slot)" and - vroot_slot="(cnode_id, vspace_slot)" and - - ipcbuff_slot="(cnode_id, buffer_frame_slot)"]) - apply (simp) + ipcbuff_slot="(cnode_id, buffer_frame_slot)"])+ apply (rule_tac P="is_tcb_cap c" in hoare_gen_asmEx ) apply (rule split_error_validE) apply (clarsimp simp: decode_tcb_invocation_simps) apply (wp) apply (clarsimp simp: comp_def) - apply (wp)[2] + apply (wp+)[2] apply (simp add:lookup_extra_caps_def Let_def mapME_def sequenceE_def get_index_def bindE_assoc) apply (rule wp_no_exception_seq) @@ -1173,7 +1176,7 @@ shows apply (rule update_thread_intent_update) apply (wp hoare_vcg_ball_lift hoare_vcg_imp_lift hoare_vcg_ex_lift hoare_vcg_all_lift - update_thread_intent_update) + update_thread_intent_update)+ defer apply (clarsimp) apply (intro conjI allI impI disjI2) @@ -1200,7 +1203,7 @@ shows apply assumption apply (sep_select_asm 4) apply (sep_solve) -done + done crunch idle_thread[wp]: set_cap "\s. P (cdl_current_thread s)" (wp: crunch_wps) @@ -1212,12 +1215,13 @@ crunch current_domain[wp]: set_cap "\s. P (cdl_current_domain s)" lemma restart_cdl_current_domain: "\\s. <(ptr,tcb_pending_op_slot) \c cap \* \ > s \ \ is_pending_cap cap \ P (cdl_current_domain s)\ restart ptr \\r s. P (cdl_current_domain s)\" + including no_pre apply (simp add:restart_def) apply (wp alternative_wp) - apply (simp add:cancel_ipc_def) - apply wp + apply (simp add:cancel_ipc_def) + apply wp apply (rule_tac P ="\ is_pending_cap capa" in hoare_gen_asm) - apply (wpc,simp_all add:is_pending_cap_def,wp) + apply (wpc,simp_all add:is_pending_cap_def,wp+) apply clarsimp apply (drule opt_cap_sep_imp) apply auto[1] @@ -1228,17 +1232,17 @@ lemma restart_cdl_current_domain: lemma restart_cdl_current_thread: "\\s. <(ptr,tcb_pending_op_slot) \c cap \* \ > s \ \ is_pending_cap cap \ P (cdl_current_thread s)\ restart ptr \\r s. P (cdl_current_thread s)\" + including no_pre apply (simp add:restart_def) apply (wp alternative_wp) - apply (simp add:cancel_ipc_def) - apply wp + apply (simp add:cancel_ipc_def) + apply wp apply (rule_tac P ="\ is_pending_cap capa" in hoare_gen_asm) - apply (wpc,simp_all add:is_pending_cap_def,wp) + apply (wpc,simp_all add:is_pending_cap_def,wp+) apply clarsimp apply (drule opt_cap_sep_imp) apply auto[1] - apply (simp add:reset_cap_asid_def - split:cdl_cap.splits) + apply (simp add:reset_cap_asid_def split:cdl_cap.splits) done lemma seL4_TCB_WriteRegisters_wp: @@ -1272,7 +1276,6 @@ lemma seL4_TCB_WriteRegisters_wp: sep_state_projection2_def is_tcb_def split:cdl_object.splits) apply (rename_tac cdl_tcb) - apply (rule hoare_pre) apply (wp do_kernel_op_pull_back) apply (rule hoare_post_imp[OF _ call_kernel_with_intent_allow_error_helper [where check = False,simplified]]) @@ -1281,7 +1284,7 @@ lemma seL4_TCB_WriteRegisters_wp: apply fastforce apply (rule hoare_strengthen_post[OF set_cap_wp]) apply (sep_select 3,sep_cancel) - apply wp[4] + apply (wp+)[4] apply (rule_tac P= " iv = (InvokeTcb $ WriteRegisters (cap_object tcb_cap) False [0] 0)" in hoare_gen_asmEx) apply (clarsimp simp:invoke_tcb_def) @@ -1298,16 +1301,15 @@ lemma seL4_TCB_WriteRegisters_wp: throw_opt_def get_tcb_intent_def decode_tcb_invocation_def) apply wp apply (rule alternativeE_wp) - apply wp[2] + apply (wp+)[2] apply (clarsimp simp:conj_comms lookup_extra_caps_def mapME_def sequenceE_def) apply (rule returnOk_wp) apply (rule lookup_cap_and_slot_rvu [where r=root_size and cap=cnode_cap and cap'=tcb_cap]) apply clarsimp - apply (wp hoare_vcg_ball_lift hoare_vcg_conj_lift hoare_vcg_imp_lift - hoare_vcg_all_lift) - apply (wp update_thread_intent_update) + apply (wp hoare_vcg_ball_lift hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift) + apply (wp update_thread_intent_update)+ apply clarify apply (drule_tac x = tcb_cap in spec) apply clarsimp @@ -1316,12 +1318,10 @@ lemma seL4_TCB_WriteRegisters_wp: apply (intro conjI impI allI) apply (clarsimp simp:is_tcb_def reset_cap_asid_tcb split:cdl_object.splits cdl_cap.splits)+ - apply (simp add: ep_related_cap_def - cap_type_def cap_object_def + apply (simp add: ep_related_cap_def cap_type_def cap_object_def split:cdl_cap.splits) apply ((rule conjI|sep_solve)+)[1] - apply (clarsimp simp: user_pointer_at_def - Let_unfold sep_conj_assoc is_tcb_def) + apply (clarsimp simp: user_pointer_at_def Let_unfold sep_conj_assoc is_tcb_def) apply sep_cancel+ apply sep_solve done @@ -1362,7 +1362,7 @@ lemma seL4_TCB_Resume_wp: apply fastforce apply (rule hoare_strengthen_post[OF set_cap_wp]) apply (sep_select 2,sep_cancel) - apply wp[4] + apply (wp+)[4] apply (rule_tac P= " iv = (InvokeTcb $ Resume (cap_object tcb_cap))" in hoare_gen_asmEx) apply (clarsimp simp:invoke_tcb_def) @@ -1392,14 +1392,14 @@ lemma seL4_TCB_Resume_wp: throw_opt_def get_tcb_intent_def decode_tcb_invocation_def) apply wp apply (rule alternativeE_wp) - apply wp[2] + apply (wp+)[2] apply (clarsimp simp: lookup_extra_caps_def mapME_def sequenceE_def) apply (rule returnOk_wp) apply (rule lookup_cap_and_slot_rvu [where r=root_size and cap=cnode_cap and cap'=tcb_cap]) apply clarsimp apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift) - apply (wp update_thread_intent_update) + apply (wp update_thread_intent_update)+ apply clarify apply (drule_tac x = tcb_cap in spec) apply clarsimp @@ -1407,7 +1407,7 @@ lemma seL4_TCB_Resume_wp: apply sep_solve apply (intro conjI impI allI) apply (clarsimp simp:is_tcb_def reset_cap_asid_tcb - split:cdl_object.splits cdl_cap.splits)+ + split:cdl_object.splits cdl_cap.splits)+ apply (simp add: ep_related_cap_def cap_type_def cap_object_def split: cdl_cap.splits) apply ((rule conjI|sep_solve)+)[1] diff --git a/proof/crefine/Arch_C.thy b/proof/crefine/Arch_C.thy index bd79526b5..a7a669be0 100644 --- a/proof/crefine/Arch_C.thy +++ b/proof/crefine/Arch_C.thy @@ -478,7 +478,7 @@ shows apply simp apply (clarsimp simp: option_to_ptr_def option_to_0_def) apply (clarsimp simp: asid_high_bits_def) - apply wp + apply wp+ apply (strengthen valid_pspace_mdb' vp_strgs' valid_pspace_valid_objs') apply (clarsimp simp: is_simple_cap'_def isCap_simps conj_comms placeNewObject_def2) apply (wp createObjects_valid_pspace'[where ty="Inl (KOArch (KOASIDPool f))" and sz = pageBits] @@ -826,7 +826,7 @@ lemma decodeARMPageTableInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_inst[where P=\ and P'=UNIV], simp) - apply wp + apply wp+ apply simp apply (vcg exspec=setThreadState_modifies) apply simp @@ -1666,7 +1666,7 @@ lemma performPageInvocationMapPTE_ccorres: apply (clarsimp simp: valid_pte_slots'2_def del: disjCI) apply (erule disjE, simp_all add: unat_arith_simps)[1] apply (clarsimp simp: upt_conv_Cons[where i=0]) - apply (wp valid_pte_slots_lift2) + apply (wp valid_pte_slots_lift2)+ apply (clarsimp simp: pte_range_relation_def map_is_Nil_conv hd_map_simp ptr_range_to_list_def valid_pte_slots'2_def word_le_nat_alt power_increasing[where a="2 :: nat" and N=4, simplified]) @@ -2174,7 +2174,7 @@ lemma performPageInvocationRemapPTE_ccorres: apply simp apply (simp add: objBits_simps archObjSize_def) apply (simp add: typ_at_to_obj_at_arches[symmetric]) - apply (wp mapM_x_wp_inv valid_pte_slots_lift2) + apply (wp mapM_x_wp_inv valid_pte_slots_lift2)+ apply clarsimp apply (simp add: typ_at_to_obj_at_arches) apply (frule bspec, erule hd_in_set) @@ -2642,7 +2642,7 @@ lemma decodeARMFrameInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_inst[where P=\ and P'=UNIV], simp) - apply wp + apply wp+ apply (vcg exspec=setThreadState_modifies) apply (rule ccorres_rhs_assoc)+ apply csymbr+ @@ -3151,7 +3151,7 @@ lemma decodeARMFrameInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_inst[where P=\ and P'=UNIV], simp) - apply (wp sts_invs_minor' valid_pte_slots_lift2) + apply (wp sts_invs_minor' valid_pte_slots_lift2)+ apply simp apply (vcg exspec=setThreadState_modifies) apply simp @@ -4086,10 +4086,10 @@ lemma Arch_decodeInvocation_ccorres: list_case_If2 split_def del: Collect_const) apply (simp add: if_1_0_0 from_bool_0 hd_conv_nth length_ineq_not_Nil - del: Collect_const ) + del: Collect_const) apply (clarsimp simp: eq_Nil_null[symmetric] asid_high_bits_word_bits hd_conv_nth ThreadState_Restart_def mask_def) - apply wp + apply wp+ apply (simp add: cap_get_tag_isCap) apply (rule HoarePartial.SeqSwap) apply (rule_tac I="\Prop \ksCurThread \root\" diff --git a/proof/crefine/CLevityCatch.thy b/proof/crefine/CLevityCatch.thy index 156b61d7c..88628de0a 100644 --- a/proof/crefine/CLevityCatch.thy +++ b/proof/crefine/CLevityCatch.thy @@ -141,7 +141,7 @@ lemma asUser_get_registers: apply (wp mapM_wp') apply clarsimp apply (erule(1) obj_at_conj') - apply (rule hoare_pre, wp) + apply (wp) apply (simp add: asUser_def split_def threadGet_def) apply (wp getObject_tcb_wp) apply (clarsimp simp: getRegister_def simpler_gets_def diff --git a/proof/crefine/CSpace_C.thy b/proof/crefine/CSpace_C.thy index f5ea377cd..bbbd94616 100644 --- a/proof/crefine/CSpace_C.thy +++ b/proof/crefine/CSpace_C.thy @@ -1213,7 +1213,7 @@ thm cteInsert_body_def apply (ctac ccorres:ccorres_updateMDB_set_mdbPrev) apply (simp add:dc_def[symmetric]) apply (ctac ccorres: ccorres_updateMDB_skip) - apply (wp static_imp_wp) + apply (wp static_imp_wp)+ apply (clarsimp simp: Collect_const_mem dc_def split del: if_split) apply vcg apply (wp static_imp_wp) diff --git a/proof/crefine/CSpace_RAB_C.thy b/proof/crefine/CSpace_RAB_C.thy index bd82ff722..d2edbd507 100644 --- a/proof/crefine/CSpace_RAB_C.thy +++ b/proof/crefine/CSpace_RAB_C.thy @@ -694,7 +694,7 @@ lemma lookupSlotForThread_ccorres': apply (ctac add: ccorres_return_CE) apply csymbr+ apply (ctac add: ccorres_return_C_errorE) - apply wp + apply wp+ apply vcg apply (rule conjI) apply (clarsimp simp add: conj_comms word_size tcbSlots Kernel_C.tcbCTable_def) diff --git a/proof/crefine/Delete_C.thy b/proof/crefine/Delete_C.thy index be6673099..5e4ae9e1b 100644 --- a/proof/crefine/Delete_C.thy +++ b/proof/crefine/Delete_C.thy @@ -891,11 +891,11 @@ lemma finaliseSlot_ccorres: apply (clarsimp simp: throwError_def return_def cintr_def) apply vcg apply (wp cutMon_validE_drop reduceZombie_invs reduceZombie_sch_act_simple) - apply (wp reduceZombie_cap_to[simplified imp_conv_disj, simplified]) + apply (wp reduceZombie_cap_to[simplified imp_conv_disj, simplified])+ apply (simp add: guard_is_UNIV_def) apply (simp add: conj_comms) apply (wp make_zombie_invs' updateCap_cte_wp_at_cases - updateCap_cap_to' hoare_vcg_disj_lift static_imp_wp) + updateCap_cap_to' hoare_vcg_disj_lift static_imp_wp)+ apply (simp add: guard_is_UNIV_def) apply wp apply (simp add: guard_is_UNIV_def) diff --git a/proof/crefine/DetWP.thy b/proof/crefine/DetWP.thy index 029fd3d47..c4b18f8dd 100644 --- a/proof/crefine/DetWP.thy +++ b/proof/crefine/DetWP.thy @@ -19,7 +19,7 @@ lemma det_wp_doMachineOp [wp]: apply (simp add: doMachineOp_def split_def) apply (rule det_wp_pre, wp) apply (erule det_wp_select_f) - apply wp + apply wp+ apply simp done @@ -123,7 +123,7 @@ lemma det_wp_asUser [wp]: apply wp apply (drule det_wp_det) apply (erule det_wp_select_f) - apply wp + apply wp+ apply (rule_tac Q="\_. tcb_at' t" in hoare_post_imp) apply simp apply wp diff --git a/proof/crefine/Fastpath_C.thy b/proof/crefine/Fastpath_C.thy index 2c3d650a6..0921a4d73 100644 --- a/proof/crefine/Fastpath_C.thy +++ b/proof/crefine/Fastpath_C.thy @@ -698,15 +698,15 @@ lemma findPDForASID_pd_at_asid_noex: apply (rule hoare_pre) apply (rule seqE[rotated]) apply wpc - apply wp[1] + apply wp apply (rule seqE[rotated]) apply (rule seqE[rotated]) apply (rule returnOk_wp) apply (simp add:checkPDAt_def) - apply wp[1] + apply wp apply (rule assertE_wp) apply wpc - apply wp[1] + apply wp apply (rule liftE_wp) apply (rule getASID_wp) apply (clarsimp simp: pd_at_asid'_def obj_at'_def projectKOs @@ -2139,7 +2139,7 @@ lemma cnotification_relation_isActive: lemma option_case_liftM_getNotification_wp: "\\s. \rv. (case x of None \ rv = v | Some p \ obj_at' (\ntfn. f ntfn = rv) p s) \ Q rv s\ case x of None \ return v | Some ptr \ liftM f $ getNotification ptr \ Q \" - apply (rule hoare_pre, wpc, wp getNotification_wp) + apply (rule hoare_pre, (wpc; wp getNotification_wp)) apply (auto simp: obj_at'_def) done @@ -2164,7 +2164,7 @@ lemma fastpath_call_ccorres: (ksCurThread s) s) (UNIV \ {s. cptr_' s = cptr} \ {s. msgInfo_' s = msginfo}) [] (fastpaths SysCall) (Call fastpath_call_'proc)" - proof - +proof - have [simp]: "scast Kernel_C.tcbCaller = tcbCallerSlot" by (simp add:Kernel_C.tcbCaller_def tcbCallerSlot_def) have [simp]: "scast Kernel_C.tcbVTable = tcbVTableSlot" @@ -3517,12 +3517,12 @@ lemma monadic_rewrite_add_lookup_both_sides: \ monadic_rewrite E F (P and Q) f g" apply (rule monadic_rewrite_imp) apply (rule monadic_rewrite_trans[rotated]) - apply (rule monadic_rewrite_symb_exec_l'[where m=lu], wp inv ef nf impI) + apply (rule monadic_rewrite_symb_exec_l'[where m=lu], (wp inv ef nf impI)+) apply (rule monadic_rewrite_refl, wp) apply (simp; erule monadic_rewrite_trans[rotated]) apply (rule monadic_rewrite_transverse[OF _ monadic_rewrite_refl]) - apply (rule monadic_rewrite_symb_exec_l'[where m=lu], wp inv ef nf impI) + apply (rule monadic_rewrite_symb_exec_l'[where m=lu], (wp inv ef nf impI)+) apply (rule monadic_rewrite_refl, wp) apply simp done @@ -3658,17 +3658,17 @@ lemma fastpath_callKernel_SysCall_corres: apply simp apply (rule monadic_rewrite_bind_tail) apply (rule_tac x=thread in monadic_rewrite_symb_exec, - wp empty_fail_getCurThread) + (wp empty_fail_getCurThread)+) apply (simp add: sendIPC_def bind_assoc) apply (rule_tac x=send_ep in monadic_rewrite_symb_exec, - wp empty_fail_getEndpoint getEndpoint_obj_at') + (wp empty_fail_getEndpoint getEndpoint_obj_at')+) apply (rule_tac P="epQueue send_ep \ []" in monadic_rewrite_gen_asm) apply (simp add: isRecvEP_endpoint_case list_case_helper bind_assoc) apply (rule monadic_rewrite_bind_tail) apply (elim conjE) apply (match premises in "isEndpointCap ep" for ep \ \rule monadic_rewrite_symb_exec[where x="BlockedOnReceive (capEPPtr ep)"]\, - wp empty_fail_getThreadState) + (wp empty_fail_getThreadState)+) apply (rule monadic_rewrite_symb_exec2, (wp | simp)+) apply (rule monadic_rewrite_bind) apply (rule_tac msgInfo=msgInfo in doIPCTransfer_simple_rewrite) @@ -3677,7 +3677,7 @@ lemma fastpath_callKernel_SysCall_corres: apply (rule_tac curPrio=curPrio and destPrio=destPrio and curDom=curDom and destDom=destDom and thread=thread in attemptSwitchTo_rewrite) - apply (rule monadic_rewrite_symb_exec2, wp empty_fail_threadGet) + apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_threadGet)+) apply (rule monadic_rewrite_bind) apply (rule monadic_rewrite_trans) apply (rule setupCallerCap_rewrite) @@ -3685,7 +3685,7 @@ lemma fastpath_callKernel_SysCall_corres: apply (rule setThreadState_blocked_rewrite, simp) apply (rule monadic_rewrite_trans) apply (rule_tac x=BlockedOnReply in monadic_rewrite_symb_exec, - wp empty_fail_getThreadState) + (wp empty_fail_getThreadState)+) apply simp apply (rule monadic_rewrite_refl) apply (rule monadic_rewrite_trans) @@ -3706,7 +3706,7 @@ lemma fastpath_callKernel_SysCall_corres: locateSlot_conv ct_in_state'_def cur_tcb'_def) apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1] apply (simp add: setSchedulerAction_def) - apply wp[1] + apply wp apply (simp cong: if_cong conj_cong add: if_bool_simps) apply (simp_all only:)[5] apply ((wp setThreadState_oa_queued[of _ "\a _ _. \ a"] @@ -3782,10 +3782,9 @@ lemma fastpath_callKernel_SysCall_corres: apply (wp getCTE_wp') apply (rule resolveAddressBits_points_somewhere) apply (simp cong: if_cong bool.case_cong) - apply wp[1] + apply wp apply simp - apply (wp user_getreg_wp user_getregs_wp - threadGet_wp) + apply (wp user_getreg_wp user_getregs_wp threadGet_wp)+ apply (clarsimp simp: ct_in_state'_def pred_tcb_at') apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+) apply (clarsimp simp: isCap_simps valid_cap'_def maskCapRights_def) @@ -3885,13 +3884,12 @@ lemma doReplyTransfer_simple: setThreadState Running receiver; attemptSwitchTo receiver od )" - apply (simp add: doReplyTransfer_def liftM_def nullPointer_def - getSlotCap_def) + apply (simp add: doReplyTransfer_def liftM_def nullPointer_def getSlotCap_def) apply (rule monadic_rewrite_bind_tail)+ - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_threadGet) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_threadGet)+) apply (rule_tac P="rv = None" in monadic_rewrite_gen_asm, simp) apply (rule monadic_rewrite_refl) - apply (wp threadGet_const gts_wp' getCTE_wp') + apply (wp threadGet_const gts_wp' getCTE_wp')+ apply (simp add: o_def) done @@ -3919,10 +3917,10 @@ lemma receiveIPC_simple_rewrite: apply (simp add: receiveIPC_def) apply (rule monadic_rewrite_imp) apply (rule_tac rv=ep in monadic_rewrite_symb_exec_l_known, - wp empty_fail_getEndpoint) + (wp empty_fail_getEndpoint)+) apply (rule monadic_rewrite_symb_exec_l, (wp | simp add: getBoundNotification_def)+) apply (rule monadic_rewrite_symb_exec_l) - apply (rule hoare_pre, wpc, wp, simp) + apply (rule hoare_pre, wpc, wp+, simp) apply (simp split: option.split) apply (rule monadic_rewrite_trans, rule monadic_rewrite_if_known[where X=False], simp) apply (rule monadic_rewrite_refl3[where P=\]) @@ -3942,7 +3940,7 @@ lemma cteDeleteOne_replycap_rewrite: (emptySlot slot None)" apply (simp add: cteDeleteOne_def) apply (rule monadic_rewrite_imp) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rule_tac P="cteCap rv \ NullCap \ isReplyCap (cteCap rv) \ \ isEndpointCap (cteCap rv) \ \ isNotificationCap (cteCap rv)" @@ -3950,9 +3948,9 @@ lemma cteDeleteOne_replycap_rewrite: apply (simp add: finaliseCapTrue_standin_def capRemovable_def) apply (rule monadic_rewrite_symb_exec_l, - wp isFinalCapability_inv empty_fail_isFinalCapability) + (wp isFinalCapability_inv empty_fail_isFinalCapability)+) apply (rule monadic_rewrite_refl) - apply (wp getCTE_wp') + apply (wp getCTE_wp')+ apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps) done @@ -3963,7 +3961,7 @@ lemma cteDeleteOne_nullcap_rewrite: (return ())" apply (simp add: cteDeleteOne_def) apply (rule monadic_rewrite_imp) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rule_tac P="cteCap rv = NullCap" in monadic_rewrite_gen_asm) apply simp apply (rule monadic_rewrite_refl) @@ -3979,7 +3977,7 @@ lemma deleteCallerCap_nullcap_rewrite: apply (simp add: deleteCallerCap_def getThreadCallerSlot_def locateSlot_conv getSlotCap_def) apply (rule monadic_rewrite_imp) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rule monadic_rewrite_assert) apply (rule cteDeleteOne_nullcap_rewrite) apply (wp getCTE_wp) @@ -4070,11 +4068,11 @@ lemma tcbSchedDequeue_rewrite_not_queued: "monadic_rewrite True False (tcb_at' t apply (wp threadGet_const) apply (rule monadic_rewrite_symb_exec_l) - apply wp + apply wp+ apply (rule monadic_rewrite_refl) apply (wp) apply (clarsimp simp: o_def obj_at'_def) -done + done lemma schedule_known_rewrite: "monadic_rewrite True False @@ -4104,7 +4102,7 @@ lemma schedule_known_rewrite: apply (rule monadic_rewrite_refl) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_refl) - apply (wp Arch_switchToThread_obj_at_pre, simp, wp) + apply ((wp Arch_switchToThread_obj_at_pre)+, simp, wp+) apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_symb_exec_l) apply (wp) @@ -4120,7 +4118,7 @@ lemma schedule_known_rewrite: apply (wp, simp) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_refl) - apply (wp) + apply wp+ apply (rule monadic_rewrite_refl) apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def) done @@ -4133,8 +4131,8 @@ lemma setThreadState_schact_set: apply (simp add: setThreadState_def) apply (rule monadic_rewrite_imp) apply (subst bind_return[symmetric], rule monadic_rewrite_bind_tail) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_isRunnable) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCurThread) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_isRunnable)+) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCurThread)+) apply (rule monadic_rewrite_symb_exec_l, wp) apply (simp add: getSchedulerAction_def) apply (rename_tac sa) @@ -4233,7 +4231,7 @@ lemma setEndpoint_setCTE_pivot[unfolded K_bind_def]: split: if_split) apply (auto split: if_split simp: obj_at'_def projectKOs intro!: arg_cong[where f=f] ext kernel_state.fold_congs)[1] - apply wp + apply wp+ apply simp done @@ -4347,7 +4345,7 @@ lemma set_setCTE[unfolded K_bind_def]: apply (auto simp: simpler_modify_def projectKO_opt_tcb intro!: kernel_state.fold_congs ext split: if_split)[1] - apply wp + apply wp+ apply (clarsimp intro!: all_tcbI) apply (auto simp: tcb_cte_cases_def split: if_split_asm) done @@ -4374,7 +4372,7 @@ lemma clearUntypedFreeIndex_simple_rewrite: apply (rule monadic_rewrite_name_pre) apply (clarsimp simp: cte_wp_at_ctes_of) apply (rule monadic_rewrite_imp) - apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp) + apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp+) apply (simp split: capability.split, strengthen monadic_rewrite_refl, simp) apply clarsimp @@ -4406,7 +4404,7 @@ lemma emptySlot_replymaster_rewrite[OF refl]: apply (rule monadic_rewrite_bind_head) apply (rule clearUntypedFreeIndex_simple_rewrite) apply simp - apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp empty_fail_getCTE) + apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, (wp empty_fail_getCTE)+) apply (simp add: updateMDB_def Let_def bind_assoc makeObject_cte case_Null_If) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_bind) @@ -4416,7 +4414,7 @@ lemma emptySlot_replymaster_rewrite[OF refl]: apply (case_tac ctea, rename_tac mdbnode, case_tac mdbnode) apply simp apply (rule monadic_rewrite_refl) - apply (wp getCTE_wp') + apply (wp getCTE_wp')+ apply (clarsimp simp: cte_wp_at_ctes_of reply_masters_rvk_fb_def) apply (fastforce simp: isCap_simps) done @@ -4540,6 +4538,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: (invs' and ct_in_state' (op = Running) and (\s. ksSchedulerAction s = ResumeCurrentThread) and cnode_caps_gsCNodes') (callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)" + including no_pre apply (rule monadic_rewrite_introduce_alternative) apply ( simp add: callKernel_def) apply (rule monadic_rewrite_imp) @@ -4555,9 +4554,9 @@ lemma fastpath_callKernel_SysReplyRecv_corres: cong: if_cong) apply (rule monadic_rewrite_rdonly_bind_l, wp) apply (rule monadic_rewrite_bind_tail) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac thread msgInfo) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac cptr) apply (rule monadic_rewrite_symb_exec_r[OF threadGet_inv no_fail_threadGet]) apply (rename_tac tcbFault) @@ -4577,7 +4576,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: isRight_def[where x="Inr v" for v] isRight_def[where x="Inl v" for v] cong: if_cong) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac "cTableCTE") apply (rule monadic_rewrite_transverse, @@ -4592,7 +4591,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply clarsimp apply (simp add: isRight_case_sum liftE_bind isRight_def[where x="Inr v" for v]) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac ep_cap) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) @@ -4603,7 +4602,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (rename_tac ep) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac ep) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) @@ -4615,20 +4614,20 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (simp add: bind_assoc) apply (rule monadic_rewrite_rdonly_bind_l, wp assert_inv) apply (rule monadic_rewrite_assert) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac callerFault) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) apply (simp add: getThreadVSpaceRoot_def locateSlot_conv) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rename_tac vTableCTE) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) - apply (rule monadic_rewrite_symb_exec_r, wp)+ + apply (rule monadic_rewrite_symb_exec_r, wp+)+ apply (rename_tac curPrio callerPrio) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) - apply (rule monadic_rewrite_symb_exec_r, wp) + apply (rule monadic_rewrite_symb_exec_r, wp+) apply (rule monadic_rewrite_if_rhs[rotated]) apply (rule monadic_rewrite_alternative_l) apply (rule monadic_rewrite_symb_exec_r[OF curDomain_inv], @@ -4678,12 +4677,12 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (simp add: setMessageInfo_def) apply (rule monadic_rewrite_bind_tail) apply (rule_tac rv=thread in monadic_rewrite_symb_exec_l_known, - wp empty_fail_getCurThread) + (wp empty_fail_getCurThread)+) apply (rule_tac rv=cptr in monadic_rewrite_symb_exec_l_known, - wp empty_fail_asUser empty_fail_getRegister) + (wp empty_fail_asUser empty_fail_getRegister)+) apply (rule monadic_rewrite_bind) apply (rule monadic_rewrite_catch[OF _ monadic_rewrite_refl True_E_E]) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rename_tac cTableCTE2, rule_tac P="cteCap cTableCTE2 = cteCap cTableCTE" in monadic_rewrite_gen_asm) @@ -4698,7 +4697,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: in monadic_rewrite_gets_known[where m="NonDetMonad.lift f" for f, folded bindE_def]) apply (simp add: NonDetMonad.lift_def isRight_case_sum) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rename_tac ep_cap2) apply (rule_tac P="cteCap ep_cap2 = cteCap ep_cap" in monadic_rewrite_gen_asm) apply (simp add: cap_case_EndpointCap_NotificationCap) @@ -4710,7 +4709,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (wp, simp) apply (rule monadic_rewrite_bind_head) apply (rule setThreadState_schact_set) - apply (wp getCTE_known_cap) + apply (wp getCTE_known_cap)+ apply (rule monadic_rewrite_bind) apply (rule_tac t="capTCBPtr (cteCap replyCTE)" and t'=thread @@ -4719,8 +4718,8 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (rule activateThread_simple_rewrite) apply wp apply (simp add: ct_in_state'_def) - apply (wp setCurThread_ct_in_state[folded st_tcb_at'_def] - Arch_switchToThread_pred_tcb')[2] + apply ((wp setCurThread_ct_in_state[folded st_tcb_at'_def] + Arch_switchToThread_pred_tcb')+)[2] apply (simp add: catch_liftE) apply (wp setEndpoint_obj_at_tcb' threadSet_pred_tcb_at_state[unfolded if_bool_eq_conj]) apply (simp cong: rev_conj_cong) @@ -4728,7 +4727,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (unfold setSchedulerAction_def)[3] apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change setThreadState_obj_at_unchanged - sts_st_tcb_at'_cases sts_bound_tcb_at' + sts_st_tcb_at'_cases sts_bound_tcb_at' emptySlot_obj_at'_not_queued emptySlot_cte_wp_at_cteCap emptySlot_cnode_caps @@ -4739,7 +4738,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: hoare_vcg_ex_lift | simp del: comp_apply | clarsimp simp: obj_at'_weakenE[OF _ TrueI])+) - apply (wp getCTE_wp' gts_imp') + apply (wp getCTE_wp' gts_imp')+ apply (simp add: ARM_H.switchToThread_def bind_assoc) apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse]) @@ -4755,7 +4754,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres: apply (simp add: bind_assoc catch_liftE receiveIPC_def Let_def liftM_def setThreadState_runnable_simp) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getThreadState) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getThreadState)+) apply (rule monadic_rewrite_assert) apply (rule_tac P="inj (case_bool thread (capTCBPtr (cteCap replyCTE)))" @@ -4783,24 +4782,24 @@ lemma fastpath_callKernel_SysReplyRecv_corres: and F=True and E=False in monadic_rewrite_weaken) apply (rule monadic_rewrite_isolate_final2) apply simp - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rename_tac callerCTE) apply (rule monadic_rewrite_assert) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE) + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+) apply (rule monadic_rewrite_assert) apply (simp add: emptySlot_setEndpoint_pivot) apply (rule monadic_rewrite_bind) apply (rule monadic_rewrite_refl2) apply (clarsimp simp: isSendEP_def split: Structures_H.endpoint.split) apply (rule_tac Q="\rv. (\_. rv = callerCTE) and Q'" for Q' - in monadic_rewrite_symb_exec_r, wp) + in monadic_rewrite_symb_exec_r, wp+) apply (rule monadic_rewrite_gen_asm, simp) apply (rule monadic_rewrite_trans, rule monadic_rewrite_bind_head, rule_tac cte=callerCTE in emptySlot_replymaster_rewrite) apply (simp add: bind_assoc o_def) apply (rule monadic_rewrite_refl) apply (simp add: cte_wp_at_ctes_of pred_conj_def) - apply (wp getCTE_ctes_wp) + apply (wp getCTE_ctes_wp)+ apply (clarsimp simp: fun_eq_iff if_flip cong: if_cong) apply (drule obj_at_ko_at', clarsimp) diff --git a/proof/crefine/Finalise_C.thy b/proof/crefine/Finalise_C.thy index 87cea67b0..c20ef7c29 100644 --- a/proof/crefine/Finalise_C.thy +++ b/proof/crefine/Finalise_C.thy @@ -2011,7 +2011,7 @@ lemma finaliseCap_ccorres: apply (simp add: ctcb_offset_def) apply (simp add: mask_def irq_opt_relation_def) apply (simp add: cap_get_tag_isCap) - apply wp + apply wp+ apply (rule ccorres_if_lhs) apply (simp add: Let_def) apply (rule ccorres_from_vcg_throws[where P=\ and P'=UNIV]) @@ -2098,4 +2098,5 @@ lemma finaliseCap_ccorres: apply (clarsimp simp add:mask_eq_ucast_eq) done end + end diff --git a/proof/crefine/Interrupt_C.thy b/proof/crefine/Interrupt_C.thy index 357ac39da..0a16df23e 100644 --- a/proof/crefine/Interrupt_C.thy +++ b/proof/crefine/Interrupt_C.thy @@ -168,7 +168,7 @@ lemma decodeIRQHandlerInvocation_ccorres: apply (simp add: liftE_alternative returnOk_liftE[symmetric]) apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (rule ccorres_Cond_rhs) apply (rule ccorres_rhs_assoc)+ apply csymbr @@ -252,7 +252,7 @@ lemma decodeIRQHandlerInvocation_ccorres: apply (simp add: liftE_alternative returnOk_liftE[symmetric]) apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (rule ccorres_Cond_rhs) apply (rule ccorres_equals_throwError) apply (fastforce simp: invocationCatch_def throwError_bind split: invocation_label.split) @@ -307,7 +307,7 @@ lemma invokeIRQControl_ccorres: apply csymbr apply (ctac(no_vcg) add: cteInsert_ccorres) apply (rule ccorres_return_CE, simp+)[1] - apply wp + apply wp+ apply (simp add: Collect_const_mem) apply (vcg exspec=setIRQState_modifies) apply (rule conjI) @@ -535,7 +535,7 @@ lemma decodeIRQControlInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply simp diff --git a/proof/crefine/Invoke_C.thy b/proof/crefine/Invoke_C.thy index 65a753740..63af16547 100644 --- a/proof/crefine/Invoke_C.thy +++ b/proof/crefine/Invoke_C.thy @@ -963,7 +963,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_valid_pspace_hangers) + apply (wp sts_valid_pspace_hangers)+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (simp add: Collect_const_mem exception_defs) @@ -1028,7 +1028,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeRevoke_modifies) @@ -1043,7 +1043,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeDelete_modifies) @@ -1062,7 +1062,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_valid_pspace_hangers) + apply (wp sts_valid_pspace_hangers)+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (simp add: dc_def[symmetric]) @@ -1111,7 +1111,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] - apply (wp sts_invs_minor') + apply (wp sts_invs_minor')+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (simp add: Collect_const_mem) @@ -1296,7 +1296,7 @@ lemma decodeCNodeInvocation_ccorres: apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeCNodeRotate_modifies) - apply (wp static_imp_wp) + apply (wp static_imp_wp)+ apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (simp add: Collect_const_mem) @@ -1407,7 +1407,6 @@ lemma decodeCNodeInvocation_ccorres: cte_wp_at_ctes_of excaps_in_mem_def slotcap_in_mem_def sysargs_rel_def length_ineq_not_Nil dest!: interpret_excaps_eq) - (* why does auto with these rules take ten times as long? *) apply ((rule conjI | clarsimp simp:split_def neq_Nil_conv | erule pred_tcb'_weakenE disjE | drule st_tcb_at_idle_thread')+)[1] @@ -1476,7 +1475,7 @@ lemma resetUntypedCap_gsCNodes_at_pt: apply (wp mapME_x_wp' | simp add: unless_def)+ apply (wp hoare_vcg_const_imp_lift deleteObjects_gsCNodes_at_pt - getSlotCap_wp) + getSlotCap_wp)+ apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps) apply (frule(1) ctes_of_valid') apply (clarsimp simp: valid_cap_simps' capAligned_def) @@ -2757,9 +2756,9 @@ lemma mapME_ensureEmptySlot': "\P\ mapME (\x. injection_handler Inl (ensureEmptySlot (f x))) slots \\rva s. P s \ (\slot \ set slots. (\cte. cteCap cte = capability.NullCap \ ctes_of s (f slot) = Some cte))\, -" + including no_pre apply (induct slots arbitrary: P) - apply simp - apply wp + apply wpsimp apply (rename_tac a slots P) apply (simp add: mapME_def sequenceE_def Let_def) apply (rule_tac Q="\rv. P and (\s. \cte. cteCap cte = capability.NullCap \ ctes_of s (f a) = Some cte)" in validE_R_sp) diff --git a/proof/crefine/IpcCancel_C.thy b/proof/crefine/IpcCancel_C.thy index 83da6e70f..d2cbacbcf 100644 --- a/proof/crefine/IpcCancel_C.thy +++ b/proof/crefine/IpcCancel_C.thy @@ -1144,7 +1144,7 @@ proof - apply (simp only: dc_def[symmetric]) apply ctac prefer 2 - apply (wp, clarsimp, wp) + apply (wp, clarsimp, wp+) apply (rule_tac P="\s. valid_queues s \ (\p. t \ set (ksReadyQueues s p)) \ (\tcb. ko_at' tcb t s \ tcbDomain tcb =rva \ tcbPriority tcb = rvb \ valid_tcb' tcb s)" @@ -1497,7 +1497,7 @@ proof - apply (simp only: dc_def[symmetric]) apply ctac prefer 2 - apply (wp, clarsimp, wp) + apply (wp, clarsimp, wp+) apply (rule_tac P="(\s. \d p. (\t\set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s) \ distinct(ksReadyQueues s (d, p))) and valid_queues' and obj_at' (inQ rva rvb) t @@ -1862,7 +1862,7 @@ proof - apply (simp only: dc_def[symmetric]) apply ctac prefer 2 - apply (wp, clarsimp, wp) + apply (wp, clarsimp, wp+) apply (rule_tac P="\s. valid_queues s \ (\p. t \ set (ksReadyQueues s p)) \ (\tcb. ko_at' tcb t s \ tcbDomain tcb =rva \ tcbPriority tcb = rvb \ valid_tcb' tcb s)" @@ -2041,7 +2041,7 @@ lemma rescheduleRequired_ccorres: max_word_def) apply wp apply (simp add: guard_is_UNIV_def) - apply wp + apply wp+ apply (simp add: getSchedulerAction_def) apply (clarsimp simp: weak_sch_act_wf_def rf_sr_def cstate_relation_def Let_def cscheduler_action_relation_def) @@ -2197,9 +2197,9 @@ lemma scheduleTCB_ccorres': split: scheduler_action.split_asm) apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def cscheduler_action_relation_def) - apply wp + apply wp+ apply (simp add: getSchedulerAction_def) - apply wp + apply wp+ apply (simp add: isRunnable_def isBlocked_def) apply wp apply (simp add: guard_is_UNIV_def) @@ -2255,9 +2255,9 @@ lemma scheduleTCB_ccorres_valid_queues'_pre: split: scheduler_action.split_asm)+ apply (clarsimp simp: rf_sr_def cstate_relation_def cscheduler_action_relation_def split: scheduler_action.split_asm) - apply wp + apply wp+ apply (simp add: getSchedulerAction_def) - apply wp + apply wp+ apply (simp add: isRunnable_def isBlocked_def) apply wp apply (simp add: guard_is_UNIV_def) @@ -2293,7 +2293,7 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple: max_word_def) apply wp apply (simp add: guard_is_UNIV_def) - apply wp + apply wp+ apply (simp add: getSchedulerAction_def) apply (clarsimp simp: weak_sch_act_wf_def rf_sr_def cstate_relation_def Let_def cscheduler_action_relation_def) @@ -2348,9 +2348,9 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple: split: scheduler_action.split_asm) apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def cscheduler_action_relation_def) - apply wp + apply wp+ apply (simp add: getSchedulerAction_def) - apply wp + apply wp+ apply (simp add: isRunnable_def isBlocked_def) apply wp apply (simp add: guard_is_UNIV_def) diff --git a/proof/crefine/Ipc_C.thy b/proof/crefine/Ipc_C.thy index b49d631a7..c19936ffe 100644 --- a/proof/crefine/Ipc_C.thy +++ b/proof/crefine/Ipc_C.thy @@ -234,11 +234,12 @@ lemma tcbFault_submonad_args: lemma threadGet_stateAssert_gets: "threadGet ext t = do stateAssert (tcb_at' t) []; gets (thread_fetch ext t) od" + including no_pre apply (rule is_stateAssert_gets [OF _ _ empty_fail_threadGet no_fail_threadGet]) - apply (clarsimp simp: threadGet_def liftM_def, wp)[1] - apply (simp add: threadGet_def liftM_def, wp getObject_tcb_at') - apply (simp add: threadGet_def liftM_def, wp) - apply (rule hoare_strengthen_post, wp getObject_obj_at') + apply (clarsimp simp: threadGet_def liftM_def, wp+)[1] + apply (simp add: threadGet_def liftM_def, (wp getObject_tcb_at')+) + apply (simp add: threadGet_def liftM_def, wp+) + apply (rule hoare_strengthen_post, (wp getObject_obj_at')+) apply (simp add: objBits_def objBitsKO_def)+ apply (clarsimp simp: obj_at'_def thread_fetch_def projectKOs) done @@ -516,7 +517,7 @@ lemma stateAssert_mapM_loadWordUser_comm: do y \ mapM loadWordUser ptrs; x \ stateAssert P []; n od" apply (rule bind_inv_inv_comm) apply (wp stateAssert_inv) - apply (wp mapM_wp_inv) + apply (wp mapM_wp_inv)+ apply simp done @@ -622,7 +623,7 @@ lemma handleFaultReply': zip_Cons ARM_H.exceptionMessage_def ARM.exceptionMessage_def mapM_x_Cons mapM_x_Nil) - apply (rule monadic_rewrite_symb_exec_l, wp) + apply (rule monadic_rewrite_symb_exec_l, wp+) apply (rule_tac P="tcb_at' s and tcb_at' r" in monadic_rewrite_inst) apply (case_tac rv; (case_tac "msgLength tag < scast n_msgRegisters", (erule disjE[OF word_less_cases], @@ -639,7 +640,7 @@ lemma handleFaultReply': | wp asUser_tcb_at' lookupIPCBuffer_inv')+)+)) apply wp (* capFault *) - apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_asUser)+ + apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_asUser)+)+ apply(case_tac rv) apply (clarsimp | rule monadic_rewrite_bind_tail monadic_rewrite_refl @@ -752,7 +753,7 @@ lemma handleFaultReply': fromIntegral_simp1 fromIntegral_simp2 shiftL_word) apply (clarsimp simp: mapM_def sequence_def bind_assoc asUser_bind_distrib asUser_return submonad_asUser.fn_stateAssert bit_def) - apply wp + apply wp+ done end @@ -952,7 +953,7 @@ lemma replyFromKernel_success_empty_ccorres [corres]: apply vcg apply wp apply vcg - apply wp + apply wp+ apply (simp add: ARM_H.msgInfoRegister_def ARM.msgInfoRegister_def Kernel_C.msgInfoRegister_def Kernel_C.R1_def ARM_H.badgeRegister_def ARM.badgeRegister_def @@ -1518,10 +1519,9 @@ lemma exceptionMessage_ccorres: = index exceptionMessageC n" apply (simp add: exceptionMessageC_def ARM_H.exceptionMessage_def ARM.exceptionMessage_def MessageID_Exception_def) - apply (simp add: Arrays.update_def n_exceptionMessage_def fcp_beta nth_Cons' - fupdate_def - split: if_split) - done + by (simp add: Arrays.update_def n_exceptionMessage_def fcp_beta nth_Cons' + fupdate_def + split: if_split) lemma asUser_obj_at_elsewhere: "\obj_at' (P :: tcb \ bool) t' and (\_. t \ t')\ asUser t m \\rv. obj_at' P t'\" @@ -1633,6 +1633,7 @@ proof - have mapM_x_return_gen: "\v w xs. mapM_x (\_. return v) xs = return w" (* FIXME mapM_x_return *) by (induct_tac xs; simp add: mapM_x_Nil mapM_x_Cons) show ?thesis + including no_pre apply (unfold K_def) apply (intro ccorres_gen_asm) apply (cinit' lift: sender_' receiver_' receiveIPCBuffer_' @@ -1958,7 +1959,7 @@ proof - apply (ctac(no_vcg) add: setMRs_lookup_failure_ccorres[unfolded msgMaxLength_unfold]) apply simp apply (rule ccorres_return_C, simp+)[1] - apply (wp setMR_tcbFault_obj_at hoare_case_option_wp) + apply (wp setMR_tcbFault_obj_at hoare_case_option_wp)+ apply (clarsimp simp: option_to_ptr_def Collect_const_mem guard_is_UNIV_def) apply (rule conjI) apply (simp add: seL4_CapFault_InRecvPhase_def) @@ -2275,14 +2276,14 @@ lemma loadCapTransfer_ctReceiveDepth: apply simp apply (simp only: word_bits_len_of[symmetric]) apply (subst unat_lt2p, simp) - apply wp -done + apply wp+ + done + (* FIXME: move *) lemma cte_at_0' [dest!]: "\ cte_at' 0 s; no_0_obj' s \ \ False" apply (clarsimp simp: cte_wp_at_obj_cases') - apply (auto simp: tcb_cte_cases_def is_aligned_def dest!:tcb_aligned' split: if_split_asm) - done + by (auto simp: tcb_cte_cases_def is_aligned_def dest!:tcb_aligned' split: if_split_asm) lemma getReceiveSlots_ccorres: "ccorres (\a c. (a = [] \ (\slot. a = [slot])) \ @@ -2354,7 +2355,7 @@ lemma getReceiveSlots_ccorres: apply (simp add: cct_relation_def) apply (case_tac rv, clarsimp) apply (rule UNIV_I) -- "still a schematic here ..." -done + done lemma setExtraBadge_ccorres: @@ -3088,7 +3089,7 @@ lemma transferCaps_ccorres [corres]: apply (rule_tac R'=UNIV in ccorres_split_throws [OF ccorres_return_C], simp_all)[1] apply vcg apply simp - apply (wp empty_fail_getReceiveSlots)[3] + apply ((wp empty_fail_getReceiveSlots)+)[3] apply (simp add: message_info_to_H_def word_sless_def word_sle_def) apply (simp add: option_to_0_def ccorres_cond_iffs interpret_excaps_test_null excaps_map_def @@ -3139,6 +3140,7 @@ lemma transferCaps_ccorres [corres]: (* FIXME: move *) lemma getMessageInfo_le3: "\\\ getMessageInfo sender \\rv s. unat (msgExtraCaps rv) \ 3\" + including no_pre apply (simp add: getMessageInfo_def) apply wp apply (rule_tac Q="\_. \" in hoare_strengthen_post) @@ -3146,10 +3148,11 @@ lemma getMessageInfo_le3: apply (simp add: messageInfoFromWord_def Let_def msgExtraCapBits_def) apply (cut_tac y="r >> Types_H.msgLengthBits" in word_and_le1 [where a=3]) apply (simp add: word_le_nat_alt) - done + done lemma getMessageInfo_msgLength: "\\\ getMessageInfo sender \\rv. K (unat (msgLength rv) \ msgMaxLength)\" + including no_pre apply (simp add: getMessageInfo_def) apply wp apply (rule_tac Q="\_. \" in hoare_strengthen_post) @@ -3336,7 +3339,7 @@ proof - unat_of_nat32[unfolded word_bits_conv] word_of_nat_less) apply (simp add: word_less_nat_alt) - apply wp + apply wp+ apply (clarsimp simp: ccorres_cond_iffs) apply (rule_tac P= \ and P'="{x. errstate x= lu_ret___struct_lookupSlot_raw_ret_C \ @@ -5217,9 +5220,9 @@ lemma sendIPC_ccorres [corres]: apply (fastforce simp: weak_sch_act_wf_def valid_tcb_state'_def elim: obj_at'_weakenE) apply (wp attemptSwitchTo_sch_act_not sts_st_tcb' hoare_vcg_all_lift - attemptSwitchTo_ksQ sts_valid_queues sts_ksQ') + attemptSwitchTo_ksQ sts_valid_queues sts_ksQ')+ apply (clarsimp simp: valid_tcb_state'_def) - apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift) + apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)+ apply (rule_tac Q="\rv. valid_queues and valid_pspace' and valid_objs' and valid_mdb' and tcb_at' dest and cur_tcb' and tcb_at' thread and K (dest \ thread) @@ -5229,8 +5232,8 @@ lemma sendIPC_ccorres [corres]: in hoare_post_imp) apply (clarsimp simp: st_tcb_at'_def obj_at'_def is_tcb weak_sch_act_wf_def) apply (wp setEndpoint_ksQ hoare_vcg_all_lift set_ep_valid_objs' - setEndpoint_valid_mdb') -apply (clarsimp simp: guard_is_UNIV_def ThreadState_Inactive_def + setEndpoint_valid_mdb')+ + apply (clarsimp simp: guard_is_UNIV_def ThreadState_Inactive_def ThreadState_Running_def mask_def from_bool_def option_to_ptr_def option_to_0_def split: bool.split_asm) diff --git a/proof/crefine/IsolatedThreadAction.thy b/proof/crefine/IsolatedThreadAction.thy index 9206625c8..a1e13b3cc 100644 --- a/proof/crefine/IsolatedThreadAction.thy +++ b/proof/crefine/IsolatedThreadAction.thy @@ -585,7 +585,7 @@ lemma monadic_rewrite_in_isolate_thread_actions: apply (rule monadic_rewrite_bind_tail)+ apply (rule_tac P="\_. P s" in monadic_rewrite_bind_head) apply (simp add: monadic_rewrite_def select_f_def) - apply wp + apply wp+ apply simp done @@ -669,7 +669,7 @@ lemma select_f_isolatable: split_def select_f_selects liftM_def bind_assoc) apply (rule monadic_rewrite_imp, rule monadic_rewrite_transverse) apply (rule monadic_rewrite_drop_modify monadic_rewrite_bind_tail)+ - apply wp + apply wp+ apply (simp add: gets_bind_ign getSchedulerAction_def) apply (rule monadic_rewrite_refl) apply (simp add: ksPSpace_update_partial_id o_def) @@ -768,11 +768,12 @@ lemma transferCaps_simple_rewrite: "monadic_rewrite True True ((\_. caps = []) and \) (transferCaps mi caps ep r rBuf) (return (mi \ msgExtraCaps := 0, msgCapsUnwrapped := 0 \))" + including no_pre apply (rule monadic_rewrite_gen_asm) apply (rule monadic_rewrite_imp) apply (rule monadic_rewrite_trans) apply (simp add: transferCaps_simple, rule monadic_rewrite_refl) - apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getReceiveSlots) + apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getReceiveSlots)+) apply (rule monadic_rewrite_refl) apply simp done @@ -836,13 +837,13 @@ lemma doIPCTransfer_simple_rewrite: apply (rule_tac P="fault = None" in monadic_rewrite_gen_asm, simp) apply (rule monadic_rewrite_bind_tail) apply (rule_tac x=msgInfo in monadic_rewrite_symb_exec, - wp empty_fail_user_getreg user_getreg_rv) + (wp empty_fail_user_getreg user_getreg_rv)+) apply (simp add: lookupExtraCaps_simple_rewrite returnOk_catch_bind) apply (rule monadic_rewrite_bind) apply (rule monadic_rewrite_from_simple, rule copyMRs_simple) apply (rule monadic_rewrite_bind_head) apply (rule transferCaps_simple_rewrite) - apply (wp threadGet_const) + apply (wp threadGet_const)+ apply (simp add: bind_assoc) apply (rule monadic_rewrite_symb_exec2[OF lookupIPC_inv empty_fail_lookupIPCBuffer] monadic_rewrite_symb_exec2[OF threadGet_inv empty_fail_threadGet] @@ -895,7 +896,7 @@ lemma setThreadState_blocked_rewrite: in monadic_rewrite_gen_asm) apply (simp add: when_def) apply (rule monadic_rewrite_refl) - apply wp + apply wp+ apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_isRunnable | (simp only: getCurThread_def getSchedulerAction_def @@ -939,8 +940,8 @@ lemma setupCallerCap_rewrite: apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_symb_exec2, (wp | simp)+)+ apply (rule monadic_rewrite_refl) - apply wp - apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getCTE)+ + apply wp+ + apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getCTE)+)+ apply (rule monadic_rewrite_refl) apply (wp getCTE_wp' | simp add: cte_wp_at_ctes_of)+ apply (clarsimp simp: reply_masters_rvk_fb_def) @@ -971,11 +972,11 @@ lemma attemptSwitchTo_rewrite: in monadic_rewrite_gen_asm) apply (simp add: eq_commute le_less[symmetric]) apply (rule monadic_rewrite_refl) - apply (wp threadGet_wp) + apply (wp threadGet_wp)+ apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_symb_exec2, - wp empty_fail_threadGet | simp add: getSchedulerAction_def curDomain_def)+ + (wp empty_fail_threadGet)+ | simp add: getSchedulerAction_def curDomain_def)+ apply (rule monadic_rewrite_refl) apply wp apply (rule monadic_rewrite_symb_exec2, simp_all add: getCurThread_def) @@ -1067,7 +1068,7 @@ lemma schedule_rewrite: apply (rule monadic_rewrite_bind_tail) apply (rule_tac P="curRunnable \ action = SwitchToThread t" in monadic_rewrite_gen_asm, simp) apply (rule monadic_rewrite_refl) - apply (wp,simp,wp) + apply (wp,simp,wp+) apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_symb_exec2, wp | simp add: isRunnable_def getSchedulerAction_def)+ @@ -1096,7 +1097,7 @@ lemma schedule_rewrite_ct_not_runnable': apply (rule monadic_rewrite_bind_tail) apply (rule_tac P="\ curRunnable \ action = SwitchToThread t" in monadic_rewrite_gen_asm,simp) apply (rule monadic_rewrite_refl) - apply (wp,simp,wp) + apply (wp,simp,wp+) apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_symb_exec2, wp | @@ -1122,7 +1123,7 @@ lemma activateThread_simple_rewrite: apply simp apply (rule monadic_rewrite_refl) apply wp - apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getThreadState) + apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getThreadState)+) apply (rule monadic_rewrite_refl) apply wp apply (rule monadic_rewrite_symb_exec2, @@ -1169,7 +1170,7 @@ lemma setThreadState_no_sch_change: apply (rule_tac Q="\_. ?P and st_tcb_at' (op = st) t" in hoare_post_imp) apply (clarsimp split: if_split) apply (clarsimp simp: obj_at'_def st_tcb_at'_def projectKOs) - apply (rule hoare_pre, wp threadSet_pred_tcb_at_state) + apply (wp threadSet_pred_tcb_at_state) apply simp done @@ -1419,7 +1420,7 @@ lemma tcbSchedDequeue_rewrite: apply (rule monadic_rewrite_refl) apply (wp threadGet_const) apply (rule monadic_rewrite_symb_exec2) - apply wp + apply wp+ apply (rule monadic_rewrite_refl) apply (clarsimp) done @@ -1436,10 +1437,10 @@ lemma switchToThread_rewrite: apply (rule monadic_rewrite_bind) apply (rule tcbSchedDequeue_rewrite) apply (rule monadic_rewrite_refl) - apply (wp Arch_switchToThread_obj_at_pre) + apply (wp Arch_switchToThread_obj_at_pre)+ apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_symb_exec) - apply (wp, simp) + apply (wp+, simp) apply (rule monadic_rewrite_refl) apply (wp) apply (clarsimp simp: comp_def) @@ -1642,7 +1643,7 @@ lemma monadic_rewrite_isolate_final2: \ sa = ksSchedulerAction s)" in monadic_rewrite_refl3) apply (clarsimp simp: exec_modify eqs return_def) - apply wp + apply wp+ apply (clarsimp simp: o_def eqs) done diff --git a/proof/crefine/Machine_C.thy b/proof/crefine/Machine_C.thy index 023036fce..2ca77ae50 100644 --- a/proof/crefine/Machine_C.thy +++ b/proof/crefine/Machine_C.thy @@ -523,7 +523,7 @@ lemma cleanCacheRange_RAM_ccorres: apply (rule ccorres_Guard_Seq) apply (rule ccorres_basic_srnoop2, simp) apply (ctac (no_vcg) add: cleanL2Range_ccorres[unfolded dc_def]) - apply wp + apply wp+ apply clarsimp apply (auto dest: ghost_assertion_size_logic simp: o_def) done @@ -693,7 +693,7 @@ lemma cleanCaches_PoU_ccorres: apply (ctac (no_vcg) add: dsb_ccorres) apply (ctac (no_vcg) add: invalidate_I_PoU_ccorres) apply (ctac (no_vcg) add: dsb_ccorres) - apply wp + apply wp+ apply clarsimp done @@ -710,7 +710,7 @@ lemma setCurrentPD_ccorres: apply (ctac (no_vcg) add: dsb_ccorres) apply (ctac (no_vcg) add: writeTTBR0_ccorres) apply (ctac (no_vcg) add: isb_ccorres) - apply wp + apply wp+ apply clarsimp done diff --git a/proof/crefine/Recycle_C.thy b/proof/crefine/Recycle_C.thy index 32a4262e6..0b5e67c45 100644 --- a/proof/crefine/Recycle_C.thy +++ b/proof/crefine/Recycle_C.thy @@ -911,8 +911,9 @@ lemma tcbSchedEnqueue_ep_at: "\obj_at' (P :: endpoint \ bool) ep\ tcbSchedEnqueue t \\rv. obj_at' P ep\" + including no_pre apply (simp add: tcbSchedEnqueue_def unless_def null_def) - apply (wp threadGet_wp, clarsimp, wp) + apply (wp threadGet_wp, clarsimp, wp+) apply (clarsimp split: if_split, wp) done diff --git a/proof/crefine/Refine_C.thy b/proof/crefine/Refine_C.thy index 116d1aabd..9273ad8bb 100644 --- a/proof/crefine/Refine_C.thy +++ b/proof/crefine/Refine_C.thy @@ -691,7 +691,7 @@ lemma entry_corres_C: prefer 2 apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def) apply (rule getContext_corres, simp) - apply (wp threadSet_all_invs_triv' callKernel_cur) + apply (wp threadSet_all_invs_triv' callKernel_cur)+ apply (clarsimp simp: all_invs'_def invs'_def cur_tcb'_def) apply simp done diff --git a/proof/crefine/Retype_C.thy b/proof/crefine/Retype_C.thy index f0580e814..e806d58c4 100644 --- a/proof/crefine/Retype_C.thy +++ b/proof/crefine/Retype_C.thy @@ -6993,14 +6993,15 @@ lemma createObject_untypedRange: Q {ptr..ptr + 2 ^ us - 1} s) \ (toAPIType ty \ Some apiobject_type.Untyped \ Q {} s)\" shows "\P\ createObject ty ptr us dev\\m s. Q (untypedRange m) s\" + including no_pre using split apply (simp add: createObject_def) apply (case_tac "toAPIType ty") - apply (simp add: split untypedRange.simps | wp)+ + apply (simp add: split | wp)+ apply (simp add: valid_def return_def bind_def split_def) apply (case_tac a, simp_all) - apply (simp add: untypedRange.simps valid_def return_def simpler_gets_def - simpler_modify_def bind_def split_def curDomain_def)+ + apply (simp add: valid_def return_def simpler_gets_def simpler_modify_def + bind_def split_def curDomain_def)+ done lemma createObject_capRange: @@ -7206,8 +7207,7 @@ lemma insertNewCap_untypedRange: insertNewCap srcSlot destSlot x \\rv s. cte_wp_at' (\cte. isUntypedCap (cteCap cte) \ P untypedRange (cteCap cte)) srcSlot s\" apply (simp add:insertNewCap_def) - apply (wp updateMDB_weak_cte_wp_at ) - apply (wp setCTE_cte_wp_at_other getCTE_wp) + apply (wp updateMDB_weak_cte_wp_at setCTE_cte_wp_at_other getCTE_wp) apply (clarsimp simp:cte_wp_at_ctes_of) done @@ -7820,8 +7820,7 @@ lemma insertNewCap_ccorres: apply (clarsimp simp: ccap_relation_def map_option_Some_eq2) apply (simp add: untypedZeroRange_def Let_def) done -find_theorems untypedZeroRange -term zero_ranges_are_zero + lemma createObject_untyped_region_is_zero_bytes: "\\. \\\<^bsub>/UNIV\<^esub> {s. let tp = (object_type_to_H (t_' s)); sz = APIType_capBits tp (unat (userSize_' s)) @@ -8133,7 +8132,7 @@ shows "ccorres dc xfdc hoare_vcg_prop createObject_gsCNodes_p createObject_cnodes_have_size) apply (rule hoare_vcg_conj_lift[OF createObject_capRange_helper]) apply (wp createObject_cte_wp_at' createObject_ex_cte_cap_wp_to - createObject_no_inter[where sz = sz] hoare_vcg_all_lift static_imp_wp) + createObject_no_inter[where sz = sz] hoare_vcg_all_lift static_imp_wp)+ apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace' field_simps range_cover.sz conj_comms range_cover.aligned range_cover_sz' is_aligned_shiftl_self aligned_add_aligned[OF range_cover.aligned]) diff --git a/proof/crefine/Schedule_C.thy b/proof/crefine/Schedule_C.thy index 1a8ada7c7..608c818d3 100644 --- a/proof/crefine/Schedule_C.thy +++ b/proof/crefine/Schedule_C.thy @@ -101,9 +101,7 @@ qed (* FIXME move *) lemma setVMRoot_valid_queues': "\ valid_queues' \ setVMRoot a \ \_. valid_queues' \" - apply (rule valid_queues_lift') - apply wp - done + by (rule valid_queues_lift'; wp) (* FIXME move to REFINE *) crunch valid_queues'[wp]: "Arch.switchToThread" valid_queues' @@ -180,7 +178,7 @@ lemma switchToIdleThread_ccorres: apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def cmachine_state_relation_def) apply (simp add: ARM_H.switchToIdleThread_def) - apply wp + apply wp+ apply simp apply simp done @@ -223,7 +221,7 @@ lemma switchToThread_ccorres: apply (clarsimp simp: setCurThread_def simpler_modify_def) apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def carch_state_relation_def cmachine_state_relation_def) - apply wp + apply wp+ apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def) done @@ -629,7 +627,7 @@ proof - apply clarsimp apply vcg_step (* vcg creates a state that's not printable in a sane amount of time *) apply clarsimp - apply wp + apply wp+ apply (simp add: isRunnable_def) apply wp apply (rename_tac s' d) @@ -809,7 +807,7 @@ lemma schedule_ccorres: apply (ctac (no_vcg) add: chooseThread_ccorres) apply (rule ccorres_setSchedulerAction[unfolded dc_def]) apply (simp add: cscheduler_action_relation_def) - apply (wp nextDomain_invs_no_cicd') + apply (wp nextDomain_invs_no_cicd')+ apply clarsimp apply assumption (* else branch for rvb *) @@ -839,7 +837,7 @@ lemma schedule_ccorres: apply (ctac (no_vcg) add: chooseThread_ccorres) apply (rule ccorres_setSchedulerAction[unfolded dc_def]) apply (simp add: cscheduler_action_relation_def) - apply (wp nextDomain_invs_no_cicd') + apply (wp nextDomain_invs_no_cicd')+ apply clarsimp apply assumption (* else branch for rv *) diff --git a/proof/crefine/SyscallArgs_C.thy b/proof/crefine/SyscallArgs_C.thy index 6aafbcdf8..cf256ac30 100644 --- a/proof/crefine/SyscallArgs_C.thy +++ b/proof/crefine/SyscallArgs_C.thy @@ -48,11 +48,11 @@ lemmas replyOnRestart_typ_ats[wp] = typ_at_lifts [OF replyOnRestart_typ_at'] lemma replyOnRestart_invs'[wp]: "\invs'\ replyOnRestart thread reply isCall \\rv. invs'\" + including no_pre apply (simp add: replyOnRestart_def) apply (wp setThreadState_nonqueued_state_update rfk_invs' static_imp_wp) apply (rule hoare_vcg_all_lift) apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ) - apply (rule hoare_strengthen_post, rule gts_sp') apply (clarsimp simp: pred_tcb_at') apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap'' @@ -173,7 +173,7 @@ lemma preemptionPoint_ccorres: apply (simp add: from_bool_0 whenE_def returnOk_def throwError_def return_def split: option.splits) apply (clarsimp simp: cintr_def exception_defs) - apply wp + apply wp+ apply vcg apply (unfold modifyWorkUnits_def)[1] apply wp @@ -557,7 +557,7 @@ lemma is_nondet_refinement_bind: "\ is_nondet_refinement a c; \rv. is_nondet_refinement (b rv) (d rv) \ \ is_nondet_refinement (a >>= b) (c >>= d)" apply (clarsimp simp: is_nondet_refinement_def bind_def split_def) - apply blast + apply fast done lemma is_nondet_refinement_bindE: @@ -643,10 +643,10 @@ lemma asUser_cur_obj_at': asUser t f \\rv s. obj_at' (\tcb. Q rv (atcbContextGet (tcbArch tcb))) (ksCurThread s) s\" apply (simp add: asUser_def split_def) apply (wp) - apply (rule hoare_lift_Pf2 [where f=ksCurThread]) - apply (wp threadSet_obj_at'_really_strongest) - apply (clarsimp simp: threadGet_def) - apply (wp getObject_tcb_wp) + apply (rule hoare_lift_Pf2 [where f=ksCurThread]) + apply (wp threadSet_obj_at'_really_strongest)+ + apply (clarsimp simp: threadGet_def) + apply (wp getObject_tcb_wp) apply clarsimp apply (drule obj_at_ko_at') apply clarsimp @@ -683,16 +683,15 @@ lemma getMRs_tcbContext: apply (elim conjE) apply (thin_tac "thread = t" for t) apply (clarsimp simp add: getMRs_def) - apply (rule hoare_pre) - apply (wp|wpc)+ - apply (rule_tac P="n < length x" in hoare_gen_asm) - apply (clarsimp simp: nth_append) - apply (wp mapM_wp' static_imp_wp) + apply (wp|wpc)+ + apply (rule_tac P="n < length x" in hoare_gen_asm) + apply (clarsimp simp: nth_append) + apply (wp mapM_wp' static_imp_wp)+ apply simp apply (rule asUser_cur_obj_at') apply (simp add: getRegister_def msgRegisters_unfold) apply (simp add: mapM_Cons bind_assoc mapM_empty) - apply wp[1] + apply wp apply (wp hoare_drop_imps hoare_vcg_all_lift) apply (wp asUser_cur_obj_at') apply (simp add: getRegister_def msgRegisters_unfold) @@ -1069,8 +1068,7 @@ lemma getMRs_user_word: defer apply simp apply (wp asUser_const_rv) - apply (simp add: msgRegisters_unfold n_msgRegisters_def) - apply simp + apply (simp add: msgRegisters_unfold n_msgRegisters_def) apply (erule_tac x="unat i - unat n_msgRegisters" in allE) apply (erule impE) apply (simp add: msgRegisters_unfold @@ -1169,7 +1167,7 @@ lemma getMRs_length: apply (simp add: getMRs_def) apply (rule hoare_pre, wp) apply simp - apply (wp mapM_length asUser_const_rv mapM_length) + apply (wp mapM_length asUser_const_rv mapM_length)+ apply (clarsimp simp: length_msgRegisters) apply (simp add: min_def split: if_splits) apply (clarsimp simp: word_le_nat_alt) diff --git a/proof/crefine/Syscall_C.thy b/proof/crefine/Syscall_C.thy index aa0474d3a..6580facdb 100644 --- a/proof/crefine/Syscall_C.thy +++ b/proof/crefine/Syscall_C.thy @@ -204,7 +204,7 @@ lemma decodeInvocation_ccorres: apply simp apply (rule hoare_use_eq[where f=ksCurThread]) apply (wp sts_invs_minor' sts_st_tcb_at'_cases - setThreadState_ct' hoare_vcg_all_lift sts_ksQ') + setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+ apply simp apply (vcg exspec=setThreadState_modifies) apply vcg @@ -536,7 +536,7 @@ lemma handleDoubleFault_ccorres: apply (ctac (no_vcg)) apply (rule ccorres_symb_exec_l) apply (rule ccorres_return_Skip) - apply (wp asUser_inv getRestartPC_inv) + apply (wp asUser_inv getRestartPC_inv)+ apply (rule empty_fail_asUser) apply (simp add: getRestartPC_def) apply wp @@ -781,6 +781,7 @@ lemma handleFault_ccorres: lemma getMessageInfo_less_4: "\\\ getMessageInfo t \\rv s. msgExtraCaps rv < 4\" + including no_pre apply (simp add: getMessageInfo_def) apply wp apply (rule hoare_strengthen_post, rule hoare_vcg_prop) @@ -815,7 +816,7 @@ lemma getMRs_length: apply (simp add: getMRs_def) apply (rule hoare_pre, wp) apply simp - apply (wp mapM_length asUser_const_rv mapM_length) + apply (wp mapM_length asUser_const_rv mapM_length)+ apply (clarsimp simp: length_msgRegisters) apply (simp add: min_def split: if_splits) apply (clarsimp simp: word_le_nat_alt) @@ -824,6 +825,7 @@ lemma getMRs_length: lemma getMessageInfo_msgLength': "\\\ getMessageInfo t \\rv s. msgLength rv \ 0x78\" + including no_pre apply (simp add: getMessageInfo_def) apply wp apply (rule hoare_strengthen_post, rule hoare_vcg_prop) @@ -925,7 +927,7 @@ lemma handleInvocation_ccorres: apply (ctac(no_vcg) add: replyFromKernel_success_empty_ccorres) apply (ctac(no_vcg) add: setThreadState_ccorres) apply (rule ccorres_return_CE[folded return_returnOk], simp+)[1] - apply (wp) + apply wp+ apply (rule hoare_strengthen_post, rule rfk_invs') apply auto[1] apply simp @@ -1028,7 +1030,7 @@ lemma handleInvocation_ccorres: apply clarsimp apply (vcg exspec= lookupCapAndSlot_modifies) apply simp - apply (wp getMessageInfo_less_4 getMessageInfo_le3 getMessageInfo_msgLength') + apply (wp getMessageInfo_less_4 getMessageInfo_le3 getMessageInfo_msgLength')+ apply (simp add: msgMaxLength_def, wp getMessageInfo_msgLength')[1] apply simp apply wp @@ -1214,7 +1216,7 @@ lemma deleteCallerCap_ccorres [corres]: gs_set_assn_Delete_cstate_relation[unfolded o_def]) apply (wp | simp)+ apply (simp add: getSlotCap_def) - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply clarsimp apply (simp add: guard_is_UNIV_def ghost_assertion_data_get_def ghost_assertion_data_set_def) @@ -1639,7 +1641,7 @@ lemma getIRQSlot_ccorres3: apply (clarsimp simp: getIRQSlot_ccorres_stuff objBits_simps cte_level_bits_def ucast_nat_def uint_ucast uint_up_ucast is_up) - apply wp + apply wp+ done lemma ucast_eq_0[OF refl]: @@ -1851,7 +1853,7 @@ lemma handleInterrupt_ccorres: apply (ctac (no_vcg) add: sendSignal_ccorres) apply (ctac (no_vcg) add: maskInterrupt_ccorres) apply (ctac add: ackInterrupt_ccorres [unfolded dc_def]) - apply wp + apply wp+ apply (simp del: Collect_const) apply (rule ccorres_cond_true_seq) apply (rule ccorres_rhs_assoc)+ @@ -1884,7 +1886,7 @@ lemma handleInterrupt_ccorres: apply (ctac (no_vcg) add: timerTick_ccorres) apply (ctac (no_vcg) add: resetTimer_ccorres) apply (ctac add: ackInterrupt_ccorres ) - apply wp + apply wp+ apply (simp add: Platform_maxIRQ maxIRQ_def del: Collect_const) apply (rule ccorres_move_const_guards)+ apply (rule ccorres_cond_false_seq) diff --git a/proof/crefine/TcbAcc_C.thy b/proof/crefine/TcbAcc_C.thy index e039792ee..43bf6bc2a 100644 --- a/proof/crefine/TcbAcc_C.thy +++ b/proof/crefine/TcbAcc_C.thy @@ -114,7 +114,7 @@ lemma getRegister_ccorres [corres]: apply (rule refl) apply (erule threadSet_eq) apply (clarsimp simp: ctcb_relation_def ccontext_relation_def carch_tcb_relation_def) - apply (wp threadGet_obj_at2) + apply (wp threadGet_obj_at2)+ apply simp apply simp apply (erule obj_atE') diff --git a/proof/crefine/Tcb_C.thy b/proof/crefine/Tcb_C.thy index be2b8db50..3f8e3a37b 100644 --- a/proof/crefine/Tcb_C.thy +++ b/proof/crefine/Tcb_C.thy @@ -13,17 +13,18 @@ imports Move Delete_C Ipc_C begin lemma asUser_obj_at' : - " \ K(t\t') and obj_at' P t' \ asUser t f \ \_. obj_at' (P::Structures_H.tcb \ bool) t' \" - apply (simp add: asUser_def ) + "\ K(t\t') and obj_at' P t' \ asUser t f \ \_. obj_at' (P::Structures_H.tcb \ bool) t' \" + including no_pre + apply (simp add: asUser_def) apply wp - apply (simp add: split_def) - apply (wp threadSet_obj_at'_strongish) + apply (simp add: split_def) + apply (wp threadSet_obj_at'_strongish)+ apply (case_tac "t=t'") apply clarsimp apply clarsimp apply (rule hoare_drop_imps)+ apply wp -done + done lemma getObject_sched: @@ -355,8 +356,10 @@ lemma getMRs_rel_state: apply (erule doMachineOp_state) done +(* FIXME: move *) lemma setTCB_cur: "\cur_tcb'\ setObject t (v::tcb) \\_. cur_tcb'\" + including no_pre apply (wp cur_tcb_lift) apply (simp add: setObject_def split_def updateObject_default_def) apply wp @@ -985,7 +988,7 @@ lemma restart_ccorres: apply (wp sts_valid_queues setThreadState_st_tcb)[1] apply (simp add: valid_tcb_state'_def) apply wp - apply (wp_once sch_act_wf_lift, wp tcb_in_cur_domain'_lift) + apply (wp_once sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+) apply (rule hoare_strengthen_post) apply (rule hoare_vcg_conj_lift) apply (rule delete_one_conc_fr.cancelIPC_invs) @@ -1092,7 +1095,7 @@ lemma invokeTCB_CopyRegisters_ccorres: apply simp apply (ctac(no_vcg) add: getRestartPC_ccorres) apply (ctac add: setNextPC_ccorres) - apply wp + apply wp+ apply (clarsimp simp: guard_is_UNIV_def) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_when[where R=\]) @@ -1367,7 +1370,7 @@ lemma asUser_getMRs_rel: apply wp apply (simp del: fun_upd_apply) apply (wp getObject_tcb_wp) - apply (wp threadGet_wp) + apply (wp threadGet_wp)+ apply (clarsimp simp del: fun_upd_apply) apply (drule obj_at_ko_at')+ apply (clarsimp simp del: fun_upd_apply) @@ -1508,12 +1511,12 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]: apply (rule ccorres_return_CE, simp+)[1] apply wp apply (simp add: guard_is_UNIV_def) - apply wp - apply (simp del: hoare_post_taut) + apply wp+ + apply simp apply (rule mapM_x_wp') apply (rule hoare_pre, wp) apply clarsimp - apply (simp del: hoare_post_taut) + apply simp apply wp apply (simp add: guard_is_UNIV_def) apply (rule hoare_drop_imps) @@ -1521,8 +1524,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]: apply (wp mapM_x_wp') apply (rule hoare_pre, wp asUser_sysargs_rel) apply clarsimp - apply (rule hoare_pre, wp) - apply simp + apply wpsimp apply (simp add: guard_is_UNIV_def) apply (wp) apply vcg @@ -2004,11 +2006,11 @@ shows apply (rule ccorres_from_vcg_throws[where P=\ and P'=UNIV]) apply (rule allI, rule conseqPre, vcg) apply (simp add: return_def) - apply wp + apply wp+ apply (simp cong: rev_conj_cong) apply wp apply (wp asUser_inv mapM_wp' getRegister_inv - asUser_get_registers[simplified] static_imp_wp) + asUser_get_registers[simplified] static_imp_wp)+ apply (rule hoare_strengthen_post, rule asUser_get_registers) apply (clarsimp simp: obj_at'_def genericTake_def frame_gp_registers_convs) @@ -2966,7 +2968,7 @@ lemma decodeTCBConfigure_ccorres: apply (rule ccorres_cond_true_seq) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) - apply wp + apply wp+ apply (rule ccorres_rhs_assoc)+ apply csymbr apply (simp del: Collect_const) @@ -3986,7 +3988,7 @@ lemma decodeSetSpace_ccorres: apply (rule ccorres_cond_true_seq) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) - apply wp + apply wp+ apply (rule ccorres_rhs_assoc)+ apply csymbr apply (simp add: tcb_cnode_index_defs[THEN ptr_add_assertion_positive[OF ptr_add_assertion_positive_helper]] @@ -4074,7 +4076,7 @@ lemma decodeSetSpace_ccorres: apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply simp - apply (wp hoare_drop_imps)[1] + apply (wp hoare_drop_imps) apply (wp injection_wp_E [OF refl]) apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def all_ex_eq_helper syscall_error_rel_def diff --git a/proof/crefine/VSpace_C.thy b/proof/crefine/VSpace_C.thy index 7bd49eba4..bca0443c3 100644 --- a/proof/crefine/VSpace_C.thy +++ b/proof/crefine/VSpace_C.thy @@ -278,7 +278,7 @@ lemma loadHWASID_ccorres: apply simp apply wp[1] apply (rule findPDForASIDAssert_pd_at_wp2) - apply wp + apply wp+ apply (clarsimp simp: asidLowBits_handy_convs word_sless_def word_sle_def Collect_const_mem asid_shiftr_low_bits_less) done @@ -498,7 +498,7 @@ lemma handleVMFault_ccorres: apply (clarsimp simp: errstate_def) apply (clarsimp simp: EXCEPTION_FAULT_def EXCEPTION_NONE_def) apply (simp add: seL4_Fault_VMFault_lift false_def) - apply wp + apply wp+ apply (simp add: vm_fault_type_from_H_def Kernel_C.ARMDataAbort_def Kernel_C.ARMPrefetchAbort_def) apply (simp add: ccorres_cond_univ_iff ccorres_cond_empty_iff) apply (rule ccorres_rhs_assoc)+ @@ -507,13 +507,13 @@ lemma handleVMFault_ccorres: apply (ctac (no_vcg) pre: ccorres_liftE_Seq) apply (ctac (no_vcg) add: getIFSR_ccorres pre: ccorres_liftE_Seq) apply (rule ccorres_from_vcg_throws [where P=\ and P'=UNIV]) - apply (clarsimp simp add: throwError_def throw_def return_def) + apply (clarsimp simp add: throwError_def throw_def return_def) apply (rule conseqPre) apply vcg apply (clarsimp simp: errstate_def) apply (clarsimp simp: EXCEPTION_FAULT_def EXCEPTION_NONE_def) apply (simp add: seL4_Fault_VMFault_lift true_def mask_def) - apply wp + apply wp+ apply simp done @@ -930,11 +930,7 @@ lemma ccorres_pre_getObject_asidpool: apply (rule_tac Q="ko_at' rv p s" in conjunct1) apply assumption apply assumption - apply (wp getASID_wp empty_fail_getObject | simp) - apply (wp getASID_wp empty_fail_getObject | simp) - apply (wp getASID_wp empty_fail_getObject | simp) - apply (wp getASID_wp empty_fail_getObject | simp) - apply clarsimp + apply (wpsimp wp: getASID_wp empty_fail_getObject)+ apply (erule cmap_relationE1 [OF rf_sr_cpspace_asidpool_relation], erule ko_at_projectKO_opt) apply simp @@ -1138,11 +1134,9 @@ lemma flushSpace_ccorres: rule invalidateTLB_ASID_ccorres [simplified dc_def xfdc_def], simp+)[1] apply vcg - apply wp - apply simp -done - - + apply wp+ + apply simp + done @@ -1424,7 +1418,7 @@ lemma getHWASID_ccorres: apply (ctac(no_vcg) add: findFreeHWASID_ccorres) apply (ctac(no_vcg) add: storeHWASID_ccorres) apply (rule ccorres_return_C, simp+)[1] - apply wp + apply wp+ apply (strengthen all_invs_but_ct_idle_or_in_cur_domain_valid_pde_mappings') apply (wp findFreeHWASID_invs_no_cicd') apply (rule ccorres_cond_true) @@ -1751,7 +1745,7 @@ lemma doFlush_ccorres: apply (ctac (no_vcg) add: invalidateCacheRange_I_ccorres) apply (ctac (no_vcg) add: branchFlushRange_ccorres) apply (ctac (no_vcg) add: isb_ccorres) - apply wp + apply wp+ apply simp apply (clarsimp simp: Collect_const_mem) apply (auto simp: flushtype_relation_def o_def @@ -1805,7 +1799,7 @@ lemma performPageFlush_ccorres: apply (simp add: cur_tcb'_def[symmetric]) apply (rule_tac Q="\_ s. invs' s \ cur_tcb' s" in hoare_post_imp) apply (simp add: invs'_invs_no_cicd) - apply (wp) + apply wp+ apply (simp) apply (rule_tac P=\ and P'=UNIV in ccorres_from_vcg_throws) apply (rule allI, rule conseqPre, vcg) @@ -1995,7 +1989,7 @@ lemma performPageDirectoryInvocationFlush_ccorres: apply (simp add: cur_tcb'_def[symmetric]) apply (rule_tac Q="\_ s. invs' s \ cur_tcb' s" in hoare_post_imp) apply (simp add: invs'_invs_no_cicd) - apply (wp) + apply wp+ apply (simp) apply (rule_tac P=\ and P'=UNIV in ccorres_from_vcg_throws) apply (rule allI, rule conseqPre, vcg) diff --git a/proof/drefine/Arch_DR.thy b/proof/drefine/Arch_DR.thy index 514607fb8..b3b280118 100644 --- a/proof/drefine/Arch_DR.thy +++ b/proof/drefine/Arch_DR.thy @@ -192,18 +192,16 @@ lemma lookup_pt_slot_aligned_6': apply (rule hoare_gen_asmE) apply (simp add:lookup_pt_slot_def) apply (wp|wpc)+ - apply clarsimp - apply (rule hoare_strengthen_post[where Q = "\r. valid_pde r and pspace_aligned"] ) - apply wp + apply clarsimp + apply (rule hoare_strengthen_post[where Q = "\r. valid_pde r and pspace_aligned"] ) + apply wp + apply simp+ + apply (clarsimp simp:valid_pde_def dest!:pt_aligned split:ARM_A.pde.splits) + apply (erule aligned_add_aligned) + apply (rule is_aligned_shiftl) + apply (rule is_aligned_andI1) + apply (rule is_aligned_shiftr) apply simp+ - apply (clarsimp simp:valid_pde_def dest!:pt_aligned - split:ARM_A.pde.splits) - apply (erule aligned_add_aligned) - apply (rule is_aligned_shiftl) - apply (rule is_aligned_andI1) - apply (rule is_aligned_shiftr) - apply simp - apply simp done lemma create_mapping_entries_dcorres: @@ -253,7 +251,7 @@ proof - apply assumption apply (clarsimp) apply (rule dcorres_lookup_pt_slot) - apply wp + apply wp+ apply simp apply (clarsimp simp: dest!:page_directory_at_aligned_pd_bits ) @@ -278,7 +276,7 @@ proof - apply assumption apply (clarsimp) apply (rule dcorres_lookup_pt_slot) - apply (wp lookup_pt_slot_aligned_6') + apply (wp lookup_pt_slot_aligned_6')+ apply simp apply (clarsimp simp: dest!:page_directory_at_aligned_pd_bits ) @@ -705,6 +703,7 @@ next next case (PageCap dev base rights pgsz asid) thus ?case + including no_pre apply (simp add: Decode_D.decode_invocation_def decode_invocation_def arch_decode_invocation_def split del: if_split) @@ -731,7 +730,7 @@ next apply (rule_tac r'=dc and P'="I" and Q'="\rv. I and (\\ (lookup_pd_slot rv x21 && ~~ mask pd_bits))" for I in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified]) apply (rule corres_from_rdonly, simp_all)[1] - apply (wp | simp)+ + apply (wp+ | simp)+ apply (rule hoare_strengthen_post, rule hoare_post_taut) apply (case_tac r, auto simp add: in_monad)[1] apply (simp add: corres_whenE_throwError_split_rhs corres_alternate2 @@ -749,16 +748,16 @@ next apply simp apply (fastforce simp: neq_Nil_conv valid_cap_simps dest!:page_directory_at_rev) apply (rule corres_from_rdonly[where P=\ and P'=\], simp_all)[1] - apply (wp | simp)+ + apply (wp+ | simp)+ apply (rule validE_cases_valid, rule hoare_pre) - apply (wp | simp)+ + apply (wp+ | simp)+ apply (clarsimp simp add: in_monad conj_disj_distribR[symmetric]) apply (simp add: conj_disj_distribR cong: conj_cong) apply (simp add: arch_invocation_relation_def translate_arch_invocation_def transform_page_inv_def update_cap_rights_def update_mapping_cap_status_def Types_D.cap_rights_def mask_vm_rights_def transform_mapping_def) - apply wp + apply wp+ apply (rule hoare_pre, wp, simp) apply (rule hoare_pre, wp, auto)[1] apply (wp | simp add: whenE_def split del: if_split)+ @@ -803,7 +802,7 @@ next transform_page_inv_def update_cap_rights_def update_mapping_cap_status_def Types_D.cap_rights_def mask_vm_rights_def) - apply wp + apply wp+ apply (rule hoare_pre, wp, simp) apply (rule hoare_pre, wp, auto)[1] apply (wp | simp add: whenE_def split del: if_split)+ @@ -814,8 +813,7 @@ next apply (clarsimp) apply (rule corres_from_rdonly) apply (wp, clarsimp) - apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp) - apply (assumption) + apply (simp only: Let_unfold, wp+, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+) apply (rule validE_cases_valid, rule hoare_pre) apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def transform_page_inv_def)+ @@ -825,8 +823,7 @@ next apply (metis flush.exhaust) apply (rule corres_from_rdonly) apply (wp, clarsimp) - apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp) - apply (assumption) + apply (simp only: Let_unfold, wp+, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+) apply (rule validE_cases_valid, rule hoare_pre) apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def transform_page_inv_def)+ @@ -836,8 +833,7 @@ next apply (metis flush.exhaust) apply (rule corres_from_rdonly) apply (wp, clarsimp) - apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp) - apply (assumption) + apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+) apply (rule validE_cases_valid, rule hoare_pre) apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def transform_page_inv_def)+ @@ -847,8 +843,7 @@ next apply (metis flush.exhaust) apply (rule corres_from_rdonly) apply (wp, clarsimp) - apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp) - apply (assumption) + apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp) apply (rule validE_cases_valid, rule hoare_pre) apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def transform_page_inv_def)+ @@ -1323,7 +1318,7 @@ lemma invoke_page_table_corres: apply (wp store_pte_cte_wp_at) apply fastforce apply (clarsimp simp:valid_cap_def vmsz_aligned_def mask_2pm1)+ - apply (wp hoare_post_taut) + apply (wp hoare_post_taut)+ apply (rule_tac Q="\rv s. invs s \ valid_etcbs s \ a \ idle_thread s \ cte_wp_at \ (a,b) s \ caps_of_state s' = caps_of_state s" in hoare_strengthen_post) apply wp @@ -1348,14 +1343,14 @@ lemma set_vm_root_for_flush_dwp[wp]: "\\ps. transform ps = cs\ set_vm_root_for_flush word1 word2 \\r s. transform s = cs\" apply (simp add:set_vm_root_for_flush_def) apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+ - apply (wpc) - apply wp - apply (rule hoare_conjI,rule hoare_drop_imp) - apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+ - apply (wpc|wp)+ - apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) - apply (wp|clarsimp)+ -done + apply (wpc) + apply wp+ + apply (rule hoare_conjI,rule hoare_drop_imp) + apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+ + apply (wpc|wp)+ + apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) + apply (wp|clarsimp)+ + done lemma diminished_page_is_page: "diminished (cap.ArchObjectCap (arch_cap.PageCap dev x rs sz mp)) c @@ -1555,27 +1550,26 @@ lemma invoke_page_directory_corres: (invoke_page_directory ip) (perform_page_directory_invocation ip')" apply (clarsimp simp:invoke_page_directory_def) apply (case_tac ip') - apply (simp_all add:perform_page_invocation_def) - apply (simp_all add: when_def transform_page_dir_inv_def) - apply safe - apply (clarsimp) + apply (simp_all add:perform_page_invocation_def) + apply (simp_all add: when_def transform_page_dir_inv_def) + apply safe + apply (clarsimp) + apply (rule corres_dummy_return_r) + apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\ and P'=\]]) + apply wp + apply (clarsimp simp: perform_page_directory_invocation_def) + apply (wp) + apply (rule dcorres_to_wp, rule dcorres_set_vm_root) + apply (wp) + apply (clarsimp) + apply (wp do_machine_op_wp, clarsimp, wp+) + apply (clarsimp) apply (rule corres_dummy_return_r) apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\ and P'=\]]) apply wp apply (clarsimp simp: perform_page_directory_invocation_def) - apply (wp) - apply (rule dcorres_to_wp, rule dcorres_set_vm_root) - apply (wp) - apply (clarsimp) - apply (wp do_machine_op_wp, clarsimp, wp) - apply (clarsimp) - apply (rule corres_dummy_return_r) - apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\ and P'=\]]) - apply wp - apply (clarsimp simp: perform_page_directory_invocation_def) -done + done -(* NOONE EVER SEES THIS OK *) lemma pte_check_if_mapped_corres: "dcorres dc \ \ (return a) (pte_check_if_mapped pte)" apply (clarsimp simp add: pte_check_if_mapped_def get_master_pte_def get_pte_def get_pt_def bind_assoc in_monad get_object_def corres_underlying_def) @@ -1785,7 +1779,7 @@ lemma invoke_page_corres: apply (erule notE) apply (rule dcorres_symb_exec_r)+ apply (rule dcorres_set_vm_root) - apply (wp) + apply (wp)+ apply (erule notE)+ apply (clarsimp) apply (wp do_machine_op_wp | clarsimp)+ @@ -1897,7 +1891,7 @@ proof - transform_current_thread_def) apply (clarsimp simp:transform_asid_table_def transform_asid_def fun_upd_def[symmetric] unat_map_upd) - apply wp + apply wp+ apply (rule_tac Q="\rv s. cte_wp_at (\c. \idx. c = (cap.UntypedCap False frame pageBits idx)) cref s \ asid_pool_at frame s diff --git a/proof/drefine/CNode_DR.thy b/proof/drefine/CNode_DR.thy index 5381419a5..9480447d1 100644 --- a/proof/drefine/CNode_DR.thy +++ b/proof/drefine/CNode_DR.thy @@ -476,7 +476,7 @@ proof - apply (rule corres_gets_the) apply simp apply (rule corres_trivial, rule gets_symb_exec_l) - apply (wp set_cap_caps_of_state2 set_cap_idle) + apply (wp set_cap_caps_of_state2 set_cap_idle)+ apply clarsimp apply (clarsimp simp: cte_wp_at_caps_of_state caps_of_state_transform_opt_cap @@ -522,18 +522,18 @@ lemma delete_cap_corres: apply (simp add:bindE_assoc) apply (rule corres_guard_imp) apply (rule corres_splitEE[OF _ dcorres_finalise_slot]) - apply (clarsimp simp:bindE_assoc when_def) - apply (rule empty_slot_corres) - apply wp + apply (clarsimp simp:bindE_assoc when_def) + apply (rule empty_slot_corres) + apply wp+ apply (rule validE_validE_R) apply (simp add:validE_def weak_valid_mdb_def) apply (rule hoare_drop_imp) apply (rule_tac Q = "\r. invs and not_idle_thread a and valid_etcbs" in hoare_strengthen_post) - apply (wp rec_del_invs) - apply (simp add:not_idle_thread_def validE_def) - apply wp - apply (clarsimp simp:invs_def valid_state_def valid_mdb_def) - apply clarsimp+ + apply (wp rec_del_invs) + apply (simp add:not_idle_thread_def validE_def) + apply wp + apply (clarsimp simp:invs_def valid_state_def valid_mdb_def) + apply clarsimp+ apply (simp add:cap_table_at_cte_at) apply (clarsimp simp:emptyable_def obj_at_def is_cap_table_def) apply (clarsimp simp:is_tcb_def split:Structures_A.kernel_object.splits) @@ -551,18 +551,18 @@ lemma delete_cap_corres': apply (simp add:bindE_assoc) apply (rule corres_guard_imp) apply (rule corres_splitEE[OF _ dcorres_finalise_slot]) - apply (clarsimp simp:bindE_assoc when_def) - apply (rule empty_slot_corres) - apply wp + apply (clarsimp simp:bindE_assoc when_def) + apply (rule empty_slot_corres) + apply wp+ apply (rule validE_validE_R) apply (simp add:validE_def weak_valid_mdb_def) apply (rule hoare_drop_imp) apply (rule_tac Q = "\r. invs and not_idle_thread a and valid_etcbs" in hoare_strengthen_post) - apply (wp rec_del_invs) - apply (simp add:not_idle_thread_def validE_def) - apply wp - apply (clarsimp simp:invs_def valid_state_def valid_mdb_def) - apply (clarsimp simp:not_idle_thread_def)+ + apply (wp rec_del_invs) + apply (simp add:not_idle_thread_def validE_def) + apply wp + apply (clarsimp simp:invs_def valid_state_def valid_mdb_def) + apply (clarsimp simp:not_idle_thread_def)+ done definition boolean_exception :: "'c + bool \ 'a+'b \ bool" @@ -1029,7 +1029,7 @@ lemma dcorres_ep_cancel_badge_sends: apply (clarsimp simp: valid_etcbs_2_def) apply (drule_tac x=ptr in spec) apply (clarsimp simp: st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def) - apply wp + apply wp+ apply (clarsimp) apply (rule corres_guard_imp) apply (rule corres_split_noop_rhs[OF _ corres_dummy_set_sync_ep]) @@ -1328,29 +1328,7 @@ lemma dcorres_clear_object_caps_asid_pool: lemma valid_idle_invs_strg: "invs s \ valid_idle s" by fastforce -lemma store_hw_asid_idle[wp]: - "\\s. P (idle_thread s)\ store_hw_asid a xa \\xb a. P (idle_thread a)\" - apply (simp add:store_hw_asid_def) - apply wp - apply (rule_tac Q = "\r s. P (idle_thread s)" in hoare_strengthen_post) - apply wp - apply simp -done - -lemma invalidate_hw_asid_enty_idle[wp]: - "\\s. P (idle_thread s)\ invalidate_hw_asid_entry xb \\r s. P (idle_thread s)\" - by (simp add:invalidate_hw_asid_entry_def | wp)+ - -lemma invalidate_asid_idle[wp]: - "\\s. P (idle_thread s)\ invalidate_asid x \\y s. P (idle_thread s)\" - by (simp add:invalidate_asid_def | wp)+ - -crunch idle[wp] : flush_space "\s. P (idle_thread s)" crunch idle[wp] : invalidate_tlb_by_asid "\s. P (idle_thread s)" -crunch idle[wp] : page_table_mapped "\s. P (idle_thread s)" -crunch idle[wp] : store_pte "\s. P (idle_thread s)" -crunch idle[wp] : copy_global_mappings "\s. P (idle_thread s)" - (wp: crunch_wps simp: crunch_simps) crunch st_tcb_at[wp]: invalidate_tlb_by_asid "st_tcb_at P thread" crunch st_tcb_at[wp] : copy_global_mappings "st_tcb_at P thread" @@ -1358,16 +1336,7 @@ crunch st_tcb_at[wp] : copy_global_mappings "st_tcb_at P thread" lemma delete_asid_pool_idle [wp]: "\\s. P (idle_thread s)\ ARM_A.delete_asid_pool p q\\r s. P (idle_thread s)\" - apply (simp add:delete_asid_pool_def) - apply wp - apply (rule mapM_wp) - apply wp - apply (rule_tac Q = "\r s. P (idle_thread s)" in hoare_strengthen_post) - apply (clarsimp simp:load_hw_asid_def find_free_hw_asid_def invalidate_asid_entry_def arm_context_switch_def get_hw_asid_def | wp | wpc)+ - apply fastforce - apply wp - apply clarsimp -done + by (rule delete_asid_pool_idle_thread) crunch idle [wp]: cancel_badged_sends "\s. P (idle_thread s)" (wp: crunch_wps dxo_wp_weak filterM_preserved simp: crunch_simps) @@ -1402,7 +1371,7 @@ lemma dcorres_storeWord_mapM_x_cvt: apply (rule_tac Cons.hyps) using Cons apply simp - apply wp + apply wp+ using Cons apply fastforce apply (wp|clarsimp|force)+ @@ -1904,7 +1873,7 @@ lemma dcorres_thread_get_get_object_split: apply (drule opt_object_tcb, simp, simp add: not_idle_thread_def) apply (simp add: transform_tcb_def obj_tcb_def) apply (rule c) - apply wp + apply wp+ apply clarsimp apply simp apply simp @@ -2059,7 +2028,7 @@ lemma invoke_cnode_corres: apply (erule corres_if) apply (rule swap_cap_corres) apply (rule corres_split_nor [OF move_cap_corres move_cap_corres]) - apply wp + apply wp+ apply (simp add: cte_wp_at_caps_of_state not_idle_thread_def) apply (wp cap_move_caps_of_state) apply simp @@ -2090,7 +2059,7 @@ lemma invoke_cnode_corres: apply (rule move_cap_corres) apply (rule corres_trivial[OF corres_free_fail]) apply (simp add: transform_tcb_slot_simp) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (auto simp: transform_def transform_current_thread_def ct_in_state_def not_idle_thread_def cte_wp_at_caps_of_state @@ -2148,7 +2117,7 @@ lemma decode_cnode_error_corres: apply (rule corres_trivial) apply (simp split: invocation_label.split list.split) apply auto[1] - apply wp + apply wp+ apply (elim disjE, simp_all) apply (simp add: whenE_def) apply (clarsimp simp: whenE_def) @@ -2196,7 +2165,7 @@ lemma lookup_slot_for_cnode_op_corres: apply clarsimp apply (rule corres_returnOk, rule refl) apply (clarsimp simp: neq_Nil_conv) - apply wp + apply wp+ done lemma dcorres_ensure_empty: @@ -2228,7 +2197,7 @@ lemma derive_cap_dummy: apply (rule corres_split [OF _ ensure_no_children_dummy, where R="\_. \" and R'="\_. \"]) apply (clarsimp simp: corres_underlying_def lift_def return_def split: sum.splits) apply (fastforce simp: in_monad) - apply wp + apply wp+ apply simp apply simp apply (simp add: liftME_def) @@ -2294,7 +2263,8 @@ lemma derive_cap_dcorres: apply (rule dcorres_returnOk) apply simp apply (rule dcorres_ensure_no_children) - apply wp[2] + apply wp + apply wp apply simp apply fastforce apply (simp add: arch_derive_cap_def) @@ -2534,9 +2504,9 @@ lemma decode_cnode_corres: apply (simp add:translate_cnode_invocation_def) apply simp apply (rule dcorres_throw) - apply wp + apply wp+ apply simp - apply wp + apply wp+ apply (rule hoare_post_imp_R[OF validE_validE_R]) apply (rule hoareE_TrueI[where P = \]) apply (wp|simp)+ @@ -2608,7 +2578,8 @@ lemma decode_cnode_corres: apply (rule lookup_slot_for_cnode_op_corres, simp_all)[1] apply (rule dcorres_returnOk) apply (simp add: translate_cnode_invocation_def) - apply wp[2] + apply wp + apply wp apply simp apply fastforce apply (clarsimp simp: defns split: splits) @@ -2618,7 +2589,7 @@ lemma decode_cnode_corres: apply (rule lookup_slot_for_cnode_op_corres, simp_all)[1] apply (rule dcorres_returnOk) apply (simp add: translate_cnode_invocation_def) - apply wp[2] + apply (wp+)[2] apply simp apply fastforce apply (clarsimp simp: defns split: splits) @@ -2632,7 +2603,7 @@ lemma decode_cnode_corres: apply (rule dcorres_ensure_empty) apply (rule dcorres_returnOk) apply (simp add: translate_cnode_invocation_def) - apply (wp lsfco_not_idle) + apply (wp lsfco_not_idle)+ apply simp apply fastforce apply (clarsimp simp: defns split: splits) @@ -2734,7 +2705,7 @@ lemma decode_cnode_corres: in hoare_post_imp_R) apply (wp lsfco_not_idle) apply (clarsimp simp:Invariants_AI.cte_wp_valid_cap) - apply (wp lsfco_not_idle) + apply (wp lsfco_not_idle)+ apply simp apply fastforce apply (erule disjE) diff --git a/proof/drefine/Corres_D.thy b/proof/drefine/Corres_D.thy index 6eda5fc07..4592cec95 100644 --- a/proof/drefine/Corres_D.thy +++ b/proof/drefine/Corres_D.thy @@ -38,7 +38,7 @@ lemma OR_choice_OR[simp]: "(OR_choice c (f :: ('a,unit) s_monad) g) = (f OR g)" apply (case_tac "g s") by (intro conjI set_eqI; clarsimp?; blast) -lemma OR_choiceE_OR[simp]: "(OR_choiceE c (f :: ('a + 'b,unit) s_monad) g) = (f OR g)" +lemma OR_choiceE_OR[simp]: "(OR_choiceE c (f :: ('a + 'b,unit) s_monad) g) = (f \ g)" apply (clarsimp simp: OR_choiceE_def bindE_def liftE_def) apply (clarsimp simp: alternative_def get_def select_def return_def bind_def select_f_def mk_ef_def wrap_ext_unit_def wrap_ext_bool_unit_def image_def @@ -218,7 +218,7 @@ lemma dcorres_get: apply (rule dcorres_expand_pfx) apply (rule_tac r'="\r r'. s=r \ s'=r'" and P="%x. op=s" and P'="%x. op=s'" in corres_underlying_split) apply (clarsimp simp: corres_underlying_def get_def) - apply wp + apply wp+ apply (drule A) apply clarsimp+ done @@ -278,7 +278,6 @@ lemma hoare_mapM_idempotent: "\ \ a R. \ R \ x a \< apply (erule_tac x=R in allE) apply (rule hoare_seq_ext) apply wp - apply assumption apply assumption done diff --git a/proof/drefine/Finalise_DR.thy b/proof/drefine/Finalise_DR.thy index f4a3fd3c9..dbed53c3a 100644 --- a/proof/drefine/Finalise_DR.thy +++ b/proof/drefine/Finalise_DR.thy @@ -205,10 +205,10 @@ lemma delete_cdt_slot_shrink_descendants: done lemma delete_cap_one_shrink_descendants: - "\\s. s = pres \ invs s \ slot \ CSpaceAcc_A.descendants_of p (cdt pres) \ cap_delete_one slot \\r s. slot \ CSpaceAcc_A.descendants_of p (cdt s) \ CSpaceAcc_A.descendants_of p (cdt s) \ CSpaceAcc_A.descendants_of p (cdt pres) \" + including no_pre apply (simp add:cap_delete_one_def unless_def) apply wp apply (clarsimp simp add:empty_slot_def) @@ -297,7 +297,7 @@ lemma caps_of_state_transform_opt_cap_no_idle: length_set_helper word_bl.Abs_inverse object_slots_def nat_bl_to_bin_lt2p) apply (frule(1) valid_etcbs_tcb_etcb) - apply (clarsimp simp: opt_cap_def transform_cslot_ptr_def + by (clarsimp simp: opt_cap_def transform_cslot_ptr_def slots_of_def opt_object_def restrict_map_def transform_def object_slots_def transform_objects_def valid_irq_node_def obj_at_def is_cap_table_def @@ -305,7 +305,6 @@ lemma caps_of_state_transform_opt_cap_no_idle: tcb_pending_op_slot_def tcb_cap_cases_def tcb_boundntfn_slot_def bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0 split: if_split_asm option.splits) - done lemma transform_cap_Null [simp]: "(transform_cap cap = cdl_cap.NullCap) = (cap = cap.NullCap)" @@ -353,7 +352,7 @@ lemma dcorres_revoke_the_cap_corres: apply (rule corres_split[OF dcorres_revoke_cap_no_descendants]) apply simp apply (rule delete_cap_simple_corres) - apply (wp cap_delete_one_cte_at) + apply (wp cap_delete_one_cte_at)+ apply (rule_tac pres1 = s' and p1 = slot in hoare_strengthen_post[OF delete_cap_one_shrink_descendants]) apply (simp_all add:invs_def valid_state_def valid_mdb_def) apply fastforce @@ -373,7 +372,7 @@ lemma valid_ntfn_after_remove_slot: \ valid_ntfn (ntfn_set_obj ntfn (case remove1 ptr list of [] \ Structures_A.ntfn.IdleNtfn | a # lista \ Structures_A.ntfn.WaitingNtfn (remove1 ptr list))) s'" - apply (clarsimp simp: valid_ntfn_def distinct_remove1 + apply (clarsimp simp: valid_ntfn_def split: ntfn.splits list.split_asm list.splits option.splits) by (metis (mono_tags) distinct.simps(2) distinct_length_2_or_more distinct_remove1 set_remove1) @@ -401,7 +400,7 @@ lemma finalise_cancel_ipc: apply clarsimp apply (rule corres_dummy_return_pr) apply (rule corres_split [OF _ dcorres_revoke_cap_unnecessary]) - apply (simp add:K_bind_def when_def dc_def[symmetric]) + apply (simp add: when_def dc_def[symmetric]) apply (rule set_thread_state_corres) apply (wp sts_only_idle sts_st_tcb_at' valid_ep_queue_subset | clarsimp simp:not_idle_thread_def)+ apply (simp add:get_blocking_object_def | wp)+ @@ -511,17 +510,13 @@ lemmas dmo_dwp = do_machine_op_wp [OF allI] lemma machine_op_lift[wp]: "\\ms. underlying_memory ms = m\ machine_op_lift x \\rv ms. underlying_memory ms = m\" apply (clarsimp simp:machine_rest_lift_def ignore_failure_def machine_op_lift_def) - apply wp - apply (clarsimp simp:simpler_modify_def valid_def) - apply (assumption) - apply wp - apply clarsimp -done + apply (wpsimp simp:simpler_modify_def valid_def) + done lemma invalidateTLB_ASID_underlying_memory[wp]: "\\ms. underlying_memory ms = m\ invalidateTLB_ASID a \\rv ms. underlying_memory ms = m\" - apply (clarsimp simp: invalidateTLB_ASID_def, wp) -done + apply (clarsimp simp: invalidateTLB_ASID_def, wp) + done lemma dsb_underlying_memory[wp]: "\\ms. underlying_memory ms = m\ dsb \\rv ms. underlying_memory ms = m\" apply (clarsimp simp: dsb_def, wp) @@ -544,49 +539,50 @@ lemma flush_space_dwp[wp]: "\\ps. transform ps = cs\ flush_space x \\r ps. transform ps = cs\" apply (clarsimp simp:flush_space_def) apply (wp|wpc)+ - apply (clarsimp split:option.splits) - apply (rule do_machine_op_wp) - apply clarsimp - apply (wp static_imp_wp) - apply (rule do_machine_op_wp) - apply clarsimp - apply wp - apply (rule hoare_allI) - apply (rule hoare_drop_imp) - apply (rule do_machine_op_wp) - apply clarsimp - apply wp - apply (rule hoare_conjI) + apply (clarsimp split:option.splits) + apply (rule do_machine_op_wp) + apply clarsimp + apply (wp static_imp_wp)+ + apply (rule do_machine_op_wp) + apply clarsimp + apply wp + apply (rule hoare_allI) apply (rule hoare_drop_imp) - apply (clarsimp simp:load_hw_asid_def) + apply (rule do_machine_op_wp) + apply clarsimp apply wp - apply (clarsimp simp:load_hw_asid_def) + apply (rule hoare_conjI) + apply (rule hoare_drop_imp) + apply (clarsimp simp:load_hw_asid_def) apply wp -done + apply (clarsimp simp:load_hw_asid_def) + apply wp + apply assumption + done lemma invalidate_asid_dwp[wp]: "\\ps. transform ps = cs\ invalidate_asid (the (hw_asid_table next_asid)) \\x ps. transform ps = cs\" apply (clarsimp simp:invalidate_asid_def) apply wp apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def) -done + done lemma invalidate_asid_entry_dwp[wp]: "\\ps. transform ps = cs\ invalidate_asid_entry x \\r ps. transform ps = cs\" apply (clarsimp simp:invalidate_asid_entry_def) apply wp - apply (clarsimp simp:invalidate_asid_def) - apply wp + apply (clarsimp simp:invalidate_asid_def) + apply wp+ apply (clarsimp simp:invalidate_hw_asid_entry_def) - apply wp - apply (subgoal_tac "transform s = cs") - prefer 2 - apply (assumption) + apply wp+ + apply (subgoal_tac "transform s = cs") + prefer 2 + apply (assumption) + apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def) + apply (clarsimp simp:load_hw_asid_def) + apply wp apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def) - apply (clarsimp simp:load_hw_asid_def) - apply wp - apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def) -done + done lemma invalidate_hw_asid_entry_dwp[wp]: "\\s. transform s = cs\ invalidate_hw_asid_entry next_asid \\xb a. transform a = cs\" @@ -698,18 +694,17 @@ lemma dcorres_set_vm_root: "dcorres dc \ \ (return x) (set_vm_root rvd)" apply (clarsimp simp: set_vm_root_def) apply (rule dcorres_symb_exec_r)+ - apply (clarsimp simp:catch_def throwError_def) + apply (clarsimp simp:catch_def throwError_def) apply (rule corres_dummy_return_r) apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\ and P'=\]])+ - apply wp + apply wp+ apply wpc - apply (wp do_machine_op_wp | clarsimp)+ - apply (rule_tac Q = "\_ s. transform s = cs" in hoare_post_imp) + apply (wp do_machine_op_wp | clarsimp)+ + apply (rule_tac Q = "\_ s. transform s = cs" in hoare_post_imp) apply simp - apply (rule hoare_pre) - apply (wp hoare_whenE_wp do_machine_op_wp [OF allI] hoare_drop_imps find_pd_for_asid_inv - | wpc | simp add: arm_context_switch_def get_hw_asid_def load_hw_asid_def if_apply_def2)+ - done + apply (wpsimp wp: hoare_whenE_wp do_machine_op_wp [OF allI] hoare_drop_imps find_pd_for_asid_inv + simp: arm_context_switch_def get_hw_asid_def load_hw_asid_def if_apply_def2)+ + done lemma dcorres_delete_asid_pool: "dcorres dc \ \ @@ -753,7 +748,7 @@ lemma dcorres_delete_asid_pool: apply clarsimp apply wp apply fastforce - apply wp + apply wp+ apply simp done @@ -781,9 +776,8 @@ lemma page_table_aligned: done lemma invalidateTLB_VAASID_underlying_memory[wp]: - "\\ms. underlying_memory ms = m\ invalidateTLB_VAASID word \\rv ms. underlying_memory ms = m\" - apply (clarsimp simp: invalidateTLB_VAASID_def, wp) -done + "\\ms. underlying_memory ms = m\ invalidateTLB_VAASID word \\rv ms. underlying_memory ms = m\" + by (clarsimp simp: invalidateTLB_VAASID_def, wp) lemma dcorres_flush_page: "dcorres dc \ \ (return x) (flush_page aa a b word)" @@ -792,22 +786,22 @@ lemma dcorres_flush_page: apply wp apply (simp add:flush_page_def) apply wp - apply (rule dcorres_to_wp[OF dcorres_set_vm_root]) - apply wp - apply clarsimp - apply (wp do_machine_op_wp, clarsimp) - apply (wp) - apply (simp add:load_hw_asid_def) - apply wp - apply (clarsimp simp:set_vm_root_for_flush_def) + apply (rule dcorres_to_wp[OF dcorres_set_vm_root]) + apply wp + apply clarsimp + apply (wp do_machine_op_wp, clarsimp) + apply (wp) + apply (simp add:load_hw_asid_def) + apply wp + apply (clarsimp simp:set_vm_root_for_flush_def) apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+ - apply (wpc) - apply wp - apply (rule hoare_conjI,rule hoare_drop_imp) - apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+ - apply (wpc|wp)+ - apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) - apply (wp|clarsimp)+ + apply (wpc) + apply wp+ + apply (rule hoare_conjI,rule hoare_drop_imp) + apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+ + apply (wpc|wp)+ + apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) + apply (wp|clarsimp)+ done lemma dcorres_flush_table: @@ -817,21 +811,21 @@ lemma dcorres_flush_table: apply wp apply (simp add:flush_table_def) apply wp - apply (rule dcorres_to_wp[OF dcorres_set_vm_root]) - apply wp - apply clarsimp - apply (wp do_machine_op_wp|clarsimp)+ - apply (clarsimp simp:load_hw_asid_def) - apply wp - apply (clarsimp simp:set_vm_root_for_flush_def) - apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+ + apply (rule dcorres_to_wp[OF dcorres_set_vm_root]) + apply wp + apply clarsimp + apply (wp do_machine_op_wp|clarsimp)+ + apply (clarsimp simp:load_hw_asid_def) + apply wp + apply (clarsimp simp:set_vm_root_for_flush_def) + apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+ apply wpc - apply wp + apply wp+ apply (rule hoare_conjI,rule hoare_drop_imp) apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+ - apply (wpc|wp)+ - apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) - apply (wp|clarsimp)+ + apply (wpc|wp)+ + apply (rule_tac Q="\rv s. transform s = cs" in hoare_strengthen_post) + apply (wp|clarsimp)+ done lemma flush_table_exec: @@ -1297,20 +1291,16 @@ lemma dcorres_delete_cap_simple_section: (lookup_pd_slot pd v) and K (is_aligned pd pd_bits \ v < kernel_base)) (delete_cap_simple (cdl_lookup_pd_slot pd v)) (store_pde (lookup_pd_slot pd v) ARM_A.pde.InvalidPDE)" - apply (clarsimp simp:store_pde_def transform_pd_slot_ref_def - lookup_pd_slot_def) + apply (clarsimp simp: store_pde_def transform_pd_slot_ref_def lookup_pd_slot_def) apply (rule corres_gen_asm2) - apply (subst dcorres_lookup_pd_slot,simp add:pd_bits_def pageBits_def) - apply (clarsimp simp:transform_pd_slot_ref_def lookup_pd_slot_def) + apply (subst dcorres_lookup_pd_slot, simp add: pd_bits_def pageBits_def) + apply (clarsimp simp: transform_pd_slot_ref_def lookup_pd_slot_def) apply (rule corres_guard_imp) apply (rule corres_symb_exec_r) apply (rule dcorres_delete_cap_simple_set_pde[where oid = oid]) apply (drule(1) less_kernel_base_mapping_slots) - apply (simp add:lookup_pd_slot_def) - apply wp - apply simp - apply simp - apply simp + apply (simp add: lookup_pd_slot_def) + apply wpsimp+ apply fastforce done @@ -1421,20 +1411,20 @@ lemma mask_compare_imply: \ (x && mask l \y && mask l) \ (x && ~~ mask (l+n)) \ (y && ~~ mask (l+n))" apply (rule ccontr) apply (subgoal_tac "x = y") - apply simp + apply simp apply (rule word_eqI) apply clarsimp apply (case_tac "na na") - apply (drule_tac na = na in test_bits_neg_mask) - apply clarsimp+ + apply (drule_tac na = na in test_bits_neg_mask) + apply clarsimp+ apply (drule_tac na = "na-l" in test_bits_mask) - apply (clarsimp simp: linorder_not_le) - apply (subst (asm) add.commute[where a = l])+ - apply (drule nat_diff_less) - apply (clarsimp simp:word_size)+ + apply (clarsimp simp: linorder_not_le) + apply (subst (asm) add.commute[where a = l])+ + apply (drule nat_diff_less) + apply (clarsimp simp:word_size)+ apply (clarsimp simp:nth_shiftr) apply (auto simp:word_size) done @@ -1444,8 +1434,8 @@ lemma aligned_in_step_up_to: \ is_aligned x t" apply (clarsimp simp:upto_enum_step_def image_def) apply (rule aligned_add_aligned[where n = t]) - apply (rule is_aligned_mult_triv2) - apply (simp add:word_bits_def)+ + apply (rule is_aligned_mult_triv2) + apply (simp add:word_bits_def)+ done lemma remain_pt_pd_relation: @@ -1454,84 +1444,84 @@ lemma remain_pt_pd_relation: \\r s. \y\ys. pt_page_relation (y && ~~ mask pt_bits) pg_id y S s\" apply (rule hoare_vcg_const_Ball_lift) apply (subgoal_tac "ptr\ y") - apply (simp add:store_pte_def) - apply wp - apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits) - and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp) - apply (clarsimp simp:set_pt_def) - apply wp - apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits) - and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp) - apply (clarsimp simp:valid_def set_object_def in_monad) - apply (drule_tac x= y in bspec,simp) - apply (clarsimp simp:pt_page_relation_def dest!: ucast_inj_mask| rule conjI)+ - apply (drule mask_compare_imply) - apply ((simp add:word_size pt_bits_def pageBits_def is_aligned_mask)+) + apply (simp add:store_pte_def) + apply wp + apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits) + and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp) + apply (clarsimp simp:set_pt_def) + apply wp + apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits) + and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp) + apply (clarsimp simp:valid_def set_object_def in_monad) + apply (drule_tac x= y in bspec,simp) + apply (clarsimp simp:pt_page_relation_def dest!: ucast_inj_mask| rule conjI)+ + apply (drule mask_compare_imply) + apply ((simp add:word_size pt_bits_def pageBits_def is_aligned_mask)+) - apply (clarsimp simp:pt_page_relation_def obj_at_def) - apply (assumption) + apply (clarsimp simp:pt_page_relation_def obj_at_def) + apply (assumption) + apply wp + apply (simp add:get_object_def) + apply wp + apply (clarsimp simp:obj_at_def)+ + apply (assumption) apply wp - apply (simp add:get_object_def) - apply wp - apply (clarsimp simp:obj_at_def)+ - apply (assumption) - apply wp - apply (clarsimp simp:obj_at_def pt_page_relation_def)+ -done + apply (clarsimp simp:obj_at_def pt_page_relation_def)+ + done lemma remain_pd_section_relation: "\is_aligned ptr 2; is_aligned y 2; ptr \ y\ \ \\s. pd_section_relation ( y && ~~ mask pd_bits) sid y s\ store_pde ptr sp \\r s. pd_section_relation (y && ~~ mask pd_bits) sid y s\" - apply (simp add:store_pde_def) - apply wp + apply (simp add:store_pde_def) + apply wp apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) - and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) - apply (clarsimp simp:set_pd_def) - apply wp - apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) - and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) - apply (clarsimp simp:valid_def set_object_def in_monad) - apply (clarsimp simp:pd_section_relation_def dest!:ucast_inj_mask | rule conjI)+ - apply (drule mask_compare_imply) - apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+ - apply (clarsimp simp:pt_page_relation_def obj_at_def) + and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) + apply (clarsimp simp:set_pd_def) + apply wp + apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) + and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) + apply (clarsimp simp:valid_def set_object_def in_monad) + apply (clarsimp simp:pd_section_relation_def dest!:ucast_inj_mask | rule conjI)+ + apply (drule mask_compare_imply) + apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+ + apply (clarsimp simp:pt_page_relation_def obj_at_def) + apply (assumption) + apply wp + apply (simp add:get_object_def) + apply wp + apply (clarsimp simp:obj_at_def)+ apply (assumption) - apply wp - apply (simp add:get_object_def) - apply wp - apply (clarsimp simp:obj_at_def)+ - apply (assumption) - apply wp - apply (clarsimp simp:obj_at_def pt_page_relation_def)+ + apply wp + apply (clarsimp simp:obj_at_def pt_page_relation_def)+ done lemma remain_pd_super_section_relation: "\is_aligned ptr 2; is_aligned y 2; ptr \ y\ \ \\s. pd_super_section_relation ( y && ~~ mask pd_bits) sid y s\ store_pde ptr sp \\r s. pd_super_section_relation (y && ~~ mask pd_bits) sid y s\" - apply (simp add:store_pde_def) - apply wp + apply (simp add:store_pde_def) + apply wp apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) - and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) - apply (clarsimp simp:set_pd_def) - apply wp - apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) - and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) - apply (clarsimp simp:valid_def set_object_def in_monad) - apply (clarsimp simp:pd_super_section_relation_def dest!:ucast_inj_mask | rule conjI)+ - apply (drule mask_compare_imply) - apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+ - apply (clarsimp simp:pt_page_relation_def obj_at_def) + and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) + apply (clarsimp simp:set_pd_def) + apply wp + apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits) + and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp) + apply (clarsimp simp:valid_def set_object_def in_monad) + apply (clarsimp simp:pd_super_section_relation_def dest!:ucast_inj_mask | rule conjI)+ + apply (drule mask_compare_imply) + apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+ + apply (clarsimp simp:pt_page_relation_def obj_at_def) + apply (assumption) + apply wp + apply (simp add:get_object_def) + apply wp + apply (clarsimp simp:obj_at_def)+ apply (assumption) - apply wp - apply (simp add:get_object_def) - apply wp - apply (clarsimp simp:obj_at_def)+ - apply (assumption) - apply wp - apply (clarsimp simp:obj_at_def pt_page_relation_def)+ -done + apply wp + apply (clarsimp simp:obj_at_def pt_page_relation_def) + done lemma remain_pd_either_section_relation: "\\y \ set ys. is_aligned y 2;ptr\ set ys;is_aligned ptr 2\ @@ -1541,18 +1531,16 @@ lemma remain_pd_either_section_relation: \\r s. \y\set ys. (pd_super_section_relation (y && ~~ mask pd_bits) pg_id y s \ pd_section_relation (y && ~~ mask pd_bits) pg_id y s)\" + including no_pre apply (rule hoare_vcg_const_Ball_lift) apply (wp hoare_vcg_disj_lift) - apply (rule hoare_strengthen_post[OF remain_pd_super_section_relation]) - apply fastforce+ - apply (rule hoare_strengthen_post[OF remain_pd_section_relation]) - apply fastforce+ -done + apply (rule hoare_strengthen_post[OF remain_pd_super_section_relation]; fastforce) + apply (rule hoare_strengthen_post[OF remain_pd_section_relation]; fastforce) + done lemma is_aligned_less_kernel_base_helper: "\is_aligned (ptr :: word32) 6; - ucast (ptr && mask pd_bits >> 2) \ kernel_mapping_slots; - x < 0x40 \ + ucast (ptr && mask pd_bits >> 2) \ kernel_mapping_slots; x < 0x40 \ \ ucast (x + ptr && mask pd_bits >> 2) \ kernel_mapping_slots" apply (simp add: kernel_mapping_slots_def) apply (simp add: word_le_nat_alt shiftr_20_unat_ucast @@ -1696,7 +1684,7 @@ lemma dcorres_store_invalid_pde_tail_super_section: apply (rule corres_dummy_return_l) apply (rule corres_split[OF _ Cons.hyps[unfolded swp_def]]) apply (rule corres_free_return[where P=\ and P'=\]) - apply wp + apply wp+ apply simp apply (wp store_pde_non_sense_wp) apply simp @@ -1738,7 +1726,7 @@ lemma dcorres_store_invalid_pte_tail_large_page: apply (rule corres_dummy_return_l) apply (rule corres_split[OF _ Cons.hyps[unfolded swp_def]]) apply (rule corres_free_return[where P=\ and P'=\]) - apply wp + apply wp+ apply simp apply (wp store_pte_non_sense_wp) apply simp @@ -1791,7 +1779,7 @@ lemma dcorres_unmap_large_section: apply (rule_tac r'=dc in corres_split[OF corres_free_return[where P=\ and P'=\]]) apply (rule dcorres_store_invalid_pde_tail_super_section[where slot = ptr]) - apply wp + apply wp+ apply (wp store_pde_non_sense_wp) apply simp apply (simp add: hd_map_simp upto_enum_step_def upto_enum_def drop_map) @@ -1912,7 +1900,7 @@ lemma dcorres_unmap_large_page: apply (rule_tac r'=dc in corres_split[OF corres_free_return[where P=\ and P'=\]]) apply (rule dcorres_store_invalid_pte_tail_large_page[where slot = ptr]) - apply wp + apply wp+ apply (wp store_pte_non_sense_wp) apply simp apply (clarsimp simp:unat_def pt_page_relation_univ) @@ -2110,19 +2098,19 @@ lemma pd_pt_relation_page_table_mapped_wp: (lookup_pd_slot pd b && ~~ mask pd_bits) w (lookup_pd_slot pd b) s | _ \ True)\" apply (simp add:page_table_mapped_def) apply wp - apply wpc - apply (clarsimp simp:validE_def valid_def return_def returnOk_def) - apply wp + apply wpc + apply (clarsimp simp:validE_def valid_def return_def returnOk_def) + apply wp+ apply simp apply (simp add:get_pde_def) apply wp - apply (simp add:validE_def) - apply (rule hoare_strengthen_post[where Q="\rv. page_table_at w"]) - apply wp - apply (clarsimp,rule conjI) + apply (simp add:validE_def) + apply (rule hoare_strengthen_post[where Q="\rv. page_table_at w"]) + apply wp + apply (clarsimp,rule conjI) apply fastforce - apply (clarsimp simp:pd_pt_relation_def obj_at_def) -done + apply (clarsimp simp:pd_pt_relation_def obj_at_def)+ + done lemma hoare_post_Some_conj: "\ \P\f\\r s. case r of Some a \ Q a s | _ \ S \; @@ -2232,27 +2220,27 @@ lemma dcorres_page_table_mapped: [where f = dc and E = dc and E' =dc]]) apply simp apply (rule corres_splitEE[OF _ dcorres_find_pd_for_asid]) - apply (rule_tac F =" is_aligned pda 14" in corres_gen_asm2) - apply (clarsimp simp:liftE_bindE dcorres_lookup_pd_slot) - apply (rule corres_split[OF _ dcorres_get_pde]) + apply (rule_tac F =" is_aligned pda 14" in corres_gen_asm2) + apply (clarsimp simp:liftE_bindE dcorres_lookup_pd_slot) + apply (rule corres_split[OF _ dcorres_get_pde]) apply (case_tac rv') - apply (simp add:transform_pde_def) - apply (rule dcorres_returnOk,simp) - apply (simp add:transform_pde_def PPtrPAddr) - apply (intro conjI impI) + apply (simp add:transform_pde_def) + apply (rule dcorres_returnOk,simp) + apply (simp add:transform_pde_def PPtrPAddr) + apply (intro conjI impI) + apply (rule dcorres_returnOk,simp) apply (rule dcorres_returnOk,simp) + apply (simp add:transform_pde_def) apply (rule dcorres_returnOk,simp) apply (simp add:transform_pde_def) apply (rule dcorres_returnOk,simp) - apply (simp add:transform_pde_def) - apply (rule dcorres_returnOk,simp) - apply wp + apply wp+ apply (rule hoare_post_imp_R[OF find_pd_for_asid_aligned_pd]) apply simp apply (erule less_kernel_base_mapping_slots) apply (simp add:pd_bits_def pageBits_def) apply wp - apply ((simp add:dc_def,rule hoareE_TrueI[where P = \])|wp)+ + apply ((simp add:dc_def,rule hoareE_TrueI[where P = \])|wp)+ apply simp+ apply fastforce done @@ -2310,7 +2298,7 @@ lemma dcorres_unmap_page_table: apply (rule dcorres_flush_table) apply (clarsimp) apply (rule dcorres_machine_op_noop) - apply wp + apply wp+ apply (rule dcorres_unmap_page_table_store_pde) apply (wp|simp)+ apply (wp hoare_post_Some_conj) @@ -2413,6 +2401,7 @@ lemma dcorres_unmap_page: valid_cap (cap.ArchObjectCap (arch_cap.PageCap dev pg fun vmpage_size (Some (a, v))))) (PageTableUnmap_D.unmap_page (transform_asid a,v) pg (pageBitsForSize vmpage_size)) (ARM_A.unmap_page vmpage_size a v pg)" + including no_pre apply (rule dcorres_expand_pfx) apply (clarsimp simp:valid_cap_def) apply (case_tac vmpage_size) @@ -2445,7 +2434,7 @@ prefer 2 | wp lookup_pt_slot_inv find_pd_for_asid_kernel_mapping_help | safe)+ apply ((simp add:dc_def,wp)+)[3] - apply (simp add:dc_def,wp) + apply (simp add:dc_def,wp+) -- ARMLargePage @@ -2600,7 +2589,7 @@ lemma dcorres_delete_asid: apply (rule corres_dummy_return_l) apply (rule corres_split[OF corres_trivial,where r'=dc]) apply (rule dcorres_symb_exec_r[OF dcorres_set_vm_root]) - apply wp + apply wp+ apply (rule dcorres_set_asid_pool) apply simp apply (clarsimp simp:transform_asid_def) @@ -2670,7 +2659,7 @@ lemma dcorres_finalise_cap: apply (rule iffD2[OF corres_return[where P=\ and P'=\]]) apply (clarsimp simp:transform_cap_def) apply (rule set_cap_set_thread_state_inactive) - apply wp + apply wp+ apply (simp add:not_idle_thread_def) apply (wp unbind_notification_invs | simp add: not_idle_thread_def)+ apply clarsimp @@ -3080,13 +3069,12 @@ lemma swap_for_delete_corres: (swap_for_delete (transform_cslot_ptr p) (transform_cslot_ptr p')) (cap_swap_for_delete p p')" apply (rule corres_gen_asm2) - apply (simp add: swap_for_delete_def cap_swap_for_delete_def - when_def) + apply (simp add: swap_for_delete_def cap_swap_for_delete_def when_def) apply (rule corres_guard_imp) apply (rule corres_split[OF _ get_cap_corres[OF refl]])+ apply simp apply (rule swap_cap_corres) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply simp apply (clarsimp simp: cte_wp_at_caps_of_state) done @@ -3694,7 +3682,7 @@ next apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_bindE_head) apply (rule monadic_trancl_preemptible_return) - apply wp + apply wp+ apply simp apply (rule corres_underlying_gets_pre_lhs) apply (rule corres_drop_cutMon) @@ -3707,7 +3695,7 @@ next apply (rule monadic_rewrite_pick_alternative_2) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_trancl_preemptible_return) - apply wp + apply wp+ apply (rule corres_split[OF _ set_cap_corres]) apply (rule corres_underlying_gets_pre_lhs) apply (rule corres_trivial, simp add: returnOk_liftE) @@ -3856,7 +3844,7 @@ next apply (wp | simp)+ apply (simp add: in_monad) apply simp - apply (wp cutMon_validE_R_drop) + apply (wp cutMon_validE_R_drop)+ apply clarsimp apply (clarsimp simp: cte_wp_at_caps_of_state halted_emptyable) apply (frule valid_global_refsD2, clarsimp+) diff --git a/proof/drefine/Intent_DR.thy b/proof/drefine/Intent_DR.thy index 96956092b..551f22f52 100644 --- a/proof/drefine/Intent_DR.thy +++ b/proof/drefine/Intent_DR.thy @@ -1363,56 +1363,56 @@ lemma get_ipc_buffer_words_helper: apply (clarsimp dest!:get_tcb_SomeD simp:get_ipc_buffer_words_def split:cap.splits arch_cap.splits) apply (frule ipc_frame_ptr_at_frame_at[where buf = obuf],simp+) apply (frule valid_tcb_obj_ipc_align_etc[where buf = obuf],simp+) - apply (erule get_tcb_rev) + apply (erule get_tcb_rev) apply (rule arg_cong[where f = the]) apply (rule evalMonad_mapM) - defer - apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord) - apply (wp loadWord_inv) + defer + apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord) + apply (wp loadWord_inv)+ apply (clarsimp simp:obj_at_def ipc_frame_wp_at_def) apply (drule_tac x = r in bspec,simp) apply (clarsimp simp:evalMonad_loadWord get_tcb_SomeD | rule conjI)+ apply (rule arg_cong[where f = word_rcat]) - apply clarsimp + apply clarsimp apply (clarsimp simp:|rule conjI) - apply (rule underlying_memory_storeWord) - apply simp_all + apply (rule underlying_memory_storeWord) + apply simp_all apply (rule aligned_add_aligned)+ - apply simp+ - apply (rule is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply simp+ + apply (rule is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (rule conjI) - apply (subst add.assoc[symmetric])+ - apply (rule underlying_memory_storeWord) + apply (subst add.assoc[symmetric])+ + apply (rule underlying_memory_storeWord) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (rule conjI) - apply (subst add.assoc[symmetric])+ - apply (rule underlying_memory_storeWord) + apply (subst add.assoc[symmetric])+ + apply (rule underlying_memory_storeWord) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (subst add.assoc[symmetric])+ apply (rule underlying_memory_storeWord[where n = 0,simplified]) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7] -done + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7] + done lemma get_ipc_buffer_words_separate_frame: "\valid_objs s; @@ -1429,64 +1429,64 @@ lemma get_ipc_buffer_words_separate_frame: apply (frule ipc_frame_ptr_at_frame_at[where buf = buf],simp+) apply (frule ipc_frame_ptr_at_frame_at[where buf = obuf],simp+) apply (frule valid_tcb_obj_ipc_align_etc[where buf = obuf],simp+) - apply (erule get_tcb_rev) + apply (erule get_tcb_rev) apply (subgoal_tac "\tcb. get_tcb s_id s = Some tcb") - prefer 2 - apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def) - apply (rule exI) - apply (erule get_tcb_rev) + prefer 2 + apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def) + apply (rule exI) + apply (erule get_tcb_rev) apply clarify apply (frule valid_tcb_obj_ipc_align_etc[where buf = buf],simp+) apply (rule arg_cong[where f = the]) apply (rule evalMonad_mapM) - defer - apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord) - apply (wp loadWord_inv) + defer + apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord) + apply (wp loadWord_inv)+ apply (clarsimp simp:obj_at_def ipc_frame_wp_at_def) apply (drule_tac x = r in bspec,simp) apply (clarsimp split:cap.split_asm arch_cap.split_asm) apply (clarsimp simp:evalMonad_loadWord get_tcb_SomeD | rule conjI)+ apply (rule arg_cong[where f = word_rcat]) - apply clarsimp + apply clarsimp apply (clarsimp simp:|rule conjI) - apply (rule underlying_memory_storeWord) - apply simp_all + apply (rule underlying_memory_storeWord) + apply simp_all apply (rule aligned_add_aligned)+ - apply simp+ - apply (rule is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply simp+ + apply (rule is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (rule conjI) - apply (subst add.assoc[symmetric])+ - apply (rule underlying_memory_storeWord) + apply (subst add.assoc[symmetric])+ + apply (rule underlying_memory_storeWord) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (rule conjI) - apply (subst add.assoc[symmetric])+ - apply (rule underlying_memory_storeWord) + apply (subst add.assoc[symmetric])+ + apply (rule underlying_memory_storeWord) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+ apply (subst add.assoc[symmetric])+ apply (rule underlying_memory_storeWord[where n = 0,simplified]) apply (simp_all) - apply (rule aligned_add_aligned)+ - apply simp+ - apply (subst is_aligned_after_mask) - apply simp+ - apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) - apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7] -done + apply (rule aligned_add_aligned)+ + apply simp+ + apply (subst is_aligned_after_mask) + apply simp+ + apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf]) + apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7] + done lemma mask_inj_if: "\a && mask n = a; b && mask n = b; a && mask n = b && mask n\\ a = b" @@ -1500,21 +1500,21 @@ lemma bound_preserve_mask: "\is_aligned (x::word32) n; x\ mask k; (z::word32)\ mask n; n < 32;k<32;n\ k\ \ x+z \ mask k" apply (rule less_less_trans[where b = "(mask k && ~~ mask n) + mask n"]) - apply (rule less_less_trans[where b = "x + mask n"]) - apply (erule word_plus_mono_right) - apply (rule is_aligned_no_wrap') - apply simp - apply (rule mask_lt_2pn) - apply (simp add:word_size) - apply (rule word_plus_mono_left) + apply (rule less_less_trans[where b = "x + mask n"]) + apply (erule word_plus_mono_right) + apply (rule is_aligned_no_wrap') + apply simp + apply (rule mask_lt_2pn) + apply (simp add:word_size) + apply (rule word_plus_mono_left) apply (rule less_less_trans[where b = "x && ~~ mask n"]) - apply (simp add:mask_out_sub_mask is_aligned_mask) + apply (simp add:mask_out_sub_mask is_aligned_mask) apply (erule neg_mask_mono_le) - apply (simp add:mask_out_sub_mask mask_and_mask min_def) - apply (rule word_leI) - apply (clarsimp simp:word_size) + apply (simp add:mask_out_sub_mask mask_and_mask min_def) + apply (rule word_leI) + apply (clarsimp simp:word_size) apply (simp add:mask_out_sub_mask mask_and_mask min_def) -done + done lemma nat_less_le: "(a::nat) < b \ a \ b - 1" @@ -1526,7 +1526,7 @@ lemma within_page_ipc_buf: \ within_page buf (buf + (bptr && mask (pageBitsForSize sz)) + of_nat x * of_nat word_size) sz" apply (clarsimp simp:ipc_buffer_wp_at_def obj_at_def) apply (frule valid_tcb_obj_ipc_align_etc,simp+) - apply (erule get_tcb_rev) + apply (erule get_tcb_rev) apply (clarsimp simp: ipc_frame_wp_at_def obj_at_def within_page_def) apply (clarsimp split: cap.split_asm arch_cap.split_asm) apply (frule valid_tcb_objs, erule get_tcb_rev) @@ -1534,18 +1534,18 @@ lemma within_page_ipc_buf: apply (subst add.assoc) apply (erule is_aligned_add_helper[THEN conjunct2]) apply (rule iffD1[OF le_mask_iff_lt_2n[where n = "pageBitsForSize sz"],THEN iffD1]) - apply (simp add:word_size) - apply (case_tac sz,simp_all) + apply (simp add:word_size) + apply (case_tac sz,simp_all) apply (rule bound_preserve_mask[where n = msg_align_bits]) - apply (rule is_aligned_after_mask) - apply (simp add:word_and_le1)+ - apply (simp add:msg_align_bits mask_2pm1) - apply (rule div_le_mult) - apply (simp add:word_size_def) - apply (rule word_of_nat_le) - apply (simp add:word_size_def msg_align_bits)+ - apply (cases sz,auto) -done + apply (rule is_aligned_after_mask) + apply (simp add:word_and_le1)+ + apply (simp add:msg_align_bits mask_2pm1) + apply (rule div_le_mult) + apply (simp add:word_size_def) + apply (rule word_of_nat_le) + apply (simp add:word_size_def msg_align_bits)+ + apply (cases sz,auto) + done lemma eq_sym_helper: "(A = B) \ (B = A)" by auto @@ -1838,7 +1838,7 @@ lemma zip_cpy_word_corres: apply (rule Cons.hyps) using Cons apply clarsimp - apply wp + apply wp+ apply (rule corres_symb_exec_r) apply (simp add: store_word_offs_def bind_assoc[symmetric] state_assert_def[symmetric]) @@ -1852,11 +1852,10 @@ lemma zip_cpy_word_corres: apply (rule_tac x=sz in exI) apply (frule (2) ipc_frame_ptr_at_frame_at) apply (simp add: obj_at_def a_type_simps) - apply wp + apply wp+ apply clarsimp+ apply (wp store_word_offs_ipc_frame_wp) - apply (fastforce simp:ipc_frame_wp_at_def)+ - done + by (fastforce simp:ipc_frame_wp_at_def)+ qed lemma zip_store_word_corres: @@ -1894,7 +1893,7 @@ lemma zip_store_word_corres: apply (rule_tac x=sz in exI) apply (frule (2) ipc_frame_ptr_at_frame_at) apply (simp add: obj_at_def a_type_simps) - apply (wp store_word_offs_ipc_frame_wp) + apply (wp store_word_offs_ipc_frame_wp)+ apply clarsimp+ done @@ -1998,7 +1997,7 @@ lemma set_mrs_corres: apply (clarsimp simp del:upt.simps) apply (rule within_page_ipc_buf) apply ((simp add:msg_align_bits msg_max_length_def)+)[7] - apply wp + apply wp+ apply (clarsimp, drule(1) valid_etcbs_get_tcb_get_etcb) apply (rule_tac s'=s' in set_cxt_none_det_intent_corres) apply (clarsimp dest!:get_tcb_SomeD get_etcb_SomeD)+ @@ -2055,7 +2054,7 @@ lemma copy_mrs_corres: apply (rule corres_free_return[where P="\" and P'="\"]) apply (rule dcorres_dummy_corrupt_frame) apply wp - apply (clarify,simp del:upt.simps ) + apply (clarify,simp del:upt.simps ) apply (rule corres_dummy_return_l) apply (rule corres_split[where r'="dc"]) apply (rule corres_free_return[where P="\" and P'="\"]) @@ -2069,7 +2068,7 @@ lemma copy_mrs_corres: apply (rule iffD2[OF Suc_le_mono]) apply (erule iffD1[OF word_le_nat_alt]) apply simp - apply wp + apply wp+ apply (rule set_registers_corres) apply ((clarsimp|wp)+)[1] apply (rule mapM_wp_inv) @@ -2079,7 +2078,7 @@ lemma copy_mrs_corres: apply (clarsimp|rule conjI)+ apply ((wp|clarsimp)+)[3] apply (case_tac rv) - apply (clarsimp simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+ + apply (fastforce simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+ done lemmas transform_cap_simps [simp] = transform_cap_def [split_simps cap.split arch_cap.split] @@ -2200,7 +2199,7 @@ lemma dcorres_store_word_conservative: pspace_aligned and valid_etcbs) (corrupt_frame obuf) (do_machine_op (storeWord ptr b))" apply (rule dcorres_expand_pfx,clarsimp) - apply (case_tac "\buf. (\thread. ipc_frame_ptr_at buf thread s') \ buf \ obuf") + apply (case_tac "\buf. (\thread. ipc_frame_ptr_at buf thread s') \ buf \ obuf") apply (rule corres_dummy_return_pl) apply (rule corres_dummy_return_r) apply (rule corres_underlying_split) diff --git a/proof/drefine/Interrupt_DR.thy b/proof/drefine/Interrupt_DR.thy old mode 100755 new mode 100644 index 8104ceaa6..37d58fd65 --- a/proof/drefine/Interrupt_DR.thy +++ b/proof/drefine/Interrupt_DR.thy @@ -76,25 +76,25 @@ lemma decode_irq_control_corres: apply (simp add: get_index_def transform_cap_list_def throw_on_none_def) apply (cases "excaps' = []", simp_all) apply (rule corres_alternative_throw_splitE) - apply (rule corres_alternate1) - apply (rule lookup_slot_for_cnode_op_corres) - apply simp+ - apply (clarsimp simp: split_def,simp) - apply (rule corres_throw_skip_r) - apply (rule corres_alternate1) - apply (rule corres_returnOk [where P=\ and P'=\]) - apply (simp add: cdl_irq_control_invocation_relation_def) - apply (subst ucast_mask_drop) - apply simp + apply (rule corres_alternate1) + apply (rule lookup_slot_for_cnode_op_corres) + apply simp+ + apply (clarsimp simp: split_def,simp) + apply (rule corres_throw_skip_r) + apply (rule corres_alternate1) + apply (rule corres_returnOk [where P=\ and P'=\]) + apply (simp add: cdl_irq_control_invocation_relation_def) + apply (subst ucast_mask_drop) + apply simp + apply simp + apply wp[1] apply simp - apply wp[1] - apply simp - apply wp[3] - apply simp - apply (rule hoare_pre, wp) - apply simp - apply wp - apply (cases excaps', auto)[1] + apply (wp+)[3] + apply simp + apply (rule hoare_pre, wp) + apply simp + apply wp + apply (cases excaps', auto)[1] apply wp[1] apply (clarsimp simp: arch_decode_irq_control_invocation_def transform_intent_def) apply (rule corres_guard_imp) @@ -208,13 +208,10 @@ lemma ackInterrupt_underlying_memory[wp]: lemma resetTimer_underlying_memory[wp]: "\\ms. underlying_memory ms = m\ resetTimer \\rv ms. underlying_memory ms = m\" apply (simp add:resetTimer_def machine_op_lift_def) - apply (simp add:machine_rest_lift_def ignore_failure_def) + apply (simp add:machine_rest_lift_def ignore_failure_def split_def) apply wp - apply (clarsimp simp:valid_def simpler_modify_def) - apply simp - apply (simp add:select_f_def | rule conjI)+ - apply (clarsimp simp:valid_def,simp)+ -done + apply (clarsimp simp:valid_def simpler_modify_def) + done lemma valid_state_get_cap_wp: "\valid_state\ CSpaceAcc_A.get_cap xa \\rv s. (is_ntfn_cap rv \ ntfn_at (obj_ref_of rv) s)\" @@ -281,6 +278,7 @@ lemma timer_tick_dcorres: "dcorres dc P P' (return ()) timer_tick" lemma handle_interrupt_corres: "dcorres dc \ (invs and valid_etcbs) (Interrupt_D.handle_interrupt x) (Interrupt_A.handle_interrupt x)" + including no_pre apply (clarsimp simp:Interrupt_A.handle_interrupt_def) apply (clarsimp simp:get_irq_state_def gets_def bind_assoc) apply (rule conjI; rule impI) @@ -365,11 +363,11 @@ lemma set_irq_state_dwp: set_irq_state irq_state.IRQSignal word \\r s. transform s = cs\" apply (simp add:set_irq_state_def) apply (wp do_machine_op_wp) - apply clarsimp - apply (wp maskInterrupt_underlying_memory) + apply clarsimp + apply (wp maskInterrupt_underlying_memory)+ apply (clarsimp simp:transform_def transform_objects_def transform_cdt_def transform_current_thread_def transform_asid_table_def) -done + done lemma dcorres_invoke_irq_control: "dcorres dc \ (invs and irq_control_inv_valid irq_control_invocation and valid_etcbs) @@ -462,18 +460,18 @@ lemma cte_wp_at_neq_slot_cap_delete_one: \\rv. cte_wp_at P slot\" apply (clarsimp simp:cap_delete_one_def unless_def) apply (wp hoare_when_wp) - apply (clarsimp simp:empty_slot_def) - apply (wp cte_wp_at_neq_slot_set_cap) - apply clarsimp - apply (wp dxo_wp_weak | simp)+ - apply (clarsimp simp:set_cdt_def) - apply (wp | clarsimp)+ - apply (rule_tac Q = "\r s. cte_wp_at P slot s \ cte_at slot' s" in hoare_strengthen_post) - apply (rule hoare_vcg_conj_lift) - apply wp_once - apply (wp get_cap_cte) - apply (clarsimp|wp)+ -done + apply (clarsimp simp:empty_slot_def) + apply (wp cte_wp_at_neq_slot_set_cap) + apply clarsimp + apply (wp dxo_wp_weak | simp)+ + apply (clarsimp simp:set_cdt_def) + apply (wp | clarsimp)+ + apply (rule_tac Q = "\r s. cte_wp_at P slot s \ cte_at slot' s" in hoare_strengthen_post) + apply (rule hoare_vcg_conj_lift) + apply wp_once + apply (wp get_cap_cte) + apply (clarsimp|wp)+ + done lemma cap_delete_one_not_idle [wp]: "\not_idle_thread t\ cap_delete_one slot \\_. not_idle_thread t\" diff --git a/proof/drefine/Ipc_DR.thy b/proof/drefine/Ipc_DR.thy index 52c89f15c..1c7b5ecd1 100644 --- a/proof/drefine/Ipc_DR.thy +++ b/proof/drefine/Ipc_DR.thy @@ -39,13 +39,7 @@ done lemma as_user_cur_thread_idle_thread: "\\s. P (cur_thread s) (idle_thread s)\ as_user thread x \\rv s. P (cur_thread s) (idle_thread s)\" - apply (clarsimp simp:as_user_def) - apply (wp set_object_cur_thread_idle_thread)+ - apply (fastforce simp:set_object_def valid_def get_def put_def return_def bind_def) - apply (simp add:select_f_def) - apply (simp add:valid_def) - apply (auto|wp)+ -done + by (wpsimp wp: set_object_cur_thread_idle_thread simp: as_user_def split_def) lemma do_fault_transfer_cur_thread_idle_thread: "\\s. P (cur_thread s) (idle_thread s)\ do_fault_transfer c a e recv_buffer \\rv s. P (cur_thread s) (idle_thread s)\" @@ -80,13 +74,13 @@ lemma handle_reply_cur_thread_idle_thread: apply (wp set_thread_state_cur_thread_idle_thread dxo_wp_weak |wpc|simp add: trans_state_def)+ apply ((wps|wp cap_delete_one_it)+)[1] - apply (wp do_ipc_transfer_cur_thread_idle_thread dxo_wp_weak) + apply (wp do_ipc_transfer_cur_thread_idle_thread dxo_wp_weak)+ apply (clarsimp simp: trans_state_def) apply (case_tac xf) apply (simp | wp set_thread_state_cur_thread_idle_thread thread_set_cur_thread_idle_thread)+ apply ((wps | wp)+)[1] - apply wp + apply wp+ apply ((wps | wp cap_delete_one_it)+)[1] apply (rule hoare_drop_imp | rule hoare_conjI | rule hoare_allI | wp)+ apply simp+ @@ -193,7 +187,8 @@ lemma mapM_functional: shows "functional (mapM f ns)" apply (rule functional_from_wp) apply (wp mapM_wp') - apply (rule fn [unfolded functional_def, THEN spec]) + apply (rule fn [unfolded functional_def, THEN spec]) + apply assumption done lemma evalMonad_mapM_functional: @@ -537,11 +532,11 @@ lemma corres_update_waiting_ntfn_do_notification_transfer: valid_ntfn (\ntfn_obj = case ys of [] \ Structures_A.ntfn.IdleNtfn | a # list \ Structures_A.ntfn.WaitingNtfn ys, ntfn_bound_tcb = bound_tcb\ )) (Endpoint_D.do_notification_transfer y) (update_waiting_ntfn epptr (y # ys) bound_tcb badge)" - apply (simp add: Endpoint_D.do_notification_transfer_def update_waiting_ntfn_def assert_def) - apply (rule corres_dummy_return_pl) - apply (rule corres_split_keep_pfx[where r'="dc" and Q="%x. \" and Q'="%x. \"]) - apply (rule corres_guard_imp,rule corres_dummy_set_notification,clarsimp+) - apply (rule dcorres_expand_pfx) + apply (simp add: Endpoint_D.do_notification_transfer_def update_waiting_ntfn_def assert_def) + apply (rule corres_dummy_return_pl) + apply (rule corres_split_keep_pfx[where r'="dc" and Q="%x. \" and Q'="%x. \"]) + apply (rule corres_guard_imp,rule corres_dummy_set_notification,clarsimp+) + apply (rule dcorres_expand_pfx) apply clarsimp apply (frule_tac y = y in generates_pending_not_idle) apply (clarsimp simp:st_tcb_at_def obj_at_def) @@ -551,14 +546,14 @@ lemma corres_update_waiting_ntfn_do_notification_transfer: apply (rule dcorres_dc_rhs_noop_below_2_True[OF allI[OF switch_if_required_to_dcorres]]) apply (rule corres_split[OF _ set_thread_state_corres]) apply (rule set_register_corres) - apply (wp hoare_TrueI) + apply (wp)+ apply simp apply (frule generates_pending_not_idle[where y = y]) apply (clarsimp simp: pred_tcb_at_def obj_at_def generates_pending_def) apply (drule_tac t = "tcb_state tcb" in sym) apply ((clarsimp simp:pred_tcb_at_def obj_at_def not_idle_thread_def split:Structures_A.thread_state.splits)+)[3] apply (wp set_ntfn_aligned set_ntfn_mdb set_ntfn_valid_objs sts_typ_ats) - apply (simp_all add:not_idle_thread_def)+ + apply (simp_all add:not_idle_thread_def)+ apply (clarsimp simp: pred_tcb_at_def obj_at_def) apply (drule valid_tcb_objs,erule get_tcb_rev) apply (drule_tac t = "tcb_state tcb" in sym) @@ -725,7 +720,7 @@ lemma dcorres_dat: apply (rule dcorres_dc_rhs_noop_below_2_True[OF allI[OF switch_if_required_to_dcorres]]) apply (rule corres_split[OF _ set_thread_state_corres]) apply (rule set_register_corres) - apply (wp hoare_TrueI) + apply (wp)+ apply simp apply (clarsimp simp: not_idle_thread_def valid_state_def) done @@ -733,24 +728,25 @@ lemma dcorres_dat: lemma not_idle_after_blocked_cancel_ipc: "\valid_idle and not_idle_thread obj_id' and valid_objs and st_tcb_at (op = state) obj_id'\ blocked_cancel_ipc state obj_id' \\y. valid_idle\" + including no_pre apply (simp add:blocked_cancel_ipc_def) - apply wp - apply (clarsimp simp:not_idle_thread_def) - apply (clarsimp simp:get_blocking_object_def) - apply (case_tac state) - apply clarsimp+ - apply (clarsimp simp:valid_def return_def st_tcb_at_def valid_objs_def obj_at_def) - apply (drule_tac x = obj_id' in bspec) + apply wp + apply (clarsimp simp:not_idle_thread_def) + apply (clarsimp simp:get_blocking_object_def) + apply (case_tac state) + apply clarsimp+ + apply (clarsimp simp:valid_def return_def st_tcb_at_def valid_objs_def obj_at_def) + apply (drule_tac x = obj_id' in bspec) apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+ - apply (drule_tac t = "tcb_state tcb" in sym) - apply (clarsimp simp:obj_at_def) - apply (clarsimp simp:valid_def return_def st_tcb_at_def obj_at_def valid_objs_def) + apply (drule_tac t = "tcb_state tcb" in sym) + apply (clarsimp simp:obj_at_def) + apply (clarsimp simp:valid_def return_def st_tcb_at_def obj_at_def valid_objs_def) apply (drule_tac x = obj_id' in bspec) - apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+ - apply (drule_tac t = "tcb_state tcb" in sym) - apply (clarsimp simp:obj_at_def) - apply (clarsimp)+ -done + apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+ + apply (drule_tac t = "tcb_state tcb" in sym) + apply (clarsimp simp:obj_at_def) + apply (clarsimp)+ + done lemma valid_idle_set_thread_state: "\not_idle_thread xa and valid_idle :: det_state \ bool\ set_thread_state xa Structures_A.thread_state.Restart \\xa. valid_idle\" @@ -772,57 +768,58 @@ lemma tcb_sched_action_tcb_at_not_idle[wp]: lemma valid_idle_cancel_all_ipc: "\valid_idle and valid_state :: det_state \ bool\ IpcCancel_A.cancel_all_ipc word1 \\a. valid_idle\" + including no_pre apply (simp add:cancel_all_ipc_def) apply (wp|wpc|simp)+ - apply (rename_tac queue list) - apply (rule_tac I = "(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp) - apply clarsimp - apply (wp KHeap_DR.tcb_at_set_thread_state_wp) - apply (rule hoare_conjI) - apply (rule_tac P="(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1" - in hoare_vcg_precond_imp) - apply (wp | clarsimp)+ - apply (rule set_thread_state_ko) - apply (simp add:is_tcb_def) - apply (wp valid_idle_set_thread_state) - apply (clarsimp simp:)+ + apply (rename_tac queue list) + apply (rule_tac I = "(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp) + apply clarsimp + apply (wp KHeap_DR.tcb_at_set_thread_state_wp) + apply (rule hoare_conjI) + apply (rule_tac P="(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1" + in hoare_vcg_precond_imp) + apply (wp | clarsimp)+ + apply (rule set_thread_state_ko) + apply (simp add:is_tcb_def) + apply (wp valid_idle_set_thread_state) + apply (clarsimp simp:)+ + apply wp + apply (rule hoare_vcg_conj_lift) + apply (rule hoare_Ball_helper) + apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+ + apply (rename_tac queue list) + apply (rule_tac I = "(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp) + apply clarsimp + apply (wp KHeap_DR.tcb_at_set_thread_state_wp) + apply (rule hoare_conjI) + apply (rule_tac P="(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1" + in hoare_vcg_precond_imp) + apply (rule set_thread_state_ko) + apply (simp add:is_tcb_def) + apply (wp valid_idle_set_thread_state) + apply (clarsimp simp:)+ apply wp apply (rule hoare_vcg_conj_lift) - apply (rule hoare_Ball_helper) + apply (rule hoare_Ball_helper) apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+ - apply (rename_tac queue list) - apply (rule_tac I = "(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp) - apply clarsimp - apply (wp KHeap_DR.tcb_at_set_thread_state_wp) - apply (rule hoare_conjI) - apply (rule_tac P="(\s. (queue = list) \ (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1" - in hoare_vcg_precond_imp) - apply (rule set_thread_state_ko) - apply (simp add:is_tcb_def) - apply (wp valid_idle_set_thread_state) - apply (clarsimp simp:)+ - apply wp - apply (rule hoare_vcg_conj_lift) - apply (rule hoare_Ball_helper) - apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+ - apply (rule hoare_strengthen_post[OF get_endpoint_sp]) - apply (clarsimp | rule conjI)+ - apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) - apply (drule(1) valid_objs_valid_ep_simp) - apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def) - apply (drule(1) pending_thread_in_send_not_idle) - apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+ - apply (clarsimp | rule conjI)+ - apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) - apply (drule(1) valid_objs_valid_ep_simp) - apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def) - apply (drule(1) pending_thread_in_recv_not_idle) - apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+ -done + apply (rule hoare_strengthen_post[OF get_endpoint_sp]) + apply (clarsimp | rule conjI)+ + apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) + apply (drule(1) valid_objs_valid_ep_simp) + apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def) + apply (drule(1) pending_thread_in_send_not_idle) + apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+ + apply (clarsimp | rule conjI)+ + apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) + apply (drule(1) valid_objs_valid_ep_simp) + apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def) + apply (drule(1) pending_thread_in_recv_not_idle) + apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+ + done lemma set_ntfn_obj_at: "\\s. P (kernel_object.Notification ep)\ set_notification ptr ep \\rv. obj_at P ptr\" @@ -835,61 +832,65 @@ done lemma valid_idle_cancel_all_signals: "\valid_idle and valid_state :: det_state \ bool\ IpcCancel_A.cancel_all_signals word1 \\a. valid_idle\" + including no_pre apply (simp add:cancel_all_signals_def) apply (wp|wpc|simp)+ - apply (rename_tac list) - apply (rule_tac I = "(\s. (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1 and valid_idle" in mapM_x_inv_wp) - apply clarsimp - apply (wp KHeap_DR.tcb_at_set_thread_state_wp) - apply (rule hoare_conjI) - apply (rule_tac P="(\s. (\a\ set list. tcb_at a s \ not_idle_thread a s)) - and valid_idle and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1" - in hoare_vcg_precond_imp) - apply (rule set_thread_state_ko) - apply (simp add:is_tcb_def) - apply (wp valid_idle_set_thread_state) - apply (clarsimp simp:)+ + apply (rename_tac list) + apply (rule_tac I = "(\s. (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1 and valid_idle" in mapM_x_inv_wp) + apply clarsimp + apply (wp KHeap_DR.tcb_at_set_thread_state_wp) + apply (rule hoare_conjI) + apply (rule_tac P="(\s. (\a\ set list. tcb_at a s \ not_idle_thread a s)) + and valid_idle and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1" + in hoare_vcg_precond_imp) + apply (rule set_thread_state_ko) + apply (simp add:is_tcb_def) + apply (wp valid_idle_set_thread_state)+ + apply (clarsimp simp:)+ apply (rule hoare_vcg_conj_lift) - apply (rule hoare_Ball_helper) + apply (rule hoare_Ball_helper) apply (wp set_ntfn_tcb| clarsimp simp : not_idle_thread_def)+ - apply (wp set_ntfn_obj_at) - apply (rule hoare_strengthen_post[OF get_ntfn_sp]) - apply (clarsimp | rule conjI)+ - apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) - apply (drule(1) valid_objs_valid_ntfn_simp) - apply (clarsimp simp:is_tcb_def valid_ntfn_def obj_at_def) - apply (drule(1) pending_thread_in_wait_not_idle) + apply (wp set_ntfn_obj_at)+ + apply (rule hoare_strengthen_post[OF get_ntfn_sp]) + apply (clarsimp | rule conjI)+ + apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def) + apply (drule(1) valid_objs_valid_ntfn_simp) + apply (clarsimp simp:is_tcb_def valid_ntfn_def obj_at_def) + apply (drule(1) pending_thread_in_wait_not_idle) apply (simp add:not_idle_thread_def obj_at_def is_ntfn_def)+ done lemma not_idle_after_reply_cancel_ipc: "\not_idle_thread obj_id' and invs :: det_state \ bool \ reply_cancel_ipc obj_id' \\y. valid_idle\" + including no_pre apply (simp add:reply_cancel_ipc_def) apply wp apply (simp add:cap_delete_one_def unless_def) - apply wp + apply wp+ apply (simp add:IpcCancel_A.empty_slot_def) apply (wp set_cap_idle)+ apply simp apply (rule hoare_strengthen_post[OF get_cap_idle]) apply simp apply (case_tac capa) - apply (simp_all add:fast_finalise.simps) + apply (simp_all add:fast_finalise.simps) apply (clarsimp simp:when_def | rule conjI)+ - apply (wp valid_idle_cancel_all_ipc valid_idle_cancel_all_signals | clarsimp simp: unbind_maybe_notification_def | wpc)+ + apply (wp valid_idle_cancel_all_ipc valid_idle_cancel_all_signals + | clarsimp simp: unbind_maybe_notification_def | wpc)+ apply (rule hoare_strengthen_post[where Q="\r. valid_state and valid_idle"]) apply (wp select_inv|simp)+ apply (rule hoare_strengthen_post[where Q="\r. valid_state and valid_idle"]) - apply wp + apply wp+ apply (rule hoare_strengthen_post) apply (rule hoare_vcg_precond_imp[OF thread_set_invs_trivial]) - apply (simp add:tcb_cap_cases_def invs_def valid_state_def)+ + apply (simp add:tcb_cap_cases_def invs_def valid_state_def)+ done lemma not_idle_thread_cancel_signal: - "\not_idle_thread obj_id' and valid_idle\ cancel_signal obj_id' word \\r. valid_idle\" + "\not_idle_thread obj_id' and valid_idle\ cancel_signal obj_id' word \\r. valid_idle\" + including no_pre apply (simp add:cancel_signal_def) apply (wp valid_idle_set_thread_state|wpc)+ apply (rule hoare_strengthen_post[OF get_ntfn_sp]) @@ -1044,7 +1045,7 @@ lemma corres_setup_caller_cap: apply (clarsimp simp:not_idle_thread_def set_thread_state_def) apply wp apply (simp add:set_object_def) - apply wp + apply wp+ apply simp apply (clarsimp simp:not_idle_thread_def tcb_at_def obj_at_def st_tcb_at_def) apply (rule conjI|clarsimp simp:is_tcb_def)+ @@ -1073,22 +1074,23 @@ lemma evalMonad_mapM: next case (Cons l ls) show ?case - using Cons.prems - apply clarsimp - apply (clarsimp simp:mapM_Cons) - apply (subst (asm) evalMonad_compose) - apply (simp add: Cons assms)+ - apply (clarsimp split:option.splits) - apply (subst (asm) evalMonad_compose) - apply (rule empty_when_fail_mapM) - apply (simp add: Cons assms)+ - apply (rule weak_det_spec_mapM) - apply (simp add: Cons assms)+ - apply (wp mapM_wp) - apply (simp add: Cons assms)+ - apply fastforce - apply (clarsimp split:option.splits) - apply (simp add: Cons) + using Cons.prems + apply clarsimp + apply (clarsimp simp:mapM_Cons) + apply (subst (asm) evalMonad_compose) + apply (simp add: Cons assms)+ + apply (clarsimp split:option.splits) + apply (subst (asm) evalMonad_compose) + apply (rule empty_when_fail_mapM) + apply (simp add: Cons assms)+ + apply (rule weak_det_spec_mapM) + apply (simp add: Cons assms)+ + apply (wp mapM_wp) + apply (simp add: Cons assms)+ + apply fastforce + apply simp + apply (clarsimp split:option.splits) + apply (simp add: Cons) done qed @@ -1097,14 +1099,15 @@ lemma evalMonad_get_extra_cptrs: (evalMonad (Ipc_A.get_extra_cptrs (Some buf) (data_to_message_info (arch_tcb_context_get (tcb_arch tcb) msg_info_register))) s) = Some a \ \ a = (map (to_bl) (cdl_intent_extras $ transform_full_intent (machine_state s) thread tcb))" + including no_pre apply (clarsimp simp:get_extra_cptrs_def) apply (clarsimp simp:liftM_def) apply (subst (asm) evalMonad_compose) - apply (rule empty_when_fail_mapM) - apply (simp add:weak_det_spec_load_word_offs empty_when_fail_load_word_offs) + apply (rule empty_when_fail_mapM) + apply (simp add:weak_det_spec_load_word_offs empty_when_fail_load_word_offs) apply (rule weak_det_spec_mapM) apply (simp add:weak_det_spec_load_word_offs) - apply (wp mapM_wp,fastforce) + apply (wp mapM_wp,fastforce) apply (clarsimp split:option.splits) apply (rule_tac x = x2 in arg_cong) apply (clarsimp simp:transform_full_intent_def Let_def) @@ -1112,14 +1115,14 @@ lemma evalMonad_get_extra_cptrs: apply (drule lookup_ipc_buffer_SomeB_evalMonad) apply (clarsimp simp:cte_wp_at_cases obj_at_def dest!: get_tcb_SomeD) apply (drule sym[where t = "tcb_ipcframe tcb"]) - apply clarsimp + apply clarsimp apply (simp add:mapM_load_word_offs_do_machine_op) apply (subst (asm) evalMonad_do_machine_op[symmetric]) apply (rule weak_det_spec_mapM[OF weak_det_spec_loadWord]) - apply (rule empty_when_fail_mapM) - apply (clarsimp simp:empty_when_fail_loadWord weak_det_spec_loadWord) + apply (rule empty_when_fail_mapM) + apply (clarsimp simp:empty_when_fail_loadWord weak_det_spec_loadWord) apply (clarsimp simp:get_tcb_message_info_def) -done + done lemma dcorres_symb_exec_r_evalMonad: assumes wp:"\sa. \op = sa\ f \\r. op = sa\" @@ -1291,7 +1294,7 @@ lemma ipc_buffer_wp_at_cap_insert[wp]: apply (rule_tac Q = "\r. ipc_buffer_wp_at buf t" in hoare_strengthen_post) apply wp apply (clarsimp simp:ipc_buffer_wp_at_def) - apply (wp get_cap_inv hoare_drop_imp) + apply (wp get_cap_inv hoare_drop_imp)+ apply simp done @@ -1304,7 +1307,7 @@ shows "\cte_wp_at (P and op \ cap.NullCap) slot :: det_state \(Types_D.is_ep_cap (transform_cap cap) \ @@ -1422,7 +1425,7 @@ next apply (rule hoare_pre) apply (rule cap_insert_weak_cte_wp_at_not_null) apply clarsimp+ - apply (wp cap_insert_idle valid_irq_node_typ hoare_vcg_ball_lift cap_insert_cte_wp_at) + apply (wp cap_insert_idle valid_irq_node_typ hoare_vcg_ball_lift cap_insert_cte_wp_at)+ apply (rule validE_validE_R) apply (wp whenE_throwError_wp)[1] apply wp @@ -1447,7 +1450,7 @@ next apply (rule hoare_vcg_conj_liftE_R) apply (rule derive_cap_is_derived) apply (rule derive_cap_is_derived_foo) - apply wp + apply wp+ apply (simp split del: if_split) apply (clarsimp split del: if_split cong: conj_cong) apply (rule conjI) @@ -1539,6 +1542,7 @@ lemma get_receive_slot_dcorres: and valid_global_refs and valid_irq_node and valid_idle and not_idle_thread t and valid_etcbs) (get_receive_slot t) (get_receive_slots t (buffer))" + including no_pre apply (case_tac buffer) apply (simp add:get_receive_slot_def empty_on_failure_def) apply (rule dcorres_expand_pfx) @@ -1585,8 +1589,8 @@ lemma get_receive_slot_dcorres: [Suc (Suc (msg_max_length + msg_max_extra_caps))..<5 + (msg_max_length + msg_max_extra_caps)] \ s = s'a" in corres_symb_exec_r) prefer 2 - apply (wp get_ipc_buffer_words) - apply (wp mapM_wp) + apply (wp get_ipc_buffer_words)+ + apply (wp mapM_wp)+ apply fastforce apply clarsimp apply (clarsimp,intro conjI,(simp add:obj_at_def)+) @@ -1678,7 +1682,7 @@ lemma transfer_caps_loop_None: apply (rule corres_guard_imp) apply (rule corres_split [where r'=dc], assumption) apply (rule dcorres_dummy_corrupt_ipc_buffer) - apply wp + apply wp+ apply simp apply simp done @@ -1714,7 +1718,7 @@ lemma transfer_caps_dcorres: apply simp apply simp apply (rule transfer_caps_loop_None) - apply wp + apply wp+ apply simp apply simp apply (simp del: get_receive_slots.simps) @@ -1966,30 +1970,26 @@ lemma ipc_buffer_wp_at_copy_mrs[wp]: \\r. ipc_buffer_wp_at buf t\" unfolding copy_mrs_def apply (wp|wpc)+ - apply (wp mapM_wp) - apply (simp add:store_word_offs_def ipc_buffer_wp_at_def) - apply wp - prefer 2 + apply (wp mapM_wp) + apply (simp add:store_word_offs_def ipc_buffer_wp_at_def) + apply wp+ + prefer 2 + apply fastforce + apply (clarsimp simp:ipc_buffer_wp_at_def) + apply (rule_tac Q="\rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post) + apply (wp mapM_wp) apply fastforce - apply (clarsimp simp:ipc_buffer_wp_at_def) - apply (rule_tac Q="\rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post) - apply (wp mapM_wp) - apply fastforce - apply (clarsimp) - apply wp + apply (clarsimp) + apply wp + apply assumption done lemma copy_mrs_valid_irq_node: "\valid_irq_node\ copy_mrs a b c d e \\rva s. valid_irq_node s\" apply (simp add:valid_irq_node_def) - apply (wp) - apply (rule hoare_allI) - apply (rule hoare_pre) - apply wps - apply wp - apply clarsimp -done + apply (wpsimp wp: hoare_vcg_all_lift|wps)+ + done lemma corres_complete_ipc_transfer: "ep' = ep @@ -2058,7 +2058,7 @@ lemma corres_complete_ipc_transfer: apply (rule hoare_vcg_conj_lift) apply (rule hoare_strengthen_post[OF get_extra_cptrs_length]) apply (simp add:msg_max_length_def max_ipc_words msg_max_extra_caps_def) - apply wp + apply wp+ apply fastforce apply clarsimp apply (intro conjI|clarsimp simp:obj_at_def dest!:get_tcb_SomeD)+ @@ -2085,9 +2085,9 @@ lemma corres_complete_ipc_transfer: unfolding K_bind_def apply (rule corrupt_tcb_intent_as_user_corres) apply (wp|clarsimp simp:not_idle_thread_def)+ - apply (wpc,wp) + apply wpsimp+ apply (rule hoare_pre) - apply (wpc,wp) + apply (wpc, wp+) apply clarsimp+ apply (rule hoare_allI[OF hoare_drop_imp]) apply (wp|clarsimp)+ @@ -2293,6 +2293,8 @@ lemma when_return: crunch valid_etcbs[wp]: handle_fault_reply valid_etcbs lemma do_reply_transfer_corres: + notes wp_post_taut [wp] + shows "slot' = transform_cslot_ptr slot \ dcorres dc \ (invs and tcb_at recver and tcb_at sender and cte_wp_at (op = (cap.ReplyCap recver False)) slot @@ -2300,6 +2302,7 @@ lemma do_reply_transfer_corres: and not_idle_thread recver and not_idle_thread sender and valid_etcbs) (Endpoint_D.do_reply_transfer sender recver slot') (Ipc_A.do_reply_transfer sender recver slot)" + including no_pre apply (clarsimp simp:do_reply_transfer_def Endpoint_D.do_reply_transfer_def) apply (clarsimp simp:get_thread_state_def thread_get_def get_thread_fault_def) apply (rule dcorres_absorb_gets_the) @@ -2326,9 +2329,9 @@ lemma do_reply_transfer_corres: apply (rule corres_symb_exec_r) apply (rule corres_split[OF _ dcorres_handle_fault_reply]) apply (rule corres_split[OF _ thread_set_fault_corres]) - apply (simp add:when_return split del:if_splits) - apply (simp add:dc_def[symmetric] if_distrib[where f = "set_thread_state recver"] - split del:if_splits) + apply (simp add: when_return split del: if_split) + apply (simp add: dc_def[symmetric] if_distrib[where f = "set_thread_state recver"] + split del: if_split) apply (rule corres_split_noop_rhs2) apply (rule corres_trivial) apply (clarsimp simp: when_def dc_def[symmetric]) @@ -2338,10 +2341,10 @@ lemma do_reply_transfer_corres: apply (rule set_thread_state_corres) apply (rule corres_alternate1) apply (rule set_thread_state_corres) - apply wp + apply wp+ apply simp apply clarsimp+ - apply (wp thread_set_no_change_tcb_state + apply (wp wp_post_taut thread_set_no_change_tcb_state hoare_drop_imps thread_set_cur_thread_idle_thread thread_set_valid_idle | simp add:not_idle_thread_def)+ @@ -2349,9 +2352,9 @@ lemma do_reply_transfer_corres: \ tcb_at recver s " in hoare_strengthen_post) apply (clarsimp simp:not_idle_thread_def) - apply (wp cap_delete_one_reply_st_tcb_at) + apply (wp cap_delete_one_reply_st_tcb_at)+ apply (clarsimp simp:not_idle_thread_def invs_valid_idle st_tcb_at_tcb_at) - apply (wp|clarsimp)+ + apply (wp |clarsimp)+ apply (rule conjI) apply (case_tac slot) apply (clarsimp simp:invs_def not_idle_thread_def valid_state_def) @@ -2360,27 +2363,26 @@ lemma do_reply_transfer_corres: apply (fastforce simp:valid_state_def cte_wp_at_caps_of_state) apply simp apply (rule emptyable_cte_wp_atD) - apply (simp add:is_master_reply_cap_def invs_def valid_state_def - valid_pspace_def valid_idle_def)+ -done + apply (simp add: is_master_reply_cap_def invs_def valid_state_def valid_pspace_def valid_idle_def)+ + done lemma set_endpoint_valid_irq_node[wp]: "\valid_irq_node and ep_at w\ set_endpoint w ep \\rv. valid_irq_node\" + including no_pre apply (clarsimp simp:valid_irq_node_def) apply wp - apply simp_all + apply simp_all apply (simp add:set_endpoint_def) - apply wp - apply (rule hoare_allI) - apply (rule_tac Q="\s. \irq. cap_table_at 0 (interrupt_irq_node s irq) s \ ep_at w s" in hoare_vcg_precond_imp) + apply (wp hoare_vcg_all_lift) + apply (rule_tac Q="\s. \irq. cap_table_at 0 (interrupt_irq_node s irq) s \ ep_at w s" in hoare_vcg_precond_imp) apply (clarsimp simp:set_object_def get_def put_def bind_def return_def valid_def obj_at_def) apply (drule_tac x = irq in spec) apply (clarsimp simp:is_cap_table_def is_ep_def) apply (simp split:Structures_A.kernel_object.splits) - apply assumption + apply assumption apply wp apply (clarsimp simp:get_object_def|wp)+ -done + done lemma dcorres_if_rhs: assumes G: "G \ corres_underlying sr nf nf' rvr P Q a b" @@ -2435,10 +2437,11 @@ lemma dcorres_receive_sync: set_endpoint word1 (Structures_A.endpoint.RecvEP (queue @ [thread])) od | False \ do_nbrecv_failed_transfer thread)" + including no_pre apply (clarsimp simp: receive_sync_def gets_def) apply (rule dcorres_absorb_get_l) apply (case_tac rv) -(* IdleEP *) + (* IdleEP *) apply clarsimp apply (frule_tac get_endpoint_pick) apply (simp add:obj_at_def) @@ -2482,9 +2485,9 @@ lemma dcorres_receive_sync: apply (erule get_tcb_rev) apply (fastforce simp: get_etcb_def) apply (frule_tac a = y and list = "y # ys" in pending_thread_in_send_not_idle) - apply ((simp add:valid_state_def insertI obj_at_def not_idle_thread_def )+)[4] - apply (clarsimp simp:assert_opt_def transform_tcb_def infer_tcb_pending_op_def tcb_slots - split del:if_splits) + apply ((simp add: valid_state_def insertI obj_at_def not_idle_thread_def )+)[4] + apply (clarsimp simp: assert_opt_def transform_tcb_def infer_tcb_pending_op_def tcb_slots + split del: if_split) apply (rule dcorres_symb_exec_r) apply (rule corres_symb_exec_r) apply (rule_tac F="sender_state = tcb_state t" in corres_gen_asm2) @@ -2506,7 +2509,7 @@ lemma dcorres_receive_sync: apply (rule dcorres_rhs_noop_below_True[OF switch_if_required_to_dcorres]) apply (rule set_thread_state_corres[unfolded tcb_slots]) apply clarsimp - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply clarsimp apply (wp gts_st_tcb_at | simp add:not_idle_thread_def )+ apply (rule_tac Q="\fault. valid_mdb and valid_objs and pspace_aligned @@ -2522,8 +2525,7 @@ lemma dcorres_receive_sync: apply (simp add:obj_at_def not_idle_thread_def)+ apply (rule hoare_pre) apply ((wp | clarsimp simp:not_idle_thread_def | wps )+)[1] - apply (clarsimp simp:valid_state_def st_tcb_at_def obj_at_def - valid_pspace_def) + apply (clarsimp simp:valid_state_def st_tcb_at_def obj_at_def valid_pspace_def) apply (drule valid_objs_valid_ep_simp) apply (simp add:is_ep_def) apply (clarsimp simp:valid_ep_def split:Structures_A.endpoint.splits list.splits) @@ -2786,6 +2788,7 @@ lemma tcb_fault_update_valid_state[wp]: "\valid_state and (\_. valid_fault ft')\ thread_set (tcb_fault_update (\_. Some ft')) thread \\rv. valid_state\" + including no_pre apply (clarsimp simp:valid_state_def pred_conj_def) apply (rule hoare_conjI) apply (simp add:valid_pspace_def) @@ -2795,7 +2798,7 @@ lemma tcb_fault_update_valid_state[wp]: apply (simp add:thread_set_def) apply wp apply (simp add:set_object_def) - apply (wp,clarsimp) + apply (wp+,clarsimp) apply (rule delta_sym_refs) apply (simp add:state_refs_of_def refs_of_def)+ apply (case_tac "x = thread") @@ -2823,7 +2826,7 @@ lemma tcb_fault_update_valid_state[wp]: apply (simp add:thread_set_def) apply wp apply (simp add:KHeap_A.set_object_def) - apply wp + apply wp+ apply (clarsimp simp:obj_at_def) apply (drule_tac x = irq in spec) apply (clarsimp simp:is_cap_table_def dest!: get_tcb_SomeD) @@ -2851,7 +2854,7 @@ lemma thread_set_fault_obj_at: apply (clarsimp simp:thread_set_def) apply wp apply (simp add:set_object_def) - apply wp + apply wp+ apply (clarsimp simp:obj_at_def) done @@ -2861,7 +2864,7 @@ lemma thread_set_fault_st_tcb_at: apply (clarsimp simp:thread_set_def) apply wp apply (simp add:set_object_def) - apply wp + apply wp+ apply (clarsimp simp:st_tcb_at_def obj_at_def dest!:get_tcb_SomeD split:if_splits) apply (simp add:get_tcb_def) done @@ -2914,6 +2917,7 @@ lemma send_fault_ipc_corres: valid_state and ko_at (TCB tcb) thread and (\s. ekheap s thread = Some etcb) and (\s. not_idle_thread (cur_thread s) s) and (\_. valid_fault ft') and valid_etcbs) (Endpoint_D.send_fault_ipc did) (Ipc_A.send_fault_ipc thread ft')" + including no_pre apply (simp add:Endpoint_D.send_fault_ipc_def Ipc_A.send_fault_ipc_def) apply (rule dcorres_expand_pfx) apply (rule corres_guard_imp) @@ -2953,11 +2957,11 @@ lemma send_fault_ipc_corres: apply (rule lookup_cap_corres) apply simp apply (simp add:tcb_fault_handler_length) - apply wp + apply wp+ apply (rule validE_validE_R) apply (rule hoare_validE_conj) prefer 2 - apply wp + apply wp+ apply (rule hoare_post_impErr[THEN validE_validE_R]) apply (rule hoare_vcg_precond_impE) apply (rule lookup_cap_valid[THEN validE_R_validE]) diff --git a/proof/drefine/KHeap_DR.thy b/proof/drefine/KHeap_DR.thy index 4d5d195a0..873d1e3ac 100644 --- a/proof/drefine/KHeap_DR.thy +++ b/proof/drefine/KHeap_DR.thy @@ -306,8 +306,7 @@ lemma caps_of_state_transform_opt_cap: slots_of_def opt_object_def transform_def transform_objects_def object_slots_def valid_irq_node_def obj_at_def is_cap_table_def - transform_tcb_def tcb_slot_defs tcb_slots - tcb_pending_op_slot_def tcb_cap_cases_def + transform_tcb_def tcb_slots tcb_cap_cases_def bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0 split: if_split_asm) done @@ -769,7 +768,7 @@ proof - update_slots_def split del: if_split) apply (case_tac "nat (bl_to_bin sl') = tcb_ipcbuffer_slot") - apply (simp add: tcb_slots tcb_pending_op_slot_def) + apply (simp add: tcb_slots) apply (clarsimp simp: bl_to_bin_tcb_cnode_index|rule conjI)+ apply (rule corres_guard_imp) apply (rule select_pick_corres) @@ -777,8 +776,7 @@ proof - apply (clarsimp simp: transform_tcb_def) apply (rule conjI) apply (rule ext) - apply (clarsimp simp: transform_tcb_def tcb_slots - tcb_pending_op_slot_def) + apply (clarsimp simp: transform_tcb_def tcb_slots) apply (rule refl) apply assumption apply simp @@ -790,7 +788,7 @@ proof - apply (clarsimp simp: transform_tcb_def) apply (rule conjI) apply (rule ext) - apply (clarsimp simp: transform_tcb_def tcb_pending_op_slot_def tcb_slots) + apply (clarsimp simp: transform_tcb_def tcb_slots) apply (erule transform_full_intent_same_cap) apply simp apply simp @@ -799,7 +797,7 @@ proof - apply (rule conjI) apply (clarsimp simp: bl_to_bin_tcb_cnode_index) apply (rule conjI ext dcorres_set_object_tcb|simp| - clarsimp simp: transform_tcb_def tcb_slot_defs tcb_slots corres_free_fail + clarsimp simp: transform_tcb_def tcb_slot_defs corres_free_fail cong: transform_full_intent_caps_cong_weak)+ done qed @@ -857,7 +855,7 @@ lemma set_thread_state_ext_dcorres: "dcorres dc P P' (return ()) (set_thread_sta apply (clarsimp simp: corres_underlying_def when_def set_scheduler_action_def modify_def bind_def put_def gets_def get_def return_def split: option.splits) - apply wp + apply wp+ done (*Special set_cap case which is related to thread_state *) @@ -890,7 +888,7 @@ lemma set_cap_null_cap_corres: apply (clarsimp simp:transform_cap_def) apply (rule refl) apply (rule set_original_dummy_corres) - apply wp + apply wp+ apply clarsimp apply (clarsimp simp: cte_wp_at_caps_of_state) done @@ -1333,7 +1331,7 @@ lemma set_irq_state_dcorres: transform_asid_table_def) apply simp apply (rule dmo_maskIRQ_dcorres) - apply wp + apply wp+ done lemma dcorres_gets_all_param: @@ -1385,7 +1383,7 @@ lemma empty_slot_corres: apply (clarsimp simp:transform_cap_def split:cap.splits arch_cap.splits) apply (rule get_cap_corres) apply simp - apply wp + apply wp+ apply clarsimp apply (simp add: not_idle_thread_def)+ done @@ -1393,7 +1391,7 @@ lemma empty_slot_corres: lemma valid_idle_fast_finalise[wp]: "\invs\ IpcCancel_A.fast_finalise p q \%r. valid_idle\" apply (case_tac p) - apply (simp_all add:fast_finalise.simps) + apply simp_all apply (wp,simp add:valid_state_def invs_def) apply (rule hoare_post_imp[where Q="%r. invs"]) apply (clarsimp simp:valid_state_def invs_def,wp cancel_all_ipc_invs) @@ -2046,10 +2044,10 @@ lemma tcb_at_set_thread_state_wp: set_thread_state a Structures_A.thread_state.Restart \\x s. (\x\set list. tcb_at x s \ not_idle_thread x s)\" apply (rule hoare_Ball_helper) - apply wp - apply (simp add:not_idle_thread_def) - apply wp -done + including no_pre apply wp + apply (simp add:not_idle_thread_def) + apply wp+ + done lemma invalid_cte_wp_at_pending_slot: "\tcb_at y s;transform_cslot_ptr (ad, bd) = (y, tcb_pending_op_slot); @@ -2556,7 +2554,7 @@ lemma dcorres_do_unbind_notification: apply (clarsimp simp: tcb_slots) apply (rule set_bound_notification_corres[where ntfn_opt=None, unfolded infer_tcb_bound_notification_def not_idle_thread_def tcb_slots, simplified]) - apply wp + apply wp+ apply simp apply (clarsimp simp: not_idle_thread_def) done @@ -2580,7 +2578,7 @@ lemma dcorres_unbind_maybe_notification: apply (rule_tac P'="R' (the (ntfn_bound_tcb ntfna)) ntfna" for R' in corres_inst) apply simp apply (rule dcorres_do_unbind_notification[unfolded dc_def, simplified]) - apply (wp get_ntfn_wp) + apply (wp get_ntfn_wp)+ apply (clarsimp split: option.splits) apply (clarsimp simp: valid_state_def valid_pspace_def split: option.splits) apply (simp add: obj_at_def) @@ -2588,13 +2586,10 @@ lemma dcorres_unbind_maybe_notification: apply (clarsimp simp: valid_idle_def pred_tcb_at_def not_idle_thread_def obj_at_def) done -(* -definition - "unbind_maybe_notification' ntfn \ do ntfn_obj \ get_notification ntfn; unbind_maybe_notification ntfn_obj od" -*) lemma unbind_notification_valid_state[wp]: "\valid_state\ IpcCancel_A.unbind_notification t \\rv. valid_state\" + including no_pre apply (simp add: unbind_notification_def valid_state_def valid_pspace_def) apply (rule hoare_seq_ext [OF _ gbn_sp]) apply (case_tac ntfnptr, clarsimp, wp, simp) @@ -2626,6 +2621,7 @@ lemma unbind_notification_valid_state[wp]: lemma unbind_maybe_notification_valid_state[wp]: "\valid_state\ IpcCancel_A.unbind_maybe_notification a \\rv. valid_state\" + including no_pre apply (simp add: unbind_maybe_notification_def valid_state_def valid_pspace_def) apply (rule hoare_seq_ext [OF _ get_ntfn_sp]) apply (case_tac "ntfn_bound_tcb ntfn", clarsimp, wp, simp+) @@ -2681,7 +2677,7 @@ lemma fast_finalise_corres: (IpcCancel_A.fast_finalise rv' final)" apply (case_tac rv') apply (simp_all add:transform_cap_def) - apply (simp_all add:PageTableUnmap_D.fast_finalise_def fast_finalise.simps PageTableUnmap_D.fast_finalise.simps corres_free_fail) + apply (simp_all add:PageTableUnmap_D.fast_finalise_def corres_free_fail) apply (simp_all add:when_def) apply (clarsimp simp:dcorres_cancel_all_ipc) apply clarsimp @@ -2753,6 +2749,7 @@ lemma get_tcb_reply_cap_wp_cte_at: apply (frule cte_wp_tcb_cap_valid) apply simp+ apply (clarsimp simp :cte_wp_at_def tcb_cap_valid_def st_tcb_at_def obj_at_def is_master_reply_cap_def split:cap.splits) + including no_pre apply (wp get_cap_cte_wp_at_rv) apply (rule tcb_cap_wp_at) apply (simp add:dom_tcb_cap_cases)+ @@ -2914,7 +2911,7 @@ lemma always_empty_slot_corres: apply (rule dcorres_rhs_noop_above[OF empty_slot_ext_dcorres]) apply (rule corres_bind_ignore_ret_rhs) apply (rule set_cap_null_cap_corres) - apply wp + apply wp+ apply simp apply (rule remove_parent_corres) apply (wp get_cap_wp|simp add: set_cdt_def)+ @@ -3363,14 +3360,14 @@ lemma dcorres_injection_handler_rhs: apply (clarsimp simp:injection_handler_def) apply (clarsimp simp:handleE'_def) apply (rule corres_dummy_return_l) - apply (rule corres_guard_imp) - apply (rule corres_underlying_split[where P'="\a. \" and P = "\a. \"]) - apply assumption - apply wp - apply (clarsimp simp:return_def) - apply (case_tac v) - apply (clarsimp simp:throwError_def return_def corres_underlying_def)+ -done + apply (rule corres_guard_imp) + apply (rule corres_underlying_split[where P'="\a. \" and P = "\a. \"]) + apply assumption + apply wp+ + apply (clarsimp simp:return_def) + apply (case_tac v) + apply (clarsimp simp:throwError_def return_def corres_underlying_def)+ + done crunch valid_etcbs[wp]: resolve_address_bits "valid_etcbs" @@ -3458,11 +3455,7 @@ lemma dcorres_lookup_slot: apply (rule corres_returnOk [where P=\ and P'=\]) apply clarsimp apply (clarsimp simp: word_bits_def) - apply assumption - apply simp - apply wp - apply simp - apply clarsimp + apply wpsimp+ apply (erule (1) objs_valid_tcb_ctable) done diff --git a/proof/drefine/Refine_D.thy b/proof/drefine/Refine_D.thy index c739968a0..45ee580cb 100644 --- a/proof/drefine/Refine_D.thy +++ b/proof/drefine/Refine_D.thy @@ -28,7 +28,7 @@ lemma handle_event_invs_and_valid_sched: "\invs and valid_sched and (\s. e \ Interrupt \ ct_active s) and (\s. scheduler_action s = resume_cur_thread)\ Syscall_A.handle_event e \\rv. invs and valid_sched\" - by (wp he_invs handle_event_valid_sched, simp) + including no_pre by ((wp he_invs handle_event_valid_sched), simp) lemma dcorres_call_kernel: "dcorres dc \ diff --git a/proof/drefine/Schedule_DR.thy b/proof/drefine/Schedule_DR.thy index 2113e996c..35b7b309b 100644 --- a/proof/drefine/Schedule_DR.thy +++ b/proof/drefine/Schedule_DR.thy @@ -81,16 +81,17 @@ lemma change_current_domain_and_switch_to_idle_thread_dcorres: Schedule_D.switch_to_thread None od) switch_to_idle_thread" + including no_pre apply (clarsimp simp: Schedule_D.switch_to_thread_def switch_to_idle_thread_def) apply (rule dcorres_symb_exec_r) apply (rule corres_guard_imp) apply (rule corres_symb_exec_l) - apply (rule corres_split_noop_rhs) + apply (rule_tac R=\ in corres_split_noop_rhs) apply (clarsimp simp: corres_underlying_def gets_def modify_def get_def put_def do_machine_op_def select_f_def split_def bind_def in_return) apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def) apply assumption apply (rule dcorres_arch_switch_to_idle_thread_return) - apply (wp change_current_domain_same| simp)+ + apply (wp change_current_domain_same | simp)+ done lemma arch_switch_to_thread_dcorres: @@ -116,22 +117,21 @@ crunch idle_thread [wp]: arch_switch_to_thread "\s. P (idle_thread s)" lemma switch_to_thread_corres: "dcorres dc \ (invs and (\s. idle_thread s \ x) and valid_etcbs) (Schedule_D.switch_to_thread (Some x)) (Schedule_A.switch_to_thread x)" - apply (clarsimp simp: Schedule_D.switch_to_thread_def - Schedule_A.switch_to_thread_def) + apply (clarsimp simp: Schedule_D.switch_to_thread_def Schedule_A.switch_to_thread_def) apply (rule corres_dummy_return_pl) apply (rule corres_symb_exec_r) - apply (rule corres_symb_exec_r) - apply (rule corres_guard_imp) - apply (rule corres_split [OF _ arch_switch_to_thread_dcorres]) - apply simp - apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres]) + apply (rule corres_symb_exec_r) + apply (rule corres_guard_imp) + apply (rule corres_split [OF _ arch_switch_to_thread_dcorres]) + apply simp + apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres]) apply (rule corres_modify [where P=\ and P'="\s. idle_thread s \ x"]) apply (clarsimp simp: transform_def) apply (simp add: transform_current_thread_def transform_asid_table_def) - apply wp[4] - apply simp - apply assumption - apply (clarsimp|wp)+ + apply (wp+)[4] + apply simp + apply assumption + apply (clarsimp|wp)+ done lemma corrupt_intents_current_thread: @@ -174,7 +174,7 @@ lemma switch_to_thread_same_corres: apply (rule corres_modify [where P'="\s. idle_thread s \ x"]) apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def) apply (simp add: transform_current_thread_def transform_asid_table_def) - apply wp[4] + apply (wp+)[4] apply simp apply assumption apply (clarsimp|wp)+ @@ -455,7 +455,7 @@ lemma schedule_choose_new_thread_dcorres_fragment: apply (simp only: schedule_def_2) apply (rule corres_guard_imp) apply (rule_tac r'="\_ _. True" and P=\ and P'=\ and R="\_. \" and R'="\_ s. valid_etcbs s \ valid_sched_except_blocked s \ invs s \ scheduler_action s = choose_new_thread" in corres_split) - apply (clarsimp simp: K_bind_def) + apply (clarsimp) apply (rule dcorres_symb_exec_r) apply (rule dcorres_symb_exec_r, rename_tac rq) apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres]) @@ -658,7 +658,7 @@ lemma activate_thread_corres: apply (rule dcorres_symb_exec_r) apply (rule set_thread_state_corres[unfolded tcb_pending_op_slot_def]) apply simp - apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified]) + apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified])+ apply (simp add:invs_mdb pred_tcb_at_def obj_at_def invs_valid_idle generates_pending_def not_idle_thread_def) apply (clarsimp simp:infer_tcb_pending_op_def arch_activate_idle_thread_def diff --git a/proof/drefine/Syscall_DR.thy b/proof/drefine/Syscall_DR.thy index 9a247c721..06796d6d1 100644 --- a/proof/drefine/Syscall_DR.thy +++ b/proof/drefine/Syscall_DR.thy @@ -352,18 +352,19 @@ lemma transform_type_eq_None: lemma transform_intent_untyped_cap_None: "\transform_intent (invocation_type label) args = None; cap = cap.UntypedCap dev w n idx\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp:Decode_A.decode_invocation_def) apply wp apply (case_tac "invocation_type label") (* 43 subgoals *) apply (clarsimp simp:Decode_A.decode_untyped_invocation_def unlessE_def) - apply wp + apply wp+ apply (clarsimp simp:transform_intent_def Decode_A.decode_untyped_invocation_def unlessE_def split del:if_split) apply (clarsimp simp:transform_intent_untyped_retype_def split del:if_split) apply (case_tac "args") apply (clarsimp,wp)[1] apply (clarsimp split:list.split_asm split del:if_split) - apply wp[5] + apply (wp+)[5] apply (clarsimp simp: transform_type_eq_None split del:if_split split:option.splits) apply (wp|clarsimp simp:whenE_def|rule conjI)+ apply (clarsimp simp: Decode_A.decode_untyped_invocation_def unlessE_def split del:if_split,wp)+ @@ -372,12 +373,13 @@ lemma transform_intent_untyped_cap_None: lemma transform_intent_cnode_cap_None: "\transform_intent (invocation_type label) args = None; cap = cap.CNodeCap w n list\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp:Decode_A.decode_invocation_def) - apply wp + apply wp+ apply (case_tac "invocation_type label") - apply (simp add:Decode_A.decode_cnode_invocation_def unlessE_def upto_enum_def fromEnum_def toEnum_def enum_invocation_label,wp)+ + apply (simp add:Decode_A.decode_cnode_invocation_def unlessE_def upto_enum_def fromEnum_def toEnum_def enum_invocation_label,wp+)+ apply (simp add:transform_intent_def transform_cnode_index_and_depth_def whenE_def split:list.split_asm) - apply wp + apply wp+ apply (simp add:transform_intent_def transform_cnode_index_and_depth_def Decode_A.decode_cnode_invocation_def unlessE_def whenE_def split del:if_splits split:list.split_asm) apply (wp|clarsimp|rule conjI)+ @@ -408,34 +410,36 @@ done lemma transform_intent_thread_cap_None: "\transform_intent (invocation_type label) args = None; cap = cap.ThreadCap w\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp:Decode_A.decode_invocation_def) - apply wp + apply wp+ apply (simp add:Decode_A.decode_tcb_invocation_def) apply (case_tac "invocation_type label") apply simp_all - apply wp + apply wp+ apply (clarsimp simp: transform_intent_def decode_read_registers_def decode_write_registers_def decode_copy_registers_def decode_tcb_configure_def decode_set_priority_def decode_set_mcpriority_def decode_set_ipc_buffer_def transform_intent_tcb_defs split: list.split_asm - | wp)+ + | wp+)+ apply (clarsimp simp: transform_intent_def decode_set_space_def decode_bind_notification_def decode_unbind_notification_def transform_intent_tcb_set_space_def split: list.split_asm - , wp + , wp+ | clarsimp simp: transform_intent_def)+ done lemma transform_intent_irq_control_None: "\transform_intent (invocation_type label) args = None; cap = cap.IRQControlCap\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp:Decode_A.decode_invocation_def) apply wp apply (clarsimp simp:decode_irq_control_invocation_def arch_decode_irq_control_invocation_def split del:if_splits) apply (case_tac "invocation_type label") - apply (clarsimp,wp)+ - apply (clarsimp simp:transform_intent_issue_irq_handler_def transform_intent_def split:list.split_asm split del:if_splits,wp) - apply (clarsimp simp:arch_decode_irq_control_invocation_def,wp)+ + apply (clarsimp, wp)+ + apply (clarsimp simp:transform_intent_issue_irq_handler_def transform_intent_def split:list.split_asm split del:if_splits,wp+) + apply (clarsimp simp:arch_decode_irq_control_invocation_def, wp)+ done lemma transform_intent_irq_handler_None: @@ -458,6 +462,7 @@ done lemma transform_intent_domain_cap_None: "\transform_intent (invocation_type label) args = None; cap = cap.DomainCap\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap.DomainCap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp: Decode_A.decode_invocation_def) apply wp apply (case_tac excaps, simp_all) @@ -468,55 +473,49 @@ lemma transform_intent_domain_cap_None: apply (case_tac args, simp_all) apply ((wp whenE_inv | simp)+)[1] apply (case_tac "invocation_type label \ DomainSetSet", simp_all) - apply wp[1] + apply wp apply (clarsimp simp: transform_intent_def transform_intent_domain_def) done lemma transform_intent_arch_cap_None: "\transform_intent (invocation_type label) args = None; cap = cap.ArchObjectCap arch_cap\ \ \op = s\ Decode_A.decode_invocation label args cap_i slot cap excaps \\r. \\, \\x. op = s\" + including no_pre apply (clarsimp simp:Decode_A.decode_invocation_def) - apply wp + apply wp + apply (simp add: arch_decode_invocation_def split del: if_split) apply (case_tac arch_cap) - apply (case_labels "invocation_type label") - apply (simp_all add:arch_decode_invocation_def split del:if_splits) - apply wp - apply (clarsimp split:if_splits | rule conjI)+ - apply (case_tac "excaps ! 0") - apply (clarsimp split:cap.splits | rule conjI | wp)+ - apply (clarsimp split:arch_cap.splits | rule conjI | wp)+ - apply ((clarsimp simp:transform_intent_def | wp) +)[2] - apply (case_labels "invocation_type label") - apply (simp_all add:arch_decode_invocation_def split del:if_splits) - apply wp - apply (case_tac "excaps ! 0") - apply (clarsimp simp:transform_intent_def transform_cnode_index_and_depth_def split:list.split_asm) - apply wp - apply (case_labels "invocation_type label") - apply (simp_all add:arch_decode_invocation_def isPageFlushLabel_def split del:if_splits) - apply (wp) - apply (clarsimp simp:transform_intent_def transform_intent_page_map_def split:list.split_asm ) - apply wp - apply (clarsimp | rule conjI)+ - apply (case_tac "excaps ! 0") - apply (clarsimp simp:transform_intent_def - transform_intent_page_remap_def split:list.split_asm) - apply ((clarsimp simp:transform_intent_def | wp)+) - apply (case_labels "invocation_type label") - apply (simp_all) + apply (case_labels "invocation_type label"; simp split del: if_split, wp?) + apply (clarsimp split:if_splits | rule conjI)+ + apply (case_tac "excaps ! 0") + apply (clarsimp split:cap.splits | rule conjI | wp)+ + apply (clarsimp split:arch_cap.splits | rule conjI | wp)+ + apply ((clarsimp simp:transform_intent_def | wp) +)[2] + apply (case_labels "invocation_type label"; + simp add:arch_decode_invocation_def split del: if_split; wp?) + apply (case_tac "excaps ! 0") + apply (clarsimp simp:transform_intent_def transform_cnode_index_and_depth_def split:list.split_asm) + apply wp+ + apply (case_labels "invocation_type label"; + simp add: arch_decode_invocation_def isPageFlushLabel_def + split del: if_split, wp?) + apply (clarsimp simp: transform_intent_def transform_intent_page_map_def + split: list.split_asm ) + apply wp+ + apply (clarsimp | rule conjI)+ + apply (case_tac "excaps ! 0") + apply (clarsimp simp:transform_intent_def transform_intent_page_remap_def split:list.split_asm) + apply ((clarsimp simp:transform_intent_def | wp)+) + apply (case_labels "invocation_type label"; simp) + apply (intro conjI impI | wp)+ + apply (clarsimp | rule conjI)+ + apply (clarsimp simp: transform_intent_def transform_intent_page_table_map_def + split: list.split_asm) apply (intro conjI impI | wp)+ - apply (clarsimp | rule conjI)+ - apply (clarsimp simp:transform_intent_def transform_intent_page_table_map_def - split:list.split_asm) - apply (intro conjI impI | wp)+ - - apply ((clarsimp simp:transform_intent_def - split:list.split_asm - | wp)+)[1] - apply (case_labels "invocation_type label") - apply (simp_all add: isPDFlushLabel_def) - apply (wp) -done + apply ((clarsimp simp: transform_intent_def split: list.split_asm | wp)+)[1] + apply (case_labels "invocation_type label"; simp add: isPDFlushLabel_def) + apply (wp)+ + done lemma decode_invocation_error_branch: "\transform_intent (invocation_type label) args = None; \ ep_related_cap (transform_cap cap)\ @@ -529,11 +528,11 @@ lemma decode_invocation_error_branch: apply (rule transform_intent_cnode_cap_None,fastforce+) apply (rule transform_intent_thread_cap_None,fastforce+) apply (rule transform_intent_domain_cap_None,fastforce+) - apply (rule transform_intent_irq_control_None,fastforce+) - apply (rule transform_intent_irq_handler_None,fastforce+) - apply (rule transform_intent_zombie_cap_None,fastforce+) + apply (rule transform_intent_irq_control_None,fastforce+) + apply (rule transform_intent_irq_handler_None,fastforce+) + apply (rule transform_intent_zombie_cap_None,fastforce+) apply (rule transform_intent_arch_cap_None,fastforce+) -done + done lemma decode_invocation_ep_related_branch: "\ep_related_cap (transform_cap cap);\ is_master_reply_cap cap\ @@ -669,7 +668,7 @@ lemma invoke_domain_corres: apply clarsimp apply (drule get_tcb_at) apply (clarsimp simp:opt_object_tcb) - apply wp + apply wp+ apply simp apply wp apply simp @@ -1009,9 +1008,6 @@ lemma lookup_cap_and_slot_inv: "\P\ CSpace_A.lookup_cap_and_slot t (to_bl (arch_tcb_context_get (tcb_arch obj'a) cap_register)) \\x. P\, \\ft s. True\" apply (simp add:CSpace_A.lookup_cap_and_slot_def) apply (wp | clarsimp simp:liftE_bindE)+ - apply (simp add:validE_def) - apply (rule hoare_drop_imp) - apply (wp lookup_slot_for_thread_inv) done (* We need following lemma because we need to match get_mrs in abstract and cdl_intent_op in capdl after state s is fixed *) @@ -1081,7 +1077,7 @@ lemma reply_from_kernel_error: apply (simp add:word_bits_def mask_def le_mask_iff[symmetric])+ apply unat_arith apply simp - apply (wp hoare_drop_imp hoare_vcg_all_lift) + apply (wp hoare_drop_imp hoare_vcg_all_lift)+ apply clarsimp apply (rule conjI) apply (rule word_of_nat_le) @@ -1133,29 +1129,29 @@ lemma dcorres_reply_from_syscall: transform_tcb_def assert_opt_def when_def returnOk_liftE[symmetric] split: Structures_A.thread_state.splits) apply (intro conjI impI) - apply (rule dcorres_returnOk',simp)+ + apply (rule dcorres_returnOk',simp)+ apply (rule corres_guard_imp) apply (rule corres_split[OF _ dcorres_reply_from_kernel]) apply (rule corres_dummy_return_pr) apply (rule corres_split[OF _ dcorres_set_intent_error]) apply (simp add:liftE_bindE returnOk_liftE) apply (rule set_thread_state_corres[unfolded tcb_slots]) - apply (wp rfk_invs reply_from_kernel_error) + apply (wp rfk_invs reply_from_kernel_error)+ apply (simp add:not_idle_thread_def) apply (wp rfk_invs) apply simp - apply (clarsimp simp:tcb_at_def st_tcb_at_def obj_at_def - not_idle_thread_def dest!:get_tcb_SomeD) + apply (clarsimp simp: tcb_at_def st_tcb_at_def obj_at_def not_idle_thread_def + dest!: get_tcb_SomeD) apply (rule corres_dummy_return_pr) apply (rule corres_guard_imp[OF corres_split[where r' = "dc"]]) - apply (simp add:K_bind_def returnOk_liftE) + apply (simp add: returnOk_liftE) apply (rule set_thread_state_corres[unfolded tcb_slots]) apply (rule dcorres_dummy_corrupt_ipc_buffer) - apply wp - apply simp - apply (clarsimp simp:tcb_at_def invs_mdb st_tcb_at_def - not_idle_thread_def obj_at_def dest!:get_tcb_SomeD) - apply (rule dcorres_returnOk',simp)+ + apply wp+ + apply simp + apply (clarsimp simp: tcb_at_def invs_mdb st_tcb_at_def not_idle_thread_def obj_at_def + dest!: get_tcb_SomeD) + apply (rule dcorres_returnOk', simp)+ done lemmas mapM_x_def_symmetric = mapM_x_def[symmetric] @@ -1189,15 +1185,16 @@ lemma without_preemption_idle: lemma invoke_cnode_idle: "\\s. P (idle_thread s)\ invoke_cnode pa \\r s. P (idle_thread (s :: det_ext state))\" - apply (case_tac pa) - apply (clarsimp simp:invoke_cnode_def|wp)+ - apply (rule cap_revoke_preservation) - apply (wp cap_move_idle_thread|clarsimp simp:invoke_cnode_def)+ + including no_pre + apply (cases pa) + apply (clarsimp simp:invoke_cnode_def|wp)+ + apply (rule cap_revoke_preservation) + apply (wp cap_move_idle_thread|clarsimp simp:invoke_cnode_def)+ apply (intro conjI) - apply (clarsimp simp:invoke_cnode_def|wp)+ - apply (wpc|wp)+ - apply (rule_tac Q="\x s. P (idle_thread s)" in hoare_strengthen_post) - apply wp + apply (clarsimp simp:invoke_cnode_def|wp)+ + apply (wpc|wp)+ + apply (rule_tac Q="\x s. P (idle_thread s)" in hoare_strengthen_post) + apply wp+ apply clarsimp+ apply (clarsimp simp:invoke_cnode_def) apply (wp | wpc | simp | rule hoare_pre)+ @@ -1212,6 +1209,7 @@ lemma invoke_domain_idle: lemma perform_invocation_idle[wp]: "\not_idle_thread x :: det_ext state \ bool\ Syscall_A.perform_invocation blocking call i \\rv. not_idle_thread x\" + including no_pre apply (case_tac i) apply (simp_all add:not_idle_thread_def) apply (wp invoke_cnode_idle invoke_domain_idle |clarsimp)+ @@ -1221,8 +1219,8 @@ lemma perform_invocation_idle[wp]: apply (simp add: arch_invoke_irq_control_def) apply (rename_tac irq_handler_invocation) apply (case_tac irq_handler_invocation) - apply simp_all - apply (wp|simp)+ + apply simp_all + apply (wp|simp)+ done lemma msg_from_syscall_error_simp: @@ -1237,9 +1235,8 @@ lemma msg_from_syscall_error_simp: lemma not_master_reply_cap_lcs[wp]: "\valid_reply_masters and valid_objs\CSpace_A.lookup_cap_and_slot t ptr \\rv s. \ is_master_reply_cap (fst rv)\,-" - apply (rule hoare_pre) - apply (simp add:lookup_cap_and_slot_def) - apply wp + apply (simp add:lookup_cap_and_slot_def) + apply wp apply (simp add:split_def) apply wp apply (rule_tac Q ="\cap. cte_wp_at (\x. x = cap) (fst x) and real_cte_at (fst x) @@ -1329,11 +1326,11 @@ lemma handle_invocation_corres: apply (clarsimp simp:transform_cap_list_def dcorres_symb_exec_r_evalMonad Ipc_A.lookup_extra_caps_def liftE_bindE) apply (rule corres_guard_imp) apply (rule corres_splitEE[OF _ dcorres_lookup_extra_caps]) - apply (rule dcorres_returnOk) - apply simp - apply (wp|clarsimp simp:not_idle_thread_def)+ + apply (rule dcorres_returnOk) + apply simp + apply (wp|clarsimp simp:not_idle_thread_def)+ apply (simp add:empty_when_fail_lookup_ipc_buffer weak_det_spec_lookup_ipc_buffer)+ - apply (wp lookup_cap_and_slot_inv) + apply (wp lookup_cap_and_slot_inv)+ apply (simp add:liftE_bindE) apply (rule corres_when,simp) apply (rule handle_fault_corres) @@ -1344,39 +1341,37 @@ lemma handle_invocation_corres: apply (rule corres_dummy_return_r) apply (rule corres_guard_imp[OF corres_split[OF _ dcorres_reply_from_kernel]]) apply (simp add:when_def) - apply (rule dcorres_set_intent_error) - apply (wp rfk_invs reply_from_kernel_error | simp add:not_idle_thread_def)+ + apply (rule dcorres_set_intent_error) + apply (wp rfk_invs reply_from_kernel_error | simp add:not_idle_thread_def)+ apply (rule dcorres_dummy_corrupt_ipc_buffer) apply (rule corres_split[OF _ dcorres_set_thread_state_Restart2]) apply (rule corres_splitEE[where r' = dc]) - apply (simp add: - whenE_def bind_assoc ) + apply (simp add: whenE_def bind_assoc) apply (rule dcorres_reply_from_syscall) apply (rule perform_invocation_corres,simp) - apply wp + apply wp+ apply (rule validE_validE_R) apply (clarsimp simp:validE_def) apply (rule hoare_drop_imp) apply (wp hoare_vcg_conj_lift hoare_strengthen_post[OF pinv_invs]) apply (clarsimp simp:invs_def valid_state_def) - apply wp - apply (simp add:conj_comms not_idle_thread_def split_def) - apply (wp sts_Restart_invs set_thread_state_ct_active) - apply (simp add:conj_comms split_def msg_from_syscall_error_simp) - apply (wp | simp add:split_def)+ - apply (rule_tac Q'="\r s. s = s'a \ ex_nonz_cap_to (cur_thread s) s \ + apply wp+ + apply (simp add:conj_comms not_idle_thread_def split_def) + apply (wp sts_Restart_invs set_thread_state_ct_active)+ + apply (simp add:conj_comms split_def msg_from_syscall_error_simp) + apply (wp | simp add:split_def)+ + apply (rule_tac Q'="\r s. s = s'a \ ex_nonz_cap_to (cur_thread s) s \ valid_invocation r s \ invocation_duplicates_valid r s" in hoare_post_imp_R) - apply (simp add:split_def liftE_bindE[symmetric]) - apply (wp decode_inv_wf) - apply (clarsimp simp:ct_in_state_def st_tcb_at_def obj_at_def - not_idle_thread_def)+ + apply (simp add:split_def liftE_bindE[symmetric]) + apply (wp decode_inv_wf) + apply (clarsimp simp:ct_in_state_def st_tcb_at_def obj_at_def not_idle_thread_def)+ apply (rule wp_post_tautE) apply clarsimp apply wp - apply (simp add:split_def liftE_bindE[symmetric]) - apply (wp | simp add: split_def liftE_bindE[symmetric])+ - apply (rule_tac Q="\r s. s = s'a \ + apply (simp add:split_def liftE_bindE[symmetric]) + apply (wp | simp add: split_def liftE_bindE[symmetric])+ + apply (rule_tac Q="\r s. s = s'a \ evalMonad (lookup_ipc_buffer False (cur_thread s'a)) s'a = Some r \ cte_wp_at (Not \ is_master_reply_cap) (snd x) s \ cte_wp_at (diminished (fst x)) (snd x) s \ s \ fst x \ @@ -1384,18 +1379,18 @@ lemma handle_invocation_corres: (\r\zobj_refs (fst x). ex_nonz_cap_to r s) \ (\r\cte_refs (fst x) (interrupt_irq_node s). ex_cte_cap_wp_to \ r s)" in hoare_strengthen_post) - apply (wp evalMonad_wp) - apply (simp add:empty_when_fail_lookup_ipc_buffer + apply (wp evalMonad_wp) + apply (simp add:empty_when_fail_lookup_ipc_buffer weak_det_spec_lookup_ipc_buffer)+ - apply wp - apply (clarsimp simp:invs_def valid_state_def valid_pspace_def valid_idle_def + apply wp + apply (clarsimp simp:invs_def valid_state_def valid_pspace_def valid_idle_def ct_in_state_def pred_tcb_at_def not_idle_thread_def obj_at_def st_tcb_ex_cap dest!:get_tcb_SomeD) - apply (wp | rule hoare_pre)+ + apply (wp)+ apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def pred_tcb_at_def obj_at_def) apply simp_all - done + done crunch cur_thread[wp]: complete_signal "\s. P (cur_thread s)" @@ -1482,11 +1477,11 @@ lemma handle_recv_corres: apply clarsimp apply (rule lookup_cap_corres, simp) apply (simp add: word_bits_def) - apply wp + apply wp+ apply (rule hoare_vcg_conj_liftE_R) apply (rule hoare_post_imp_R, rule lookup_cap_valid) apply (clarsimp simp: valid_cap_def) - apply wp + apply wp+ apply (simp add:injection_handler_def) apply (wp get_ntfn_wp |wpc)+ apply (simp only: conj_ac) @@ -1513,7 +1508,7 @@ lemma handle_recv_corres: obj_at_def valid_pspace_def not_idle_thread_def) apply (clarsimp, frule(1) valid_etcbs_get_tcb_get_etcb) apply (clarsimp simp:opt_object_tcb not_idle_thread_def) - apply wp + apply wp+ apply simp apply (clarsimp simp:emptyable_def not_idle_thread_def) apply (clarsimp simp: liftE_bindE get_notification_def get_object_def gets_def bind_assoc) @@ -1547,13 +1542,13 @@ lemma handle_reply_corres: apply simp apply (clarsimp simp:ct_running_not_idle_etc) apply (frule caps_of_state_valid(1)) - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (simp add:valid_cap_def)+ - apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD) - apply (drule_tac x = word in spec,simp) - apply (clarsimp simp:not_idle_thread_def pred_tcb_at_def obj_at_def valid_idle_def) - apply (clarsimp simp: transform_tcb_slot_simp|wp get_cap_wp)+ - apply (clarsimp simp:ct_in_state_def invs_def valid_state_def pred_tcb_at_def tcb_at_def obj_at_def) + apply (clarsimp simp:cte_wp_at_caps_of_state) + apply (simp add:valid_cap_def)+ + apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD) + apply (drule_tac x = word in spec,simp) + apply (clarsimp simp:not_idle_thread_def pred_tcb_at_def obj_at_def valid_idle_def) + apply (clarsimp simp: transform_tcb_slot_simp|(wp get_cap_wp)+)+ + apply (clarsimp simp:ct_in_state_def invs_def valid_state_def pred_tcb_at_def tcb_at_def obj_at_def) done lemma handle_vm_fault_wp: @@ -1561,14 +1556,14 @@ lemma handle_vm_fault_wp: apply (case_tac vmfault_type) apply (simp) apply wp - apply (clarsimp simp:do_machine_op_def getDFSR_def) - apply wp - apply (case_tac x) - apply clarsimp - apply (rule_tac P="P and (\x. snd (aa,ba) = machine_state x)" in hoare_post_imp) - apply (assumption) - apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def) + apply (clarsimp simp:do_machine_op_def getDFSR_def) apply wp + apply (case_tac x) + apply clarsimp + apply (rule_tac P="P and (\x. snd (aa,ba) = machine_state x)" in hoare_post_imp) + apply (assumption) + apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def) + apply wp+ apply (clarsimp simp:gets_def alternative_def get_def bind_def select_def return_def) apply (clarsimp simp:do_machine_op_def getFAR_def) apply wp @@ -1577,20 +1572,19 @@ lemma handle_vm_fault_wp: apply (rule_tac P="P and (\x. snd (aa,ba) = machine_state x)" in hoare_post_imp) apply (assumption) apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def) - apply wp - apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def) - apply simp - apply (simp) + apply wp+ + apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def) + apply simp apply wp - apply (clarsimp simp:do_machine_op_def getIFSR_def) - apply wp - apply (case_tac x) - apply clarsimp - apply (rule_tac P="P and (\x. snd (aa,ba) = machine_state x)" in hoare_post_imp) - apply (assumption) - apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def) + apply (clarsimp simp:do_machine_op_def getIFSR_def) apply wp - apply (clarsimp simp: gets_def get_def bind_def return_def) + apply (case_tac x) + apply clarsimp + apply (rule_tac P="P and (\x. snd (aa,ba) = machine_state x)" in hoare_post_imp) + apply (assumption) + apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def) + apply wp+ + apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def) done lemma get_active_irq_corres: @@ -1633,40 +1627,40 @@ lemma handle_event_corres: apply (simp add:not_idle_thread_def) apply (wp handle_reply_cur_thread_idle_thread handle_reply_valid_etcbs) apply (rule hoare_post_imp[OF _ hr_ct_active_and_valid_etcbs]) - apply (clarsimp simp:ct_in_state_def) - apply clarsimp+ - apply (frule (1) ct_running_not_idle_etc) - apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def + apply (clarsimp simp:ct_in_state_def) + apply clarsimp+ + apply (frule (1) ct_running_not_idle_etc) + apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)+)[1] - apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+ + apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+ apply (rule corres_guard_imp[OF handle_recv_corres]) apply simp+ apply (simp add: ct_running_not_idle_etc) - apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def) - apply (rule corres_guard_imp[OF handle_reply_corres]) - apply simp - apply (simp add: ct_running_not_idle_etc) - apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def) - apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def + apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def) + apply (rule corres_guard_imp[OF handle_reply_corres]) + apply simp + apply (simp add: ct_running_not_idle_etc) + apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def) + apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)+) - apply (rule dcorres_symb_exec_r) - apply (rule dcorres_return, simp) - apply (wp hoare_TrueI) - apply (rule corres_guard_imp) - apply (rule handle_recv_corres, simp) - apply clarsimp - apply (frule (1) ct_running_not_idle_etc) - apply (clarsimp simp: not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def) + apply (rule dcorres_symb_exec_r) + apply (rule dcorres_return, simp) + apply (wp hoare_TrueI)+ + apply (rule corres_guard_imp) + apply (rule handle_recv_corres, simp) + apply clarsimp + apply (frule (1) ct_running_not_idle_etc) + apply (clarsimp simp: not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def) + apply (rule corres_symb_exec_r[OF handle_fault_corres]) + apply wp[1] + apply clarsimp + apply (frule (1) ct_running_not_idle_etc) + apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def gets_def get_def valid_fault_def split:Structures_A.thread_state.splits)+ apply (rule corres_symb_exec_r[OF handle_fault_corres]) apply wp[1] apply clarsimp apply (frule (1) ct_running_not_idle_etc) - apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def gets_def get_def valid_fault_def split:Structures_A.thread_state.splits)+ - apply (rule corres_symb_exec_r[OF handle_fault_corres]) - apply wp[1] - apply clarsimp - apply (frule (1) ct_running_not_idle_etc) - apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+ + apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+ apply (simp add:handle_pending_interrupts_def) apply (rule corres_guard_imp) apply (rule corres_split [OF _ get_active_irq_corres]) diff --git a/proof/drefine/Tcb_DR.thy b/proof/drefine/Tcb_DR.thy index 6d4adc1c5..dec28f056 100644 --- a/proof/drefine/Tcb_DR.thy +++ b/proof/drefine/Tcb_DR.thy @@ -62,6 +62,7 @@ lemma decode_set_ipc_buffer_translate_tcb_invocation: translate_tcb_invocation_thread_ctrl_buffer (tc_new_buffer rv) = (if (x ! 0) = 0 then None else Some (reset_mem_mapping (transform_cap a), transform_cslot_ptr (b, c))) \,\\ft. op = s\)" + including no_pre apply (clarsimp simp:decode_set_ipc_buffer_def whenE_def | rule conjI)+ apply (wp , simp_all add:translate_tcb_invocation_thread_ctrl_buffer_def) apply (clarsimp | rule conjI)+ @@ -69,21 +70,21 @@ lemma decode_set_ipc_buffer_translate_tcb_invocation: apply (wp | clarsimp | rule conjI)+ apply (simp add:check_valid_ipc_buffer_def) apply (wpc|wp)+ - apply (wp hoare_whenE_wp) + apply (wp hoare_whenE_wp)+ apply (case_tac a) apply (simp_all add:derive_cap_def split del:if_split) apply (wp|clarsimp split del:if_split)+ apply (rename_tac arch_cap) apply (case_tac arch_cap) apply (simp_all add:arch_derive_cap_def split del: if_split) - apply (wp | clarsimp split del: if_split)+ + apply (wp+ | clarsimp split del: if_split)+ apply (clarsimp simp:transform_mapping_def) apply (rule hoare_pre) apply wpc apply (wp | clarsimp split del: if_split)+ apply (rule hoare_pre) apply wpc - apply wp + apply wp+ apply clarsimp done @@ -92,11 +93,11 @@ lemma derive_cap_translate_tcb_invocation: apply (simp add:derive_cap_def) apply (case_tac b) apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+ - apply (clarsimp simp:arch_derive_cap_def) - apply (rename_tac arch_cap) - apply (case_tac arch_cap) - apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+ - apply (clarsimp split:option.splits | rule conjI | wp)+ + apply (clarsimp simp:arch_derive_cap_def) + apply (rename_tac arch_cap) + apply (case_tac arch_cap) + apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+ + apply (clarsimp split:option.splits | rule conjI | wp)+ done lemma derive_cnode_cap_as_vroot: @@ -107,13 +108,13 @@ lemma derive_cnode_cap_as_vroot: apply (simp add:derive_cap_def is_valid_vtable_root_def) apply (case_tac aa) apply (clarsimp|wp)+ - apply (rename_tac arch_cap) - apply (case_tac arch_cap) - apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ + apply (rename_tac arch_cap) + apply (case_tac arch_cap) + apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ + apply (intro conjI) + apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ apply (intro conjI) - apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ - apply (intro conjI) - apply (clarsimp simp:arch_derive_cap_def | wp)+ + apply (clarsimp simp:arch_derive_cap_def | wp)+ done lemma derive_cnode_cap_as_croot: @@ -122,13 +123,13 @@ lemma derive_cnode_cap_as_croot: apply (clarsimp simp:derive_cap_def is_cap_simps) apply (case_tac a) apply (clarsimp|wp)+ - apply (rename_tac arch_cap) - apply (case_tac arch_cap) - apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ + apply (rename_tac arch_cap) + apply (case_tac arch_cap) + apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ + apply (intro conjI) + apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ apply (intro conjI) - apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+ - apply (intro conjI) - apply (clarsimp simp:arch_derive_cap_def | wp)+ + apply (clarsimp simp:arch_derive_cap_def | wp)+ done lemma valid_vtable_root_update: @@ -286,7 +287,7 @@ lemma decode_tcb_corres: apply simp apply (rule corres_alternate1) apply (clarsimp simp: returnOk_def translate_tcb_invocation_def) - apply(wp) + apply(wp)+ apply(simp add: range_check_def unlessE_def[abs_def]) (* TCBWriteRegisters *) apply(clarsimp simp: decode_write_registers_def split: list.split) @@ -303,7 +304,7 @@ lemma decode_tcb_corres: apply(fastforce intro: corres_alternate2 simp: throwError_def) apply(fastforce intro: corres_alternate1 simp: returnOk_def translate_tcb_invocation_def) - apply(wp) + apply(wp)+ (* TCBCopyRegisters *) apply(clarsimp simp: decode_copy_registers_def) apply (case_tac args') @@ -365,7 +366,7 @@ lemma decode_tcb_corres: apply (clarsimp simp:throw_on_none_def get_index_def dcorres_alternative_throw | rule conjI)+ apply (rule corres_return_throw_thingy) apply (rule decode_set_space_translate_tcb_invocation) - apply (clarsimp split del:if_splits)+ + apply (clarsimp split del: if_split)+ apply (clarsimp simp:translate_tcb_invocation_def translate_tcb_invocation_thread_ctrl_buffer_def) apply (case_tac "excaps' ! 0",simp,case_tac "excaps' ! Suc 0",simp) apply (simp add:update_cnode_cap_data) @@ -466,12 +467,11 @@ lemma dcorres_setup_reply_master: apply (rule_tac Q'="\rv. valid_objs and tcb_at obj_id and not_idle_thread obj_id and valid_idle and valid_etcbs and cte_wp_at (\c. c = rv) (obj_id,tcb_cnode_index 2)" in corres_symb_exec_r) prefer 2 - apply (wp get_cap_cte_wp_at) - apply simp - apply (rule dcorres_expand_pfx) - apply (clarsimp simp:tcb_at_def) - apply (frule valid_tcb_objs) - apply (simp add:tcb_at_def) + apply (wp get_cap_cte_wp_at) + apply (rule dcorres_expand_pfx) + apply (clarsimp simp:tcb_at_def) + apply (frule valid_tcb_objs) + apply (simp add:tcb_at_def) apply (clarsimp simp:cte_wp_at_cases dest!:get_tcb_SomeD) apply (clarsimp simp:valid_tcb_def) apply (clarsimp simp:tcb_cap_cases_def) @@ -482,7 +482,7 @@ lemma dcorres_setup_reply_master: apply (rule set_cap_corres) apply (clarsimp simp:transform_cap_def) apply (clarsimp simp:transform_tcb_slot_simp) - apply wp[2] + apply (wp+)[2] apply (clarsimp simp:transform_def transform_current_thread_def) apply (rule TrueI) apply (clarsimp simp: not_idle_thread_def) @@ -500,7 +500,7 @@ lemma dcorres_setup_reply_master: apply (clarsimp simp:cte_wp_at_cases) apply wp apply simp - done + done lemma set_cdl_cap_noop: " dcorres dc \ (cte_wp_at (\cap. cdlcap = transform_cap cap) slot and not_idle_thread (fst slot) and valid_etcbs) @@ -613,7 +613,7 @@ lemma invoke_tcb_corres_read_regs: apply (rule corres_symb_exec_r) apply (rule dcorres_idempotent_as_user) apply (rule hoare_mapM_idempotent) - apply wp + apply wp+ apply simp apply (rule suspend_corres, simp) apply wp @@ -644,7 +644,7 @@ lemma invoke_tcb_corres_write_regs: apply (clarsimp simp: dc_def, rule restart_corres [unfolded dc_def]) apply (clarsimp simp: when_def) apply (rule corrupt_tcb_intent_as_user_corres) - apply (wp | simp add:invs_def valid_state_def | fastforce)+ + apply (wp wp_post_taut | simp add:invs_def valid_state_def | fastforce)+ done context begin interpretation Arch . (*FIXME: arch_split*) @@ -712,6 +712,7 @@ crunch idle_thread_constant [wp]: "Tcb_A.restart", "IpcCancel_A.suspend" "\invs and not_idle_thread obj_id' :: det_state \ bool\ Tcb_A.restart obj_id' \\rv. valid_idle \" + including no_pre apply (simp add:Tcb_A.restart_def) apply wp apply (simp add:cancel_ipc_def) @@ -781,9 +782,9 @@ lemma invoke_tcb_corres_copy_regs: apply (rule restart_corres, simp) apply (rule corres_alternate2) apply (rule corres_free_return [where P="\" and P'="\"]) - apply (wp) + apply (wp wp_post_taut) apply (clarsimp simp:conj_comms) - apply (clarsimp simp :not_idle_thread_def | wp)+ + apply (clarsimp simp: not_idle_thread_def | wp)+ apply (rule corres_cases [where R="a"]) apply (clarsimp simp: when_def) apply (rule corres_alternate1) @@ -900,7 +901,7 @@ lemma thread_set_valid_irq_node: apply (simp add:valid_irq_node_def thread_set_def) apply wp apply (simp add:KHeap_A.set_object_def) - apply wp + apply wp+ apply (clarsimp simp:obj_at_def is_cap_table_def dest!:get_tcb_SomeD) apply (drule_tac x = irq in spec) apply clarsimp @@ -1105,13 +1106,13 @@ lemma dcorres_tcb_update_ipc_buffer: \ valid_mdb s \ valid_objs s\ not_idle_thread ab s \ valid_etcbs s \ ((is_thread_cap r \ obj_ref_of r = obj_id') \ ex_cte_cap_wp_to (\_. True) (obj_id', tcb_cnode_index 4) s)" - in hoare_strengthen_post) + in hoare_strengthen_post) apply (wp get_cap_ex_cte_cap_wp_to,clarsimp) apply (clarsimp simp:same_object_as_def) apply (drule ex_cte_cap_to_not_idle, auto simp: not_idle_thread_def)[1] - apply (wp hoare_when_wp) + apply (wp hoare_when_wp)+ apply (rule hoare_strengthen_post[OF hoare_TrueI[where P = \]],clarsimp+) - apply (wp hoare_drop_imp get_cap_weak_wp) + apply (wp wp_post_taut hoare_drop_imp get_cap_weak_wp)+ apply (clarsimp simp:conj_comms) apply (wp thread_set_global_refs_triv thread_set_valid_idle) apply (clarsimp simp:tcb_cap_cases_def) @@ -1211,11 +1212,11 @@ lemma dcorres_tcb_update_vspace_root: in hoare_post_impErr[where E="\x. \"]) apply (simp add: not_idle_thread_def) apply (wp cap_delete_cte_at cap_delete_deletes) - apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) - apply (erule cte_wp_at_weakenE,clarsimp+) - apply (simp add: emptyable_def not_idle_thread_def) - apply (erule tcb_at_cte_at,clarsimp) -done + apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) + apply (erule cte_wp_at_weakenE,clarsimp+) + apply (simp add: emptyable_def not_idle_thread_def) + apply (erule tcb_at_cte_at,clarsimp) + done lemma dcorres_tcb_update_cspace_root: "dcorres (dc \ dc) (\ ) ( invs and valid_etcbs and valid_pdpt_objs @@ -1375,11 +1376,10 @@ done lemma reschedule_required_transform: "\\ps. transform ps = cs\ reschedule_required \\r s. transform s = cs\" by (clarsimp simp: reschedule_required_def set_scheduler_action_def etcb_at_def - | wp tcb_sched_action_transform | wpc)+ + | wp tcb_sched_action_transform | wpc | assumption)+ lemma thread_set_priority_transform: "\\ps. transform ps = cs\ thread_set_priority tptr prio \\r s. transform s = cs\" apply (clarsimp simp: thread_set_priority_def ethread_set_def set_eobject_def | wp)+ - apply (clarsimp simp: transform_def transform_objects_def transform_cdt_def transform_current_thread_def transform_asid_table_def) apply (rule_tac y="\ptr. map_option (transform_object (machine_state s) ptr ((ekheap s |` (- {idle_thread s})) ptr)) ((kheap s |` (- {idle_thread s})) ptr)" in arg_cong) apply (rule ext) @@ -1493,6 +1493,7 @@ lemma dcorres_thread_control: \ (case fault_ep' of None \ True | Some bl \ length bl = word_bits)) (Tcb_D.invoke_tcb t) (Tcb_A.invoke_tcb t')" (is "\ ?eq; ?eq' \ \ dcorres (dc \ dc) \ ?P ?f ?g") + including no_pre apply (clarsimp simp: Tcb_D.invoke_tcb_def translate_tcb_invocation_def) apply (rule corres_guard_imp) apply (rule corres_splitEE[OF _ option_update_thread_corres]) @@ -1503,17 +1504,17 @@ lemma dcorres_thread_control: apply (rule corres_splitEE[OF _ dcorres_tcb_update_cspace_root]) apply (rule corres_splitEE[OF _ dcorres_tcb_update_vspace_root]) apply (rule dcorres_tcb_update_ipc_buffer) - apply (wp) + apply (wp)+ apply (wp|wpc)+ apply (wp checked_insert_tcb_invs | clarsimp)+ - apply (rule check_cap_at_stable, (clarsimp simp: not_idle_thread_def | wp)+)+ + apply (rule check_cap_at_stable, (clarsimp simp: not_idle_thread_def | wp+)+)+ apply (rule check_cap_at_stable) - apply (rule case_option_wp, clarsimp split: option.splits, wp) + apply (rule case_option_wp, clarsimp split: option.splits, wp+) apply (rule case_option_wp) apply simp apply (rule case_option_wp) apply (rule check_cap_at_stable, - clarsimp simp: not_idle_thread_def split: option.splits, wp) + clarsimp simp: not_idle_thread_def split: option.splits, wp+) apply (simp,rule check_cap_at_stable) apply (case_tac ipc_buffer') apply (clarsimp simp:not_idle_thread_def)+ @@ -1526,7 +1527,7 @@ lemma dcorres_thread_control: apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct2]) apply (wp hoare_case_someE) apply (clarsimp simp: not_idle_thread_def) - apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap) + apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)+ apply (wp case_option_wpE) apply simp apply (rule case_option_wpE) @@ -1534,55 +1535,55 @@ lemma dcorres_thread_control: apply (wp cap_delete_cte_at) apply (wp case_option_wpE) apply (simp add: not_idle_thread_def) - apply (wp cap_delete_cte_at cap_delete_valid_cap) + apply (wp cap_delete_cte_at cap_delete_valid_cap)+ apply (rule_tac Q'="\_. ?P" in hoare_post_imp_R[rotated]) apply (clarsimp simp: is_valid_vtable_root_def is_cnode_or_valid_arch_def is_arch_cap_def not_idle_thread_def emptyable_def split: option.splits) apply (wpc|wp)+ apply (wp checked_insert_tcb_invs | clarsimp)+ - apply (rule check_cap_at_stable, (simp add: not_idle_thread_def | wp)+)+ - apply (wp checked_insert_no_cap_to hoare_case_some) + apply (rule check_cap_at_stable, (simp add: not_idle_thread_def | wp+)+)+ + apply (wp checked_insert_no_cap_to hoare_case_some)+ apply (simp, rule check_cap_at_stable, simp add: not_idle_thread_def) - apply wp + apply wp+ apply (simp, rule check_cap_at_stable) - apply (rule case_option_wp, clarsimp split: option.splits, wp) + apply (rule case_option_wp, clarsimp split: option.splits, wp+) apply (rule case_option_wp) apply simp - apply (rule check_cap_at_stable, clarsimp simp: not_idle_thread_def split: option.splits, wp) + apply (rule check_cap_at_stable, clarsimp simp: not_idle_thread_def split: option.splits, wp+) apply (rule case_option_wp) apply simp - apply (rule check_cap_at_stable,wp) + apply (rule check_cap_at_stable, wp+) apply (rule case_option_wp) apply simp apply (wp checked_insert_no_cap_to) - apply (wp hoare_case_some) + apply (wp hoare_case_some) apply (simp, rule check_cap_at_stable, simp add: not_idle_thread_def) - apply (wp case_option_wp) - apply simp + apply (wp case_option_wp)+ + apply simp apply (rule case_option_wp, simp add: not_idle_thread_def) - apply (rule check_cap_at_stable, wp) + apply (rule check_cap_at_stable, wp+) apply (wp case_option_wp check_cap_at_stable | simp)+ - apply (wp cap_delete_deletes cap_delete_valid_cap) + apply (wp cap_delete_deletes cap_delete_valid_cap)+ apply (strengthen tcb_cap_always_valid_strg use_no_cap_to_obj_asid_strg) apply (simp add: tcb_cap_cases_def) apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct1]) apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct2]) apply simp - apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap) - apply (wp case_option_wpE cap_delete_valid_cap cap_delete_deletes cap_delete_cte_at - hoare_case_someE + apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)+ + apply ((wp case_option_wpE cap_delete_valid_cap cap_delete_deletes cap_delete_cte_at + hoare_case_someE)+ | simp add: not_idle_thread_def)+ apply (case_tac prio', clarsimp, rule return_wp, clarsimp) - subgoal by (wp case_option_wp dxo_wp_weak + subgoal by ((wp case_option_wp dxo_wp_weak)+ | clarsimp split: option.splits | rule conjI)+ - apply (simp, wp) + apply (simp, wp+) apply (case_tac mcp', clarsimp, rule return_wp, clarsimp) subgoal by (wp case_option_wp set_mcpriority_valid_cap_fst | clarsimp split: option.splits | rule conjI)+ - apply (wp case_option_wpE) + apply (wp case_option_wpE)+ apply (rule_tac Q="\_. ?P" in hoare_strengthen_post[rotated]) apply (clarsimp simp: is_valid_vtable_root_def is_cnode_or_valid_arch_def is_arch_cap_def not_idle_thread_def emptyable_def diff --git a/proof/drefine/Untyped_DR.thy b/proof/drefine/Untyped_DR.thy index 00076b2ff..2a0aa3c1b 100644 --- a/proof/drefine/Untyped_DR.thy +++ b/proof/drefine/Untyped_DR.thy @@ -622,7 +622,7 @@ lemma retype_region_dcorres: apply clarsimp apply simp apply assumption - apply wp + apply wp+ apply fastforce apply simp apply (case_tac type, simp_all add:translate_object_type_def) @@ -1052,7 +1052,7 @@ lemma create_caps_loop_dcorres: apply (erule corres_split_nor) apply (rule create_cap_dcorres) apply (wp create_cap_invs hoare_vcg_const_Ball_lift - create_cap_mdb_cte_at[unfolded swp_def]) + create_cap_mdb_cte_at[unfolded swp_def])+ apply simp apply (clarsimp simp: not_idle_thread_def swp_def) apply (auto simp: cte_wp_at_caps_of_state image_def) @@ -1358,7 +1358,7 @@ lemma reset_untyped_cap_corres: apply (rule throw_or_return_preemption_corres[where P=\ and P'=\]) apply (clarsimp simp: is_cap_simps bits_of_def) apply simp - apply wp + apply wp+ apply (clarsimp simp add: is_cap_simps cap_aligned_def bits_of_def aligned_add_aligned is_aligned_shiftl) apply (simp add: reset_chunk_bits_def) @@ -1373,14 +1373,12 @@ lemma reset_untyped_cap_corres: apply (rule shiftl_less_t2n[OF word_of_nat_less]) apply simp apply (simp add: word_bits_def) - apply (rule hoare_pre, wp) - apply simp - apply (rule hoare_pre) - apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift - update_untyped_cap_valid_objs set_cap_no_overlap - set_cap_idle preemption_point_inv' - set_cap_cte_wp_at - | simp)+ + apply wpsimp + apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift + update_untyped_cap_valid_objs set_cap_no_overlap + set_cap_idle preemption_point_inv' + set_cap_cte_wp_at + | simp)+ apply (clarsimp simp: cte_wp_at_caps_of_state exI is_cap_simps bits_of_def) apply (frule(1) cte_wp_at_valid_objs_valid_cap[OF caps_of_state_cteD]) @@ -1535,7 +1533,7 @@ lemma invoke_untyped_corres: simp: vslot image_def invs_def valid_state_def valid_mdb_def cte_wp_at_caps_of_state | intro conjI | drule (1) bspec | drule(1) mdb_cte_atD[rotated])+)[2] apply (wp retype_region_cte_at_other'[where sz= sz] retype_region_post_retype_invs[where sz = sz] - hoare_vcg_const_Ball_lift retype_region_aligned_for_init) + hoare_vcg_const_Ball_lift retype_region_aligned_for_init)+ apply (clarsimp simp:conj_comms misc cover) apply (rule_tac Q="\r s. cte_wp_at (\cp. \idx. cp = (cap.UntypedCap dev ptr' sz idx)) cref s \ @@ -1578,9 +1576,9 @@ lemma invoke_untyped_corres: apply simp apply wp apply (simp split del: if_split) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (wp_once hoare_drop_imps) - apply wp + apply wp+ apply (rule validE_validE_R, rule_tac E="\\" and Q="\_. valid_etcbs and invs and valid_untyped_inv_wcap untyped_invocation (Some (cap.UntypedCap dev ptr' sz (if reset then 0 else idx))) and ct_active @@ -1782,6 +1780,7 @@ lemma decode_untyped_corres: and (\s. \x \ set excaps'. cte_wp_at (diminished (fst x)) (snd x) s) and valid_etcbs) (Untyped_D.decode_untyped_invocation cap slot excaps ui) (Decode_A.decode_untyped_invocation label' args' slot' cap' (map fst excaps'))" + including no_pre apply (simp add: transform_intent_def map_option_Some_eq2 transform_intent_untyped_retype_def split: invocation_label.split_asm arch_invocation_label.split_asm list.split_asm @@ -1850,13 +1849,13 @@ lemma decode_untyped_corres: apply simp apply (simp add:const_on_failure_def) apply clarsimp - apply wp + apply wp+ apply (clarsimp simp:conj_comms) apply (wp mapME_x_inv_wp[OF hoare_pre(2)] | simp split del: if_split)+ - apply (wp hoare_whenE_wp) + apply (wp hoare_whenE_wp)+ apply (simp add:validE_def split del:if_splits) apply (rule_tac Q = "\r. op = s" in hoare_strengthen_post) - apply wp + apply wp+ apply fastforce apply (case_tac r,clarsimp+) apply (rule corres_alternate1) diff --git a/proof/infoflow/ADT_IF.thy b/proof/infoflow/ADT_IF.thy index 14026fc56..c5e22dfc4 100644 --- a/proof/infoflow/ADT_IF.thy +++ b/proof/infoflow/ADT_IF.thy @@ -852,16 +852,14 @@ crunch cur_domain[wp]: do_user_op_if "\s. P (cur_domain s)" (wp: select_ crunch idle_thread[wp]: do_user_op_if "\s. P (idle_thread s)" (wp: select_wp ignore: user_memory_update) lemma do_use_op_guarded_pas_domain[wp]: "\guarded_pas_domain aag\ do_user_op_if f tc \\_. guarded_pas_domain aag\" - apply (rule guarded_pas_domain_lift) - apply wp - done + by (rule guarded_pas_domain_lift; wp) crunch domain_fields[wp]: do_user_op_if "domain_fields P" (wp: select_wp ignore: user_memory_update) definition do_user_op_A_if :: "user_transition_if \ ((user_context \ det_state) \ event option \ (user_context \ det_state)) set" - where +where "do_user_op_A_if uop \ {(s,e,(tc,s'))| s e tc s'. ((e,tc),s') \ fst (split (do_user_op_if uop) s)}" text {* @@ -871,7 +869,7 @@ text {* *} definition kernel_entry_if :: "event \ user_context \ (((interrupt + unit) \ user_context),det_ext) s_monad" - where +where "kernel_entry_if e tc \ do t \ gets cur_thread; thread_set (\tcb. tcb \ tcb_arch := arch_tcb_context_set tc (tcb_arch tcb)\) t; @@ -1147,9 +1145,7 @@ crunch cur_domain[wp]: handle_preemption_if " \s. P (cur_domain s)" crunch idle_thread[wp]: handle_preemption_if "\s. P (idle_thread s)" lemma handle_preemption_if_guarded_pas_domain[wp]: "\guarded_pas_domain aag\ handle_preemption_if tc \\_. guarded_pas_domain aag\" - apply (rule guarded_pas_domain_lift) - apply wp - done + by (rule guarded_pas_domain_lift; wp) crunch valid_sched[wp]: handle_preemption_if "valid_sched" (wp: crunch_wps simp: crunch_simps ignore: getActiveIRQ) @@ -1205,9 +1201,7 @@ crunch cur_domain[wp]: activate_thread "\s. P (cur_domain s)" crunch idle_thread[wp]: activate_thread "\s. P (idle_thread s)" lemma activate_thread_guarded_pas_domain[wp]: "\guarded_pas_domain aag\ activate_thread \\_. guarded_pas_domain aag\" - apply (rule guarded_pas_domain_lift) - apply (wp activate_thread_cur_thread) - done + by (rule guarded_pas_domain_lift; wp activate_thread_cur_thread) lemma guarded_pas_domain_arch_state_update[simp]: "guarded_pas_domain aag (s\arch_state := x\) = guarded_pas_domain aag s" apply (simp add: guarded_pas_domain_def) @@ -1696,18 +1690,17 @@ lemma schedule_if_domain_time_nonzero': schedule_if tc \(\_ s. domain_time s > 0)\" apply(simp add: schedule_if_def schedule_def) - apply (rule hoare_pre) apply (wp next_domain_domain_time_nonzero | wpc | simp add: crunch_simps guarded_switch_to_def switch_to_thread_def choose_thread_def switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ apply(wp hoare_drop_imps) apply(simp add: choose_thread_def switch_to_idle_thread_def arch_switch_to_idle_thread_def guarded_switch_to_def switch_to_thread_def | wp)+ - apply(wp hoare_drop_imps) + apply(wp hoare_drop_imps)+ apply simp - apply(wp next_domain_domain_time_nonzero) + apply(wp next_domain_domain_time_nonzero)+ apply (clarsimp simp: if_apply_def2) - apply(wp gts_wp) + apply(wp gts_wp)+ apply (auto) done @@ -1877,33 +1870,19 @@ lemma ptrFromPAddr_add_helper: done lemma dmo_user_memory_update_idle_equiv: - "\idle_equiv st\ - do_machine_op - (user_memory_update um) - \\y. idle_equiv st\" - apply(wp dmo_wp) - apply(simp add: user_memory_update_def) - apply(wp modify_wp) - done + "\idle_equiv st\ do_machine_op (user_memory_update um) \\y. idle_equiv st\" + by (wpsimp wp: dmo_wp) lemma dmo_device_memory_update_idle_equiv: - "\idle_equiv st\ - do_machine_op - (device_memory_update um) - \\y. idle_equiv st\" - apply(wp dmo_wp) - apply(simp add: device_memory_update_def) - apply(wp modify_wp) - done + "\idle_equiv st\ do_machine_op (device_memory_update um) \\y. idle_equiv st\" + by (wpsimp wp: dmo_wp) lemma do_user_op_if_idle_equiv[wp]: "\idle_equiv st and invs\ do_user_op_if tc uop \\_. idle_equiv st\" - apply (simp add: do_user_op_if_def) - apply (wp dmo_user_memory_update_idle_equiv dmo_device_memory_update_idle_equiv - select_wp | wpc | simp)+ - done + unfolding do_user_op_if_def + by (wpsimp wp: dmo_user_memory_update_idle_equiv dmo_device_memory_update_idle_equiv select_wp) lemma ct_active_not_idle': "ct_active s \ \ ct_idle s" apply (clarsimp simp add: ct_in_state_def st_tcb_at_def obj_at_def) @@ -1911,15 +1890,11 @@ lemma ct_active_not_idle': "ct_active s \ \ ct_idle s" lemma Init_Fin_serial_weak_strengthen: "Init_Fin_serial_weak A s0 I \ A [> J \ J \ I \ Init A s0 \ J \ Init_Fin_serial_weak A s0 J" - apply (simp add: Init_Fin_serial_weak_def serial_system_weak_def Init_Fin_serial_weak_axioms_def) - apply safe - apply force+ - done + by (force simp: Init_Fin_serial_weak_def serial_system_weak_def Init_Fin_serial_weak_axioms_def) lemma rel_terminate_weaken: "rel_terminate A s0 R I measuref \ J \ I \ rel_terminate A s0 R J measuref" - apply (force simp: rel_terminate_def) - done + by (force simp: rel_terminate_def) end @@ -2071,7 +2046,7 @@ lemma kernel_entry_if_was_not_Interrupt: apply wp apply simp apply(rule handle_event_was_not_Interrupt[simplified validE_E_def validE_def]) - apply wp + apply wp+ done lemma ct_idle_lift: @@ -2779,7 +2754,7 @@ lemma cap_revoke_irq_state_inv'': apply(subst cap_revoke.simps) apply(rule hoare_spec_gen_asm) apply(rule hoare_pre_spec_validE) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply(wp spec_valid_conj_liftE2 | simp)+ apply(wp drop_spec_validE[OF preemption_point_irq_state_inv[simplified validE_R_def]] drop_spec_validE[OF preemption_point_irq_state_inv'[where irq=irq]] @@ -2954,6 +2929,7 @@ lemma perform_invocation_irq_state_inv: domain_sep_inv False sta and valid_invocation oper and K (irq_is_recurring irq st)\ perform_invocation x y oper \\_. irq_state_inv st\, \\_. irq_state_next st\" + including no_pre apply(case_tac oper) apply(simp | wp)+ apply((wp invoke_untyped_irq_state_inv[where irq=irq] irq_state_inv_triv | simp)+)[4] diff --git a/proof/infoflow/ADT_IF_Refine.thy b/proof/infoflow/ADT_IF_Refine.thy index 38cc9ef7a..d6e892618 100644 --- a/proof/infoflow/ADT_IF_Refine.thy +++ b/proof/infoflow/ADT_IF_Refine.thy @@ -98,7 +98,7 @@ lemma kernel_entry_if_valid_domain_time: | clarsimp | wpc)+ -- "strengthen post of do_machine_op; we know interrupt occurred" apply (rule_tac Q="\_ s. 0 < domain_time s" in hoare_post_imp, fastforce) - apply (wp, simp) + apply (wp+, simp) done lemma kernel_entry_if_no_preempt: @@ -332,7 +332,7 @@ lemma do_user_op_if_corres: apply (clarsimp simp: select_def corres_underlying_def) apply (simp only: comp_def | wp hoare_TrueI)+ apply (rule corres_underlying_trivial) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply clarsimp apply force apply force @@ -378,7 +378,7 @@ lemma doUserOp_if_invs'[wp]: apply (simp add: doUserOp_if_def split_def ex_abs_def) apply (wp device_update_invs' dmo_setExMonitor_wp' dmo_invs' | simp)+ apply (clarsimp simp add: no_irq_modify user_memory_update_def) - apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp) + apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)+ apply (clarsimp simp: user_memory_update_def simpler_modify_def restrict_map_def split: option.splits) @@ -573,7 +573,7 @@ lemma check_active_irq_if_corres: apply (simp add: checkActiveIRQ_if_def check_active_irq_if_def) apply (rule corres_underlying_split[where r'="op ="]) apply (rule dmo_getActiveIRQ_corres) - apply (wp del: dmo_silc_dom add: do_machine_op_domain_list) + apply (wp del: dmo_silc_dom add: do_machine_op_domain_list)+ apply clarsimp done @@ -721,7 +721,7 @@ lemma schedule_if_corres: apply (rule activate_corres) apply (rule hoare_post_taut[where P=\])+ apply (rule schedule_corres) - apply (wp schedule_invs') + apply (wp schedule_invs')+ apply clarsimp+ done @@ -748,7 +748,6 @@ lemma schedule_if'_rct[wp]: "\invs'\ schedule'_if tc \\r s. ksSchedulerAction s = ResumeCurrentThread\" apply (simp add: schedule'_if_def) apply (wp activate_sch_act schedule_sch) - apply simp done @@ -770,7 +769,7 @@ lemma schedule_if_domain_time_left: \ (domain_time s = 0 \ scheduler_action s = choose_new_thread)" in hoare_post_imp) apply fastforce - apply wp + apply wp+ apply simp done @@ -810,9 +809,9 @@ lemma kernel_exit_if_corres: apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) apply (rule gct_corres) - apply wp + apply wp+ apply clarsimp+ - done + done lemma kernelExit_inv[wp]: "\P\ kernelExit_if tc \\_. P\" @@ -1231,6 +1230,7 @@ lemma haskell_invs: "global_automaton_invs checkActiveIRQ_H_if (doUserOp_H_if uop) kernelCall_H_if handlePreemption_H_if schedule'_H_if kernelExit_H_if full_invs_if' (ADT_H_if uop) UNIV" + including no_pre supply conj_cong[cong] apply (unfold_locales) apply (simp add: ADT_H_if_def) @@ -1248,7 +1248,7 @@ lemma haskell_invs: apply (rule hoare_drop_imps) apply wp apply (wp_once hoare_disjI1) - apply wp + apply wp+ apply (clarsimp simp: active_from_running')+ apply (rule preserves_lifts) apply (simp add: full_invs_if'_def) diff --git a/proof/infoflow/ADT_IF_Refine_C.thy b/proof/infoflow/ADT_IF_Refine_C.thy index 31b5cd221..6cbb43086 100644 --- a/proof/infoflow/ADT_IF_Refine_C.thy +++ b/proof/infoflow/ADT_IF_Refine_C.thy @@ -323,15 +323,16 @@ lemma kernelEntry_corres_C: apply simp apply (rule_tac P="\" and P'="\" in corres_inst) apply (clarsimp simp: prod_lift_def split: if_split) - apply wp + apply wp+ apply (rule hoare_strengthen_post) apply (subst archTcbUpdate_aux2[symmetric]) apply (rule threadSet_all_invs_triv'[where e=e]) apply (clarsimp simp: all_invs'_def) - apply force + apply (rule exI, (rule conjI, assumption)+) + subgoal by force apply simp apply (rule hoare_post_taut[where P=\]) - apply wp + apply wp+ apply (clarsimp simp: all_invs'_def invs'_def cur_tcb'_def) apply fastforce done @@ -427,13 +428,13 @@ lemma corres_dmo_getExMonitor_C: apply clarsimp apply (rule corres_modify) apply (clarsimp simp: rf_sr_def cstate_relation_def carch_state_relation_def cmachine_state_relation_def Let_def) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply (rule corres_select_f') apply (clarsimp simp: getExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def) apply (clarsimp simp: getExMonitor_no_fail[simplified no_fail_def]) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply (clarsimp simp: corres_gets rf_sr_def cstate_relation_def cmachine_state_relation_def Let_def) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply (rule TrueI conjI | clarsimp simp: getExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)+ done @@ -451,9 +452,9 @@ lemma corres_dmo_setExMonitor_C: apply (rule corres_select_f') apply (clarsimp simp: setExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def) apply (clarsimp simp: setExMonitor_no_fail[simplified no_fail_def]) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply (clarsimp simp: corres_gets rf_sr_def cstate_relation_def cmachine_state_relation_def Let_def) - apply (wp hoare_TrueI) + apply (wp hoare_TrueI)+ apply (rule TrueI conjI | clarsimp simp: setExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)+ done @@ -753,7 +754,7 @@ lemma kernel_exit_corres_C: apply simp apply (rule_tac P="\" and P'="\" in corres_inst) apply (clarsimp simp: getCurThread_def rf_sr_def cstate_relation_def Let_def) - apply wp + apply wp+ apply clarsimp+ done @@ -888,7 +889,7 @@ lemma c_to_haskell: "uop_nonempty uop \ global_automata_refine c apply (fastforce simp: full_invs_if'_def ex_abs_def) apply simp+ apply (simp add: ct_running'_C) - apply wp + apply wp+ apply (clarsimp simp: full_invs_if'_def) apply (clarsimp) apply (drule use_valid[OF _ kernelEntry_if_no_preempt]; simp) diff --git a/proof/infoflow/Arch_IF.thy b/proof/infoflow/Arch_IF.thy index 4284de464..305d7493c 100644 --- a/proof/infoflow/Arch_IF.thy +++ b/proof/infoflow/Arch_IF.thy @@ -19,24 +19,19 @@ abbreviation irq_state_of_state :: "det_state \ nat" where lemma do_extended_op_irq_state_of_state[wp]: "\\s. P (irq_state_of_state s)\ do_extended_op f \\_ s. P (irq_state_of_state s)\" - apply(wp dxo_wp_weak) - apply simp - done + by (wpsimp wp: dxo_wp_weak) lemma no_irq_underlying_memory_update[simp]: "no_irq (modify (underlying_memory_update f))" - apply(simp add: no_irq_def | wp modify_wp | clarsimp)+ - done + by (wpsimp simp: no_irq_def) crunch irq_state_of_state[wp]: cap_insert "\s. P (irq_state_of_state s)" (wp: crunch_wps) - crunch irq_state_of_state[wp]: set_extra_badge "\s. P (irq_state_of_state s)" (wp: crunch_wps dmo_wp simp: storeWord_def) - lemma transfer_caps_loop_irq_state[wp]: "\\s. P (irq_state_of_state s)\ transfer_caps_loop a b c d e f \\_ s. P (irq_state_of_state s)\" apply(wp transfer_caps_loop_pres) @@ -118,9 +113,9 @@ lemma get_object_revrv: apply(simp) apply(rule assert_ev2) apply(simp) - apply(wp) - apply fastforce+ - done + apply(wp)+ + apply fastforce + done lemma get_object_revrv': "reads_equiv_valid_rv_inv (affects_equiv aag l) aag @@ -136,9 +131,9 @@ lemma get_object_revrv': apply(simp) apply(rule assert_ev2) apply(simp add: equiv_for_def) - apply(wp) - apply fastforce+ - done + apply(wp)+ + apply fastforce + done lemma get_asid_pool_revrv': "reads_equiv_valid_rv_inv (affects_equiv aag l) aag @@ -291,7 +286,7 @@ lemma find_pd_for_asid_reads_respects: apply(intro conjI impI allI) apply(rule return_ev2, simp) apply(rule return_ev2, simp) - apply wp + apply wp+ apply(rule_tac R'="op =" and Q="\ rv s. rv = (arm_asid_table (arch_state s)) (asid_high_bits_of asid) \ is_subject_asid aag asid \ asid \ 0" and Q'="\ rv s. rv = (arm_asid_table (arch_state s)) (asid_high_bits_of asid) \ is_subject_asid aag asid \ asid \ 0" in equiv_valid_2_bindE) apply (simp add: equiv_valid_def2[symmetric]) apply (split option.splits) @@ -301,7 +296,7 @@ lemma find_pd_for_asid_reads_respects: apply(rule equiv_valid_2_liftE) apply(clarsimp) apply(rule get_asid_pool_revrv) - apply(wp gets_apply_wp) + apply(wp gets_apply_wp)+ apply(subst rel_sum_comb_equals) apply(subst equiv_valid_def2[symmetric]) apply(wp gets_apply_ev | simp)+ @@ -660,9 +655,7 @@ lemma set_vm_root_reads_respects: lemma get_pte_reads_respects: "reads_respects aag l (K (is_subject aag (ptr && ~~ mask pt_bits))) (get_pte ptr)" unfolding get_pte_def fun_app_def - apply(wp get_pt_reads_respects) - apply(simp) - done + by (wp get_pt_reads_respects) lemma gets_cur_thread_revrv: "reads_equiv_valid_rv_inv (affects_equiv aag l) aag op = \ (gets cur_thread)" @@ -853,11 +846,10 @@ lemma invalidate_tlb_by_asid_reads_respects: "reads_respects aag l (\_. True) (invalidate_tlb_by_asid asid)" apply(rule reads_respects_unobservable_unit_return) apply (rule invalidate_tlb_by_asid_states_equiv_for) - apply wp + apply wp+ done - lemma get_master_pte_reads_respects: "reads_respects aag l (K (is_subject aag (p && ~~ mask pt_bits))) (get_master_pte p)" unfolding get_master_pte_def @@ -1028,7 +1020,7 @@ lemma equiv_valid_get_assert: apply(rule_tac W="\\" in equiv_valid_rv_bind) apply(rule equiv_valid_rv_guard_imp) apply(rule equiv_valid_rv_trivial) - apply wp + apply wp+ apply(rule_tac R'="\\" in equiv_valid_2_bind) apply(simp add: equiv_valid_def2) apply(rule assert_ev2) @@ -1109,7 +1101,7 @@ lemma arm_asid_table_update_reads_respects: apply(simp add: equiv_valid_def2) apply(rule_tac W="\\" and Q="\ rv s. is_subject aag pool_ptr \ rv = arm_asid_table (arch_state s)" in equiv_valid_rv_bind) apply(rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial]) - apply wp + apply wp+ apply(rule modify_ev2) apply clarsimp apply (drule(1) is_subject_kheap_eq[rotated]) @@ -1126,7 +1118,6 @@ lemma delete_objects_reads_respects: "reads_respects aag l (\_. True) (delete_objects p b)" apply (simp add: delete_objects_def) apply (wp detype_reads_respects dmo_freeMemory_reads_respects) - apply simp done lemma another_hacky_rewrite: @@ -1175,7 +1166,7 @@ lemma set_asid_pool_reads_respects: apply(fold equiv_valid_def2) apply(rule set_object_reads_respects) apply(rule assert_ev2, rule refl) - apply (wp get_object_wp) + apply (wp get_object_wp)+ apply(clarsimp, rule impI, rule TrueI) done @@ -1280,11 +1271,11 @@ lemma delete_asid_pool_reads_respects: apply(rule equiv_valid_2_bind) apply(rule equiv_valid_2_bind) apply(rule equiv_valid_2_unobservable) - apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread) + apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)+ apply(rule arm_asid_table_delete_ev2) - apply(wp) + apply(wp)+ apply(rule equiv_valid_2_unobservable) - apply(wp mapM_wp' invalidate_asid_entry_states_equiv_for flush_space_states_equiv_for invalidate_asid_entry_cur_thread invalidate_asid_entry_sched_act invalidate_asid_entry_wuc flush_space_cur_thread flush_space_sched_act flush_space_wuc | clarsimp)+ + apply(wp mapM_wp' invalidate_asid_entry_states_equiv_for flush_space_states_equiv_for invalidate_asid_entry_cur_thread invalidate_asid_entry_sched_act invalidate_asid_entry_wuc flush_space_cur_thread flush_space_sched_act flush_space_wuc | clarsimp)+ apply( wp return_ev2 | drule (1) requiv_arm_asid_table_asid_high_bits_of_asid_eq' | clarsimp | rule conjI | @@ -1409,23 +1400,23 @@ lemma delete_asid_reads_respects: apply(rule_tac R'="\\" in equiv_valid_2_bind) apply(subst equiv_valid_def2[symmetric]) apply(rule reads_respects_unobservable_unit_return) - apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread) + apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)+ apply(rule set_asid_pool_delete_ev2) - apply(wp) + apply(wp)+ apply(rule equiv_valid_2_unobservable) apply(wp invalidate_asid_entry_states_equiv_for - invalidate_asid_entry_cur_thread) + invalidate_asid_entry_cur_thread)+ apply(simp add: invalidate_asid_entry_def | wp invalidate_asid_kheap invalidate_hw_asid_entry_kheap load_hw_asid_kheap)+ apply(rule equiv_valid_2_unobservable) - apply(wp flush_space_states_equiv_for flush_space_cur_thread) + apply(wp flush_space_states_equiv_for flush_space_cur_thread)+ apply(wp load_hw_asid_kheap | simp add: flush_space_def | wpc)+ apply(clarsimp | rule return_ev2)+ apply(rule equiv_valid_2_guard_imp) apply(wp get_asid_pool_revrv) apply(simp)+ - apply(wp) + apply(wp)+ apply(clarsimp simp: obj_at_def)+ apply(clarsimp simp: equiv_valid_2_def reads_equiv_def equiv_asids_def equiv_asid_def states_equiv_for_def) apply(erule_tac x="pasASIDAbs aag asid" in ballE) @@ -1715,7 +1706,7 @@ declare dmo_mol_globals_equiv[wp] lemma unmap_page_table_globals_equiv: "\pspace_aligned and valid_arch_objs and valid_global_objs and valid_vs_lookup and valid_global_refs and valid_arch_state and globals_equiv st\ unmap_page_table asid vaddr pt \\rv. globals_equiv st\" - unfolding unmap_page_table_def page_table_mapped_def + unfolding unmap_page_table_def page_table_mapped_def including no_pre apply(wp store_pde_globals_equiv | wpc | simp add: cleanByVA_PoU_def)+ apply(rule_tac Q="\_. globals_equiv st and (\sa. lookup_pd_slot pd vaddr && ~~ mask pd_bits \ arm_global_pd (arch_state sa))" in hoare_strengthen_post) apply(wp | simp)+ @@ -1909,16 +1900,16 @@ lemma unmap_page_globals_equiv: "\globals_equiv st and valid_arch_state and pspace_aligned and valid_arch_objs and valid_global_objs and valid_vs_lookup and valid_global_refs \ unmap_page pgsz asid vptr pptr \\_. globals_equiv st\" - unfolding unmap_page_def cleanCacheRange_PoU_def + unfolding unmap_page_def cleanCacheRange_PoU_def including no_pre apply (induct pgsz) prefer 4 apply (simp only: vmpage_size.simps) apply(wp mapM_swp_store_pde_globals_equiv dmo_cacheRangeOp_lift | simp add: cleanByVA_PoU_def)+ apply(rule hoare_drop_imps) - apply(wp) + apply(wp)+ apply(simp) apply(rule hoare_drop_imps) - apply(wp) + apply(wp)+ apply (rule hoare_pre) apply (rule_tac Q="\x. globals_equiv st and (\sa. lookup_pd_slot x vptr && mask 6 = 0 \ (\xa\set [0 , 4 .e. 0x3C]. xa + lookup_pd_slot x vptr && ~~ mask pd_bits \ arm_global_pd (arch_state sa)))" and E="\_. globals_equiv st" in hoare_post_impErr) apply(wp find_pd_for_asid_not_arm_global_pd_large_page) @@ -1926,7 +1917,7 @@ lemma unmap_page_globals_equiv: apply simp apply simp apply(wp store_pte_globals_equiv | simp add: cleanByVA_PoU_def)+ - apply(wp hoare_drop_imps) + apply(wp hoare_drop_imps)+ apply(wp_once lookup_pt_slot_inv) apply(wp_once lookup_pt_slot_inv) apply(wp_once lookup_pt_slot_inv) @@ -1941,7 +1932,7 @@ lemma unmap_page_globals_equiv: apply(simp add: valid_arch_state_ko_at_arm) apply(rule hoare_pre) apply(wp store_pde_globals_equiv | simp add: valid_arch_state_ko_at_arm cleanByVA_PoU_def)+ - apply(wp find_pd_for_asid_not_arm_global_pd hoare_drop_imps) + apply(wp find_pd_for_asid_not_arm_global_pd hoare_drop_imps)+ apply(clarsimp) done (* don't know what happened here. wp deleted globals_equiv from precon *) @@ -1952,12 +1943,10 @@ lemma cte_wp_parent_not_global_pd: "valid_global_refs s \ cte_wp apply (drule valid_global_refsD2,simp) apply (unfold parent_for_refs_def) apply (simp add: image_def global_refs_def cap_range_def) - apply (elim conjE) - apply (intro ballI) apply clarsimp apply (subgoal_tac "arm_global_pd (arch_state s) \ set b") apply auto -done + done definition authorised_for_globals_page_inv :: "page_invocation \ 'z::state_ext state \ bool" where "authorised_for_globals_page_inv pgi \ @@ -1985,9 +1974,9 @@ lemma as_user_globals_equiv: \\_. globals_equiv s\" unfolding as_user_def apply(wp) - apply(simp add: split_def) - apply(wp set_object_globals_equiv) - apply(clarsimp simp: valid_ko_at_arm_def get_tcb_def obj_at_def) + apply(simp add: split_def) + apply(wp set_object_globals_equiv)+ + apply(clarsimp simp: valid_ko_at_arm_def get_tcb_def obj_at_def) done @@ -2043,7 +2032,7 @@ lemma set_mrs_globals_equiv: apply(insert length_msg_lt_msg_max) apply(simp) apply(wp set_object_globals_equiv static_imp_wp) - apply(wp hoare_vcg_all_lift set_object_globals_equiv static_imp_wp) + apply(wp hoare_vcg_all_lift set_object_globals_equiv static_imp_wp)+ apply(clarsimp simp:arm_global_pd_not_tcb)+ done @@ -2077,7 +2066,7 @@ lemma retype_region_ASIDPoolObj_globals_equiv: unfolding retype_region_def apply(wp modify_wp dxo_wp_weak | simp | fastforce simp: globals_equiv_def default_arch_object_def obj_bits_api_def)+ apply (simp add: trans_state_update[symmetric] del: trans_state_update) - apply wp + apply wp+ apply (fastforce simp: globals_equiv_def idle_equiv_def tcb_at_def2) done @@ -2087,7 +2076,8 @@ lemma cap_insert_globals_equiv'': "\globals_equiv s and valid_global_objs and valid_ko_at_arm\ cap_insert new_cap src_slot dest_slot \\_. globals_equiv s\" unfolding cap_insert_def - apply(wp set_original_globals_equiv update_cdt_globals_equiv set_cap_globals_equiv'' dxo_wp_weak | rule hoare_drop_imps | simp)+ + apply(wp set_original_globals_equiv update_cdt_globals_equiv set_cap_globals_equiv'' dxo_wp_weak + | rule hoare_drop_imps | simp)+ done @@ -2255,10 +2245,13 @@ lemma arch_perform_invocation_globals_equiv: arch_perform_invocation ai \\_. globals_equiv s\" unfolding arch_perform_invocation_def apply wp - apply(rule hoare_weaken_pre) apply(wpc) - apply(wp perform_page_table_invocation_globals_equiv perform_page_directory_invocation_globals_equiv perform_page_invocation_globals_equiv perform_asid_control_invocation_globals_equiv perform_asid_pool_invocation_globals_equiv) - apply(auto simp: authorised_for_globals_arch_inv_def dest: valid_arch_state_ko_at_arm simp: invs_def valid_state_def valid_arch_inv_def invs_valid_vs_lookup) + apply(wp perform_page_table_invocation_globals_equiv perform_page_directory_invocation_globals_equiv + perform_page_invocation_globals_equiv perform_asid_control_invocation_globals_equiv + perform_asid_pool_invocation_globals_equiv)+ + apply(auto simp: authorised_for_globals_arch_inv_def + dest: valid_arch_state_ko_at_arm + simp: invs_def valid_state_def valid_arch_inv_def invs_valid_vs_lookup) done lemma find_pd_for_asid_authority3: @@ -2378,12 +2371,9 @@ lemma delete_asid_pool_valid_arch_obsj[wp]: delete_asid_pool base pptr \\_. valid_arch_objs\" unfolding delete_asid_pool_def - apply (wp) - apply (wp modify_wp) - apply (strengthen valid_arch_objs_arm_asid_table_unmap) - apply simp - apply (rule hoare_vcg_conj_lift) - apply (wp mapM_wp' | simp)+ + apply (wp modify_wp) + apply (strengthen valid_arch_objs_arm_asid_table_unmap) + apply (wpsimp wp: mapM_wp')+ done crunch pspace_aligned[wp]: cap_swap_for_delete, set_cap, empty_slot "pspace_aligned" (ignore: empty_slot_ext wp: dxo_wp_weak) @@ -2407,14 +2397,8 @@ lemma restrict_eq_asn_none: "f(N := None) = f |` {s. s \ N}" by auto lemma delete_asid_valid_arch_objs[wp]: "\valid_arch_objs and pspace_aligned\ delete_asid a b \\_. valid_arch_objs\" unfolding delete_asid_def - apply (wp | wpc | simp)+ - apply (wp set_asid_pool_arch_objs_unmap'')[2] - apply (rule hoare_strengthen_post) - prefer 2 - apply (subst restrict_eq_asn_none) - apply simp - apply wp - apply fastforce + apply (wpsimp wp: set_asid_pool_arch_objs_unmap'') + apply (fastforce simp: restrict_eq_asn_none) done crunch valid_arch_objs[wp]: finalise_cap "valid_arch_objs" @@ -2491,17 +2475,11 @@ lemma mapM_x_swp_store_pde_reads_respects': lemma mapM_x_swp_store_pte_pas_refined_simple: "invariant (mapM_x (swp store_pte InvalidPTE) A) (pas_refined aag)" - apply (wp mapM_x_wp') - apply simp - apply (wp store_pte_pas_refined_simple) - done + by (wpsimp wp: mapM_x_wp' store_pte_pas_refined_simple) lemma mapM_x_swp_store_pde_pas_refined_simple: "invariant (mapM_x (swp store_pde InvalidPDE) A) (pas_refined aag)" - apply (wp mapM_x_wp') - apply simp - apply (wp store_pde_pas_refined_simple) - done + by (wpsimp wp: mapM_x_wp' store_pde_pas_refined_simple) end diff --git a/proof/infoflow/Decode_IF.thy b/proof/infoflow/Decode_IF.thy index 03f96c50b..e998331a5 100644 --- a/proof/infoflow/Decode_IF.thy +++ b/proof/infoflow/Decode_IF.thy @@ -93,21 +93,17 @@ lemma whenE_throwError_bindE_ev: shows "equiv_valid I A A P (whenE b (throwError x) >>=E (\_. f))" apply(rule_tac Q="\ rv s. \ b \ P s" in bindE_ev_pre) using ev apply(fastforce simp: equiv_valid_def2 equiv_valid_2_def) - apply(wp whenE_throwError_sp) + apply(wp whenE_throwError_sp)+ by simp -lemma hoare_vcg_imp_lift_R: - assumes "Q \ \ P \ f \ R \,-" - shows "\ \s. Q \ P s \ f \ \ rv s. Q \ R rv s \,-" - using assms - apply(fastforce simp: validE_R_def validE_def valid_def split: sum.splits) - done - lemma expand_len_gr_Suc_0: "Suc 0 < length xs = (xs \ [] \ Suc (Suc 0) \ length xs)" apply fastforce done +(* FIXME: remove *) +lemmas hoare_vcg_imp_lift_R = hoare_vcg_const_imp_lift_R + lemma decode_cnode_invocation_rev: "reads_equiv_valid_inv A aag (pas_refined aag and K (\c\{cap} \ set excaps. pas_cap_cur_auth aag c)) @@ -163,7 +159,7 @@ lemma slot_cap_long_running_delete_reads_respects_f: apply(wpc) apply(wp)[1] apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+ - apply(wp is_final_cap_reads_respects[where slot=slot and st=st])[2] + apply((wp is_final_cap_reads_respects[where slot=slot and st=st])+)[2] apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+ apply(wp is_final_cap_reads_respects[where st=st])[1] apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+ @@ -199,8 +195,7 @@ lemma check_valid_ipc_buffer_rev: lemma OR_choice_def2: "(\P. \P\ (c :: bool det_ext_monad) \\_.P\) \ empty_fail c \ (OR_choice c f g) = (do b \ c; if b then f else g od)" - apply (simp add: OR_choice_def wrap_ext_bool_det_ext_ext_def - ef_mk_ef) + apply (simp add: OR_choice_def wrap_ext_bool_det_ext_ext_def ef_mk_ef) by (subst no_state_changes[where f=c],simp,fastforce simp: bind_assoc split_def) lemma check_prio_rev: @@ -212,14 +207,13 @@ lemma check_prio_rev: lemma decode_set_priority_rev: "reads_respects aag l (is_subject aag \ cur_thread) (decode_set_priority args cap slot)" apply (clarsimp simp: decode_set_priority_def wp_ev) - apply (wp check_prio_rev) - by simp + by (wp check_prio_rev) + lemma decode_set_mcpriority_rev: "reads_respects aag l (is_subject aag \ cur_thread) (decode_set_mcpriority args cap slot)" apply (clarsimp simp: decode_set_mcpriority_def wp_ev) - apply (wp check_prio_rev) - by simp + by (wp check_prio_rev)+ lemma decode_tcb_invocation_reads_respects_f: notes respects_f = reads_respects_f[where st=st and Q=\] @@ -727,7 +721,9 @@ lemma decode_invocation_reads_respects_f: crunch globals_equiv: decode_invocation "globals_equiv st" -lemmas decode_invocation_reads_respects_f_g = reads_respects_f_g[OF decode_invocation_reads_respects_f doesnt_touch_globalsI, where Q="\", simplified, OF decode_invocation_globals_equiv] +lemmas decode_invocation_reads_respects_f_g = + reads_respects_f_g[OF decode_invocation_reads_respects_f doesnt_touch_globalsI, + where Q="\", simplified, OF decode_invocation_globals_equiv] end diff --git a/proof/infoflow/FinalCaps.thy b/proof/infoflow/FinalCaps.thy index 833e2615d..77439463a 100644 --- a/proof/infoflow/FinalCaps.thy +++ b/proof/infoflow/FinalCaps.thy @@ -1166,8 +1166,8 @@ lemma reply_cancel_ipc_silc_inv: "\silc_inv aag st and pas_refined aag and K (is_subject aag t) \ reply_cancel_ipc t \\_. silc_inv aag st\" - unfolding reply_cancel_ipc_def - apply (wp cap_delete_one_silc_inv select_wp hoare_vcg_if_lift | simp)+ + unfolding reply_cancel_ipc_def including no_pre + apply ((wp cap_delete_one_silc_inv select_wp hoare_vcg_if_lift)+ | simp)+ (* there must be a better way to do this... *) apply (clarsimp simp: valid_def) apply (rule conjI) @@ -1440,7 +1440,8 @@ lemma finalise_cap_ret: done lemma finalise_cap_ret_is_subject: - "\K ((is_cnode_cap cap \ is_thread_cap cap \ is_zombie cap) \ is_subject aag (obj_ref_of cap))\ finalise_cap cap is_final \\rv _. case (fst rv) of Zombie ptr bits n \ is_subject aag (obj_ref_of (fst rv)) | _ \ True\" + "\K ((is_cnode_cap cap \ is_thread_cap cap \ is_zombie cap) \ is_subject aag (obj_ref_of cap))\ finalise_cap cap is_final \\rv _. case (fst rv) of Zombie ptr bits n \ is_subject aag (obj_ref_of (fst rv)) | _ \ True\" + including no_pre apply(case_tac cap, simp_all add: is_zombie_def) apply(wp | simp add: comp_def | rule impI | rule conjI)+ apply(fastforce simp: valid_def dest: arch_finalise_cap_ret) @@ -1557,7 +1558,7 @@ next apply(simp add: rec_del.simps) apply(rule hoare_pre_spec_validE) apply(wp) - apply(rule drop_spec_validE, wp) + apply(rule drop_spec_validE, wp+) apply(simp add: split_def) apply(rule conjI | rule impI)+ apply(rule_tac P="pas_refined aag and K (is_subject aag (fst slot) \ (is_zombie (fst rvb) \ is_subject aag (obj_ref_of (fst rvb)) \ aag_cap_auth aag (pasObjectAbs aag (fst slot)) (fst rvb)))" in hoare_pre_spec_validE) @@ -1814,7 +1815,7 @@ lemma cap_revoke_silc_inv': show ?case apply(subst cap_revoke.simps) apply(rule hoare_pre_spec_validE) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply(wp spec_valid_conj_liftE2 | simp)+ apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_silc_inv]] cap_delete_silc_inv preemption_point_inv' | simp)+ apply(rule spec_valid_conj_liftE1) @@ -1825,7 +1826,7 @@ lemma cap_revoke_silc_inv': apply(rule spec_valid_conj_liftE1, (wp | simp)+) apply(rule spec_valid_conj_liftE1, (wp | simp)+) apply(rule drop_spec_validE[OF valid_validE[OF cap_delete_silc_inv]]) - apply (wp drop_spec_validE[OF assertE_wp] drop_spec_validE[OF without_preemption_wp] get_cap_wp select_wp drop_spec_validE[OF returnOk_wp]) + apply (wp drop_spec_validE[OF assertE_wp] drop_spec_validE[OF without_preemption_wp] get_cap_wp select_wp drop_spec_validE[OF returnOk_wp])+ apply clarsimp apply (clarsimp cong: conj_cong simp: conj_comms) apply (subst conj_commute) @@ -1880,7 +1881,7 @@ lemma invoke_cnode_silc_inv: apply(wp cap_delete_silc_inv | simp)+ apply(fastforce simp: authorised_cnode_inv_def) apply(rule hoare_pre) - apply(wp cap_move_silc_inv cap_swap_silc_inv cap_move_cte_wp_at_other | simp split del: if_splits)+ + apply(wp cap_move_silc_inv cap_swap_silc_inv cap_move_cte_wp_at_other | simp split del: if_split)+ apply(fastforce simp: silc_inv_def authorised_cnode_inv_def) apply(wp cap_move_silc_inv get_cap_wp | wpc | simp)+ apply(clarsimp simp: silc_inv_def authorised_cnode_inv_def) @@ -1924,7 +1925,7 @@ lemma retype_region_silc_inv: foldr_upd_app_if fun_app_def K_bind_def) apply(wp modify_wp dxo_wp_weak | simp)+ apply (simp add: trans_state_update[symmetric] del: trans_state_update) - apply wp + apply wp+ apply (clarsimp simp: not_less) apply (clarsimp simp add: silc_inv_def) apply (intro conjI impI allI) @@ -2582,9 +2583,8 @@ lemma invoke_irq_control_silc_inv: apply(case_tac blah) apply(wp cap_insert_silc_inv'' hoare_vcg_ex_lift slots_holding_overlapping_caps_lift | simp add: authorised_irq_ctl_inv_def)+ - apply(fastforce dest: new_irq_handler_caps_are_intra_label) - apply simp - apply(wp | simp)+ + apply(fastforce dest: new_irq_handler_caps_are_intra_label) + apply simp done @@ -2636,12 +2636,11 @@ lemma transfer_caps_silc_inv: apply (rule hoare_gen_asm) apply (simp add: transfer_caps_def) apply (wpc | wp)+ - apply (rule_tac P = "\x \ set dest_slots. is_subject aag (fst x)" in hoare_gen_asm) - apply (wp transfer_caps_loop_pres_dest cap_insert_silc_inv) - apply(fastforce simp: silc_inv_def) - apply(wp get_receive_slots_authorised hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+ - apply(fastforce elim: cte_wp_at_weakenE) - apply simp + apply (rule_tac P = "\x \ set dest_slots. is_subject aag (fst x)" in hoare_gen_asm) + apply (wp transfer_caps_loop_pres_dest cap_insert_silc_inv) + apply(fastforce simp: silc_inv_def) + apply(wp get_receive_slots_authorised hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+ + apply(fastforce elim: cte_wp_at_weakenE) done crunch silc_inv[wp]: copy_mrs, set_message_info "silc_inv aag st" @@ -2695,29 +2694,18 @@ lemma send_ipc_silc_inv: \\_. silc_inv aag st\" unfolding send_ipc_def apply (wp setup_caller_cap_silc_inv | wpc | simp)+ - apply(rename_tac xs word ys recv_state) - apply(rule_tac Q="\ r s. (can_grant \ is_subject aag thread \ is_subject aag (hd xs)) \ silc_inv aag st s" in hoare_strengthen_post) - apply simp - apply(wp do_ipc_transfer_silc_inv | wpc | simp)+ - apply(wp_once hoare_drop_imps) - apply (wp get_endpoint_wp) + apply(rename_tac xs word ys recv_state) + apply(rule_tac Q="\ r s. (can_grant \ is_subject aag thread \ is_subject aag (hd xs)) \ silc_inv aag st s" in hoare_strengthen_post) + apply simp + apply(wp do_ipc_transfer_silc_inv | wpc | simp)+ + apply(wp_once hoare_drop_imps) + apply (wp get_endpoint_wp)+ apply clarsimp apply(rule conjI) apply(fastforce simp: obj_at_def ep_q_refs_of_def) apply(clarsimp simp: valid_ep_recv_dequeue' obj_at_def) done -lemma hd_tl_in_set: - "tl xs = (x # xs') \ x \ set xs" - apply(case_tac xs, auto) - done - -lemma set_tl_subset: - "list \ [] \ set (tl list) \ set list" - apply(case_tac list) - apply auto - done - lemma receive_ipc_base_silc_inv: notes do_nbrecv_failed_transfer_def[simp] shows "\silc_inv aag st and valid_objs and valid_mdb and pas_refined aag and @@ -2927,22 +2915,21 @@ lemma invoke_tcb_silc_inv: Tcb_AI.tcb_inv_wf tinv and K (authorised_tcb_inv aag tinv)\ invoke_tcb tinv \\_. silc_inv aag st\" + including no_pre apply(case_tac tinv) - apply((wp restart_silc_inv hoare_vcg_if_lift suspend_silc_inv mapM_x_wp[OF _ subset_refl] static_imp_wp + apply((wp restart_silc_inv hoare_vcg_if_lift suspend_silc_inv mapM_x_wp[OF _ subset_refl] static_imp_wp | wpc | simp split del: if_split add: authorised_tcb_inv_def check_cap_at_def | clarsimp)+)[3] - defer - apply((wp suspend_silc_inv restart_silc_inv | simp add: authorised_tcb_inv_def)+)[2] + defer + apply((wp suspend_silc_inv restart_silc_inv | simp add: authorised_tcb_inv_def)+)[2] (* NotificationControl *) - apply (rename_tac option) - apply (case_tac option) - apply ((wp | simp)+)[2] + apply (rename_tac option) + apply (case_tac option) + apply ((wp | simp)+)[2] (* just ThreadControl left *) apply (simp add: split_def cong: option.case_cong) - apply (wp - - checked_cap_insert_silc_inv hoare_vcg_all_lift_R + apply (wp checked_cap_insert_silc_inv hoare_vcg_all_lift_R hoare_vcg_all_lift hoare_vcg_const_imp_lift_R cap_delete_silc_inv itr_wps(19) cap_insert_pas_refined cap_delete_pas_refined cap_delete_deletes @@ -2973,6 +2960,7 @@ lemma perform_invocation_silc_inv: and pas_refined aag and is_subject aag \ cur_thread\ perform_invocation block call iv \\_. silc_inv aag st\" + including no_pre apply(case_tac iv) apply(wp invoke_untyped_silc_inv send_ipc_silc_inv invoke_tcb_silc_inv invoke_cnode_silc_inv diff --git a/proof/infoflow/Finalise_IF.thy b/proof/infoflow/Finalise_IF.thy index 6fb7551ce..11efc5be5 100644 --- a/proof/infoflow/Finalise_IF.thy +++ b/proof/infoflow/Finalise_IF.thy @@ -62,10 +62,9 @@ lemma empty_slot_reads_respects: apply (simp add: bind_assoc empty_slot_ext_def cong: if_cong) apply(rule gen_asm_ev) apply (wp deleted_irq_handler_reads_respects set_cap_reads_respects set_original_reads_respects update_cdt_list_reads_respects | wpc | simp | (frule aag_can_read_self,fastforce simp: equiv_for_def split: option.splits))+ - apply (wp update_cdt_reads_respects get_cap_wp get_cap_rev) + apply (wp update_cdt_reads_respects get_cap_wp get_cap_rev)+ apply(intro impI allI conjI) - apply(fastforce simp: reads_equiv_def2 equiv_for_def elim: states_equiv_forE_cdt dest: aag_can_read_self split: option.splits)+ - done + apply(fastforce simp: reads_equiv_def2 equiv_for_def elim: states_equiv_forE_cdt dest: aag_can_read_self split: option.splits)+ done lemma requiv_get_tcb_eq': "\reads_equiv aag s t; aag_can_read aag thread\ \ @@ -124,9 +123,8 @@ lemma set_thread_state_ext_reads_respects: apply (simp add: equiv_valid_def2[symmetric] | wp)+ apply (clarsimp simp: reads_equiv_def) apply (subst equiv_valid_def2[symmetric]) - apply wp - apply force - apply (simp add: reads_equiv_def) + apply wp+ + apply force done lemma set_thread_state_reads_respects: @@ -468,7 +466,7 @@ lemma get_endpoint_revrv: unfolding get_endpoint_def apply(rule_tac Q="\ rv. ko_at rv epptr and pas_refined aag and valid_objs and sym_refs \ state_refs_of and (K ((pasSubject aag, Reset, pasObjectAbs aag epptr) \ pasPolicy aag))" in equiv_valid_rv_bind) apply(rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial]) - apply wp + apply wp+ apply(case_tac "\ ep. rv = Endpoint ep") apply(case_tac "\ ep. rv' = Endpoint ep") apply (clarsimp split: kernel_object.splits) @@ -483,35 +481,16 @@ lemma get_endpoint_revrv: lemma gen_asm_ev2_r: "\P' \ equiv_valid_2 I A B R P \ f f'\ \ equiv_valid_2 I A B R P (\s. P') f f'" - apply(fastforce simp: equiv_valid_2_def) - done + by (rule gen_asm_ev2_r') lemma gen_asm_ev2_l: "\P \ equiv_valid_2 I A B R \ P' f f'\ \ equiv_valid_2 I A B R (\s. P) P' f f'" - apply(fastforce simp: equiv_valid_2_def) - done - -(* -lemma scheduler_action_equiv_but_for_labels[simp]: "equiv_but_for_labels aag A (scheduler_action_update f st) (scheduler_action_update f s) = equiv_but_for_labels aag A st s" - apply (simp add: equiv_but_for_labels_def equiv_for_def equiv_asids_def equiv_asid_def) - done - -crunch equiv_but_for_labels[wp]: set_thread_state_ext "equiv_but_for_labels aag L st" -*) - -(* -lemma set_thread_state_equiv_but_for: - "invariant (set_thread_state ptr ts) (equiv_but_for_labels aag {pasObjectAbs aag ptr} st)" - unfolding set_thread_state_def - apply (wp set_object_equiv_but_for_labels hoare_drop_imps | simp | auto dest!: get_tcb_not_asid_pool_at)+ - done -*) + by (rule gen_asm_ev2_l') lemma bind_return_unit2: "f = return () >>= (\_. f)" - apply simp - done + by simp lemma mapM_x_ev2_invisible: assumes @@ -742,7 +721,7 @@ lemma tcb_sched_action_reads_respects: apply (rule set_tcb_queue_modifies_at_most) apply (simp | wp)+ apply (clarsimp simp: equiv_valid_2_def gets_apply_def get_def bind_def return_def labels_are_invisible_def) - apply wp + apply wp+ apply clarsimp apply (rule conjI, force) apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def) @@ -1428,7 +1407,7 @@ lemma suspend_reads_respects_f: (K (is_subject aag thread))) (suspend thread)" unfolding suspend_def apply(wp reads_respects_f[OF set_thread_state_owned_reads_respects, where st=st and Q="\"] reads_respects_f[OF tcb_sched_action_reads_respects, where st=st and Q=\] set_thread_state_pas_refined| simp)+ - apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv) + apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)+ apply(simp) done @@ -1938,18 +1917,13 @@ crunch globals_equiv[wp]: deleted_irq_handler "globals_equiv st" lemma transfer_caps_valid_ko_at_arm[wp]: "\ valid_ko_at_arm \ transfer_caps a b c d e \\_. valid_ko_at_arm\" unfolding transfer_caps_def - apply (wp | wpc)+ - apply (wp transfer_caps_loop_pres cap_insert_valid_ko_at_arm) - apply (simp) - done + by (wpsimp wp: transfer_caps_loop_pres cap_insert_valid_ko_at_arm) lemma empty_slot_globals_equiv: "\globals_equiv st and valid_ko_at_arm\ empty_slot s b\\_. globals_equiv st\" unfolding empty_slot_def - apply (wp set_cap_globals_equiv'' set_original_globals_equiv hoare_vcg_if_lift2 - set_cdt_globals_equiv dxo_wp_weak - hoare_drop_imps hoare_vcg_all_lift | wpc| simp)+ -done + by (wpsimp wp: set_cap_globals_equiv'' set_original_globals_equiv hoare_vcg_if_lift2 + set_cdt_globals_equiv dxo_wp_weak hoare_drop_imps hoare_vcg_all_lift) crunch globals_equiv: cap_delete_one "globals_equiv st" (wp: set_cap_globals_equiv'' hoare_drop_imps simp: crunch_simps unless_def) @@ -2021,8 +1995,7 @@ lemma mapM_x_swp_store_kernel_base_globals_equiv: apply (simp add: cte_wp_at_page_directory_not_in_globals cte_wp_at_page_directory_not_in_kernel_mappings not_in_global_not_arm - pde_ref_def - )+ + pde_ref_def)+ done end diff --git a/proof/infoflow/IRQMasks_IF.thy b/proof/infoflow/IRQMasks_IF.thy index 803f9debb..8d59f8f76 100644 --- a/proof/infoflow/IRQMasks_IF.thy +++ b/proof/infoflow/IRQMasks_IF.thy @@ -181,8 +181,7 @@ lemma cap_delete_irq_masks: "\ (\s. P (irq_masks_of_state s)) and domain_sep_inv False st\ cap_delete blah \\_ s. P (irq_masks_of_state s)\,\\_ s. P (irq_masks_of_state s)\" - apply(simp add: cap_delete_def | wp rec_del_irq_masks)+ - done + by (simp add: cap_delete_def) (wpsimp wp: rec_del_irq_masks) lemma invoke_irq_control_irq_masks: "\domain_sep_inv False st and irq_control_inv_valid invok\ @@ -297,7 +296,7 @@ lemma cap_revoke_irq_masks': show ?case apply(subst cap_revoke.simps) apply(rule hoare_pre_spec_validE) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply(wp spec_valid_conj_liftE2 | simp)+ apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_irq_masks]] drop_spec_validE[OF valid_validE[OF preemption_point_domain_sep_inv]] @@ -428,6 +427,7 @@ lemma handle_event_irq_masks: "\ (\s. P (irq_masks_of_state s)) and domain_sep_inv False st and invs\ handle_event ev \ \ rv s. P (irq_masks_of_state s) \" + including no_pre apply(case_tac ev) prefer 4 apply (rule hoare_pre) @@ -437,12 +437,10 @@ lemma handle_event_irq_masks: apply (wp | clarsimp)+ apply (rename_tac syscall) apply (case_tac syscall) - apply (simp add: handle_send_def handle_call_def - | wp handle_invocation_irq_masks[where st=st] handle_interrupt_irq_masks[where st=st] hoare_vcg_all_lift + apply (simp add: handle_send_def handle_call_def + | wp handle_invocation_irq_masks[where st=st] handle_interrupt_irq_masks[where st=st] hoare_vcg_all_lift | wpc - | wp_once hoare_drop_imps)+ - - + | wp_once hoare_drop_imps)+ done crunch irq_masks[wp]: activate_thread "\s. P (irq_masks_of_state s)" @@ -456,11 +454,11 @@ lemma call_kernel_irq_masks: \ \ rv s. P (irq_masks_of_state s) \" apply(simp add: call_kernel_def) apply (wp handle_interrupt_irq_masks[where st=st])+ - apply (rule_tac Q="\rv s. P (irq_masks_of_state s) \ domain_sep_inv False st s \ (\x. rv = Some x \ x \ maxIRQ)" in hoare_strengthen_post) - apply (wp | simp)+ - apply(rule_tac Q="\ x s. P (irq_masks_of_state s) \ domain_sep_inv False st s" and F="E" for E in hoare_post_impErr) - apply(rule valid_validE) - apply(wp handle_event_irq_masks[where st=st] valid_validE[OF handle_event_domain_sep_inv] | simp)+ + apply (rule_tac Q="\rv s. P (irq_masks_of_state s) \ domain_sep_inv False st s \ (\x. rv = Some x \ x \ maxIRQ)" in hoare_strengthen_post) + apply (wp | simp)+ + apply(rule_tac Q="\ x s. P (irq_masks_of_state s) \ domain_sep_inv False st s" and F="E" for E in hoare_post_impErr) + apply(rule valid_validE) + apply(wp handle_event_irq_masks[where st=st] valid_validE[OF handle_event_domain_sep_inv] | simp)+ done end diff --git a/proof/infoflow/InfoFlow.thy b/proof/infoflow/InfoFlow.thy index f7d1162b7..c383e940d 100644 --- a/proof/infoflow/InfoFlow.thy +++ b/proof/infoflow/InfoFlow.thy @@ -1398,7 +1398,7 @@ lemma do_machine_op_rev: apply(clarsimp simp: select_f_def equiv_valid_2_def) apply(insert equiv_dmo, clarsimp simp: equiv_valid_def2 equiv_valid_2_def)[1] apply(blast) - apply(wp select_f_inv) + apply(wp select_f_inv)+ apply(fastforce simp: select_f_def dest: state_unchanged[OF mo_inv])+ done diff --git a/proof/infoflow/Ipc_IF.thy b/proof/infoflow/Ipc_IF.thy index 4234f4f01..8758538dd 100644 --- a/proof/infoflow/Ipc_IF.thy +++ b/proof/infoflow/Ipc_IF.thy @@ -223,7 +223,7 @@ lemma set_thread_state_ext_runnable_equiv_but_for_labels: apply (simp add: set_thread_state_ext_def) apply wp apply (rule hoare_pre_cont) - apply (wp gts_wp) + apply (wp gts_wp)+ apply (force simp: st_tcb_at_def obj_at_def) done @@ -233,7 +233,7 @@ lemma set_thread_state_runnable_equiv_but_for_labels: \\_. equiv_but_for_labels aag L st\" unfolding set_thread_state_def apply (wp set_object_equiv_but_for_labels set_thread_state_ext_runnable_equiv_but_for_labels | simp add: split_def)+ - apply (simp add: set_object_def, wp) + apply (simp add: set_object_def, wp+) apply (fastforce dest: get_tcb_not_asid_pool_at simp: st_tcb_at_def obj_at_def) done @@ -266,8 +266,8 @@ lemma possible_switch_to_equiv_but_for_labels: \\_. equiv_but_for_labels aag L st\" apply (simp add: possible_switch_to_def) apply (wp tcb_sched_action_equiv_but_for_labels) - apply (rule hoare_pre_cont) - apply wp + apply (rule hoare_pre_cont) + apply wp+ apply (clarsimp simp: etcb_at_def split: option.splits) done @@ -436,9 +436,9 @@ lemma sts_noop: apply (rule_tac x="tcb_state (the (get_tcb tcb x))" in monadic_rewrite_symb_exec) apply (wp gts_wp | simp)+ apply (rule monadic_rewrite_symb_exec) - apply wp + apply wp+ apply (rule monadic_rewrite_symb_exec) - apply wp + apply wp+ apply (simp only: when_def) apply (rule monadic_rewrite_trans) apply (rule monadic_rewrite_if) @@ -530,7 +530,7 @@ lemma cancel_ipc_to_blocked_nosts: apply (simp add: modify_modify) apply (rule monadic_rewrite_refl2) apply (fastforce simp add: simpler_modify_def o_def get_tcb_def) - apply (wp gts_wp) + apply (wp gts_wp)+ apply (simp add: set_thread_state_def bind_assoc gets_the_def) apply (clarsimp simp add: pred_tcb_at_def receive_blocked_def obj_at_def is_tcb_def split: thread_state.splits) by (case_tac "tcb_state tcba";fastforce) @@ -1337,7 +1337,7 @@ lemma mapM_ev''': shows "equiv_valid_inv D A (\ s. Q s \ (\x\set lst. P x s)) (mapM m lst)" apply(rule mapM_ev) apply(rule equiv_valid_guard_imp[OF reads_res], simp+) - apply(wp inv, simp) + apply(wpsimp wp: inv) done lemma cancel_badged_sends_reads_respects: @@ -2117,7 +2117,7 @@ next apply(wp) apply(erule conjE, erule subst, rule Cons.hyps) apply(clarsimp) - apply(wp set_extra_badge_globals_equiv) + apply(wp set_extra_badge_globals_equiv)+ apply(rule Cons.hyps) apply(simp) apply(wp cap_insert_globals_equiv'') @@ -2127,7 +2127,7 @@ next apply(simp add: whenE_def, rule conjI) apply(rule impI, wp)+ apply(simp)+ - apply wp + apply wp+ apply(fastforce) done qed @@ -2144,12 +2144,12 @@ lemma copy_mrs_globals_equiv: "\globals_equiv s and valid_ko_at_arm and (\s. receiver \ idle_thread s)\ copy_mrs sender sbuf receiver rbuf n \\_. globals_equiv s\" - unfolding copy_mrs_def + unfolding copy_mrs_def including no_pre apply(wp | wpc)+ apply(rule_tac Q="\_. globals_equiv s" in hoare_strengthen_post) apply(wp mapM_wp' | wpc)+ - apply(wp store_word_offs_globals_equiv) + apply(wp store_word_offs_globals_equiv)+ apply fastforce apply simp apply(rule_tac Q="\_. globals_equiv s and valid_ko_at_arm and (\sa. receiver \ idle_thread sa)" @@ -2183,8 +2183,6 @@ lemma do_normal_transfer_globals_equiv: - - lemma do_fault_transfer_globals_equiv: "\globals_equiv s and valid_ko_at_arm and (\sa. receiver \ idle_thread sa)\ @@ -2231,7 +2229,7 @@ lemma do_ipc_transfer_globals_equiv: and pspace_distinct and pspace_aligned and valid_global_objs and (\s. receiver \ idle_thread s)\ do_ipc_transfer sender ep badge grant receiver \\_. globals_equiv st\" - unfolding do_ipc_transfer_def + unfolding do_ipc_transfer_def including no_pre apply(wp do_normal_transfer_globals_equiv do_fault_transfer_globals_equiv | wpc)+ apply(rule_tac Q="\_. globals_equiv st and valid_ko_at_arm and valid_global_objs and (\sa. receiver \ idle_thread sa) and @@ -2260,10 +2258,10 @@ lemma send_ipc_globals_equiv: apply(fastforce) apply(wp set_thread_state_globals_equiv dxo_wp_weak | simp)+ apply wpc - apply(wp do_ipc_transfer_globals_equiv) + apply(wp do_ipc_transfer_globals_equiv)+ apply(clarsimp) apply(rule hoare_drop_imps) - apply(wp set_endpoint_globals_equiv) + apply(wp set_endpoint_globals_equiv)+ apply(rule_tac Q="\ep. ko_at (Endpoint ep) epptr and globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned and valid_global_objs and (\s. sym_refs (state_refs_of s)) and valid_idle" @@ -2274,17 +2272,8 @@ lemma send_ipc_globals_equiv: apply(rule valid_ep_recv_dequeue') apply(simp)+ apply (frule_tac x=xa in receive_endpoint_threads_blocked,simp+) - by (clarsimp simp add: valid_idle_def pred_tcb_at_def obj_at_def) + by (clarsimp simp add: valid_idle_def pred_tcb_at_def obj_at_def)+ -lemma valid_ep_recv_dequeue': - "\ ko_at (Endpoint (Structures_A.endpoint.RecvEP (t # ts))) epptr s; - valid_objs s\ - \ valid_ep (case ts of [] \ Structures_A.endpoint.IdleEP - | b # bs \ Structures_A.endpoint.RecvEP ts) s" - unfolding valid_objs_def valid_obj_def valid_ep_def obj_at_def - apply (drule bspec) - apply (auto split: list.splits) - done lemma valid_ep_send_enqueue: "\ko_at (Endpoint (SendEP (t # ts))) a s; valid_objs s\ \ valid_ep (case ts of [] \ IdleEP | b # bs \ SendEP (b # bs)) s" @@ -2302,7 +2291,7 @@ lemma receive_ipc_globals_equiv: and pspace_aligned and valid_global_objs and (\s. thread \ idle_thread s)\ receive_ipc thread cap is_blocking \\_. globals_equiv st\" - unfolding receive_ipc_def thread_get_def + unfolding receive_ipc_def thread_get_def including no_pre apply(wp) apply(simp add: split_def) apply(wp set_endpoint_globals_equiv set_thread_state_globals_equiv @@ -2315,18 +2304,17 @@ lemma receive_ipc_globals_equiv: apply (wp gts_wp get_endpoint_sp | wpc)+ apply (wp hoare_vcg_all_lift hoare_drop_imps)[1] apply(wp set_endpoint_globals_equiv | wpc)+ - apply(wp set_thread_state_globals_equiv) - apply (wp get_ntfn_wp gbn_wp get_endpoint_wp as_user_globals_equiv | wpc | simp)+ + apply(wp set_thread_state_globals_equiv) + apply (wp get_ntfn_wp gbn_wp get_endpoint_wp as_user_globals_equiv | wpc | simp)+ apply (rule hoare_pre) apply(wpc) apply(rule fail_wp | rule return_wp)+ by (auto intro: valid_arch_state_ko_at_arm valid_ep_send_enqueue simp: neq_Nil_conv cong: case_list_cons_cong) + subsection "Notifications" - - lemma valid_ntfn_dequeue: "\ ko_at (Notification ntfn) ntfnptr s; ntfn_obj ntfn = (WaitingNtfn (t # ts)); valid_objs s; ts \ []\ @@ -2464,27 +2452,27 @@ lemma send_ipc_valid_global_objs: \\_. valid_global_objs\" unfolding send_ipc_def apply(wp | wpc)+ - apply(rule_tac Q="\_. valid_global_objs" in hoare_strengthen_post) - apply(wp, simp, (wp dxo_wp_weak |simp)+) - apply(wpc) - apply(rule fail_wp | rule return_wp | wp)+ - apply(simp) - apply(rule hoare_drop_imps) - apply(wp) - apply(rule_tac Q="\_. valid_global_objs" in hoare_strengthen_post) - apply(wp, simp) - done + apply(rule_tac Q="\_. valid_global_objs" in hoare_strengthen_post) + apply(wp, simp, (wp dxo_wp_weak |simp)+) + apply(wpc) + apply(rule fail_wp | rule return_wp | wp)+ + apply(simp) + apply(rule hoare_drop_imps) + apply(wp)+ + apply(rule_tac Q="\_. valid_global_objs" in hoare_strengthen_post) + apply(wp, simp+) + done lemma send_fault_ipc_valid_global_objs: "\valid_global_objs \ send_fault_ipc tptr fault \\_. valid_global_objs\" unfolding send_fault_ipc_def apply(wp) - apply(simp add: Let_def) - apply(wp send_ipc_valid_global_objs | wpc)+ - apply(rule_tac Q'="\_. valid_global_objs" in hoare_post_imp_R) - apply(wp | simp)+ - done + apply(simp add: Let_def) + apply(wp send_ipc_valid_global_objs | wpc)+ + apply(rule_tac Q'="\_. valid_global_objs" in hoare_post_imp_R) + apply(wp | simp)+ + done crunch valid_ko_at_arm[wp]: send_ipc "valid_ko_at_arm" (wp: hoare_drop_imps hoare_vcg_if_lift2 dxo_wp_weak diff --git a/proof/infoflow/Noninterference.thy b/proof/infoflow/Noninterference.thy index 9896c8591..9a8b6a095 100644 --- a/proof/infoflow/Noninterference.thy +++ b/proof/infoflow/Noninterference.thy @@ -391,7 +391,7 @@ lemma kernel_entry_if_integrity: | simp add: tcb_cap_cases_def schact_is_rct_def arch_tcb_update_aux2)+ apply(wp_once prop_of_two_valid[where f="ct_active" and g="cur_thread"]) apply (wp | simp)+ - apply(wp thread_set_tcb_context_update_wp) + apply(wp thread_set_tcb_context_update_wp)+ apply(clarsimp simp: schact_is_rct_def) apply(rule conjI) apply(erule integrity_update_reference_state[where blah="the (kheap st (cur_thread st))", OF _ integrity_refl]) @@ -634,7 +634,7 @@ lemma schedule_cur_domain: \\ r s. P (cur_domain s)\" apply(simp add: schedule_def | wp | wpc)+ apply(rule hoare_pre_cont) - apply wp + apply wp+ apply(rule_tac Q="\rv s. P (cur_domain s) \ domain_time s \ 0" in hoare_strengthen_post) apply(simp split del: if_split | wp gts_wp | wp_once hoare_drop_imps)+ apply clarsimp @@ -646,7 +646,7 @@ lemma schedule_domain_fields: \\ r. domain_fields P\" apply(simp add: schedule_def | wp | wpc)+ apply(rule hoare_pre_cont) - apply wp + apply wp+ apply(rule_tac Q="\rv s. domain_fields P s \ domain_time s \ 0" in hoare_strengthen_post) apply(simp split del: if_split | wp gts_wp | wp_once hoare_drop_imps)+ apply clarsimp @@ -2084,7 +2084,7 @@ lemma tcb_sched_action_reads_respects_g': apply (rule set_tcb_queue_modifies_at_most) apply (rule doesnt_touch_globalsI | simp | wp)+ apply (clarsimp simp: equiv_valid_2_def gets_apply_def get_def bind_def return_def labels_are_invisible_def) - apply wp + apply wp+ apply clarsimp apply (rule conjI, force) apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def) @@ -2099,11 +2099,12 @@ lemma switch_to_thread_reads_respects_g: apply(subst bind_assoc[symmetric]) apply(rule equiv_valid_guard_imp) apply(rule bind_ev) - apply (wp bind_ev_general cur_thread_update_reads_respects_g' tcb_sched_action_reads_respects_g' arch_switch_to_thread_reads_respects_g')[1] + apply (wp bind_ev_general cur_thread_update_reads_respects_g' tcb_sched_action_reads_respects_g' + arch_switch_to_thread_reads_respects_g') apply(simp add: equiv_valid_def2) apply(rule_tac R'="\\" in equiv_valid_2_bind) apply(rule assert_ev2 | simp)+ - apply(rule equiv_valid_rv_trivial, wp) + apply(rule equiv_valid_rv_trivial, wp+) apply fastforce done @@ -2237,7 +2238,7 @@ lemma schedule_reads_respects_g: get_thread_state_reads_respects_g | wpc | simp)+ apply(wp_once hoare_drop_imps) - apply(wp get_thread_state_reads_respects_g gts_wp) + apply(wp get_thread_state_reads_respects_g gts_wp)+ apply(clarsimp simp: invs_valid_idle) by(fastforce intro: requiv_g_cur_thread_eq simp: reads_equiv_g_def reads_equiv_def globals_equiv_idle_thread_ptr dest: scheduler_action_switch_thread_is_subject simp: not_cur_thread_2_def st_tcb_at_def obj_at_def valid_sched_2_def) @@ -2539,6 +2540,7 @@ lemma do_user_op_A_if_confidentiality: (t_aux,yy,fst t') \ do_user_op_A_if utf; snd s' = f xx; snd t' = f yy\ \ xx = yy \ (s', t') \ uwr u \ (s', t') \ uwr PSched \ (s', t') \ uwr (part s)" + including no_pre apply(frule (1) uwr_part_sys_mode_of_user_context_of_eq) apply(clarsimp simp: check_active_irq_A_if_def) apply(case_tac s, case_tac t, simp_all) @@ -2551,7 +2553,7 @@ lemma do_user_op_A_if_confidentiality: apply (clarsimp dest!: invs_if_Invs simp: Invs_def) apply (drule uwr_PSched_cur_domain) apply (clarsimp dest!: invs_if_Invs simp: Invs_def) - apply(clarsimp simp: current_aag_def) + subgoal by(clarsimp simp: current_aag_def) apply simp apply fastforce apply(simp add: do_user_op_A_if_def | elim exE conjE)+ diff --git a/proof/infoflow/PasUpdates.thy b/proof/infoflow/PasUpdates.thy index 137aed17d..d1a2a1c27 100644 --- a/proof/infoflow/PasUpdates.thy +++ b/proof/infoflow/PasUpdates.thy @@ -23,42 +23,27 @@ crunch idle_thread[wp]: preemption_point "\s::det_state. P (idle_thread crunch idle_thread[wp]: cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_delete,cancel_badged_sends "\s::det_state. P (idle_thread s)" (wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation modify_wp dxo_wp_weak simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke) -lemma cap_revoke_idle_thread[wp]:"\\s::det_state. P (idle_thread s)\ cap_revoke a \\r s. P (idle_thread s)\" - apply (rule cap_revoke_preservation2) - apply wp - done - - -lemma invoke_cnode_idle_thread[wp]: "\\s::det_state. P (idle_thread s)\ invoke_cnode a \\r s. P (idle_thread s)\" - apply (simp add: invoke_cnode_def) - apply (rule hoare_pre) - apply (wp | wpc | clarsimp simp: without_preemption_def crunch_simps | intro impI conjI | wp_once hoare_drop_imps hoare_vcg_all_lift)+ - done - crunch idle_thread[wp]: handle_event "\s::det_state. P (idle_thread s)" (wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation dxo_wp_weak simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke resetTimer ackInterrupt getFAR getDFSR getIFSR getActiveIRQ) - - abbreviation (input) domain_fields where "domain_fields P s \ P (domain_time s) (domain_index s) (domain_list s)" lemma preemption_point_domain_fields[wp]: "\domain_fields P\ preemption_point \\_. domain_fields P\" - apply(simp add: preemption_point_def | wp OR_choiceE_weak_wp modify_wp | wpc | simp add: reset_work_units_def update_work_units_def)+ - done + by (simp add: preemption_point_def + | wp OR_choiceE_weak_wp modify_wp + | wpc + | simp add: reset_work_units_def update_work_units_def)+ crunch domain_fields[wp]: retype_region_ext,create_cap_ext,cap_insert_ext,ethread_set,cap_move_ext,empty_slot_ext,cap_swap_ext,set_thread_state_ext,tcb_sched_action,reschedule_required,cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_delete,cancel_badged_sends,cap_insert "domain_fields P" (wp: syscall_valid select_wp crunch_wps rec_del_preservation cap_revoke_preservation modify_wp simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke) lemma cap_revoke_domain_fields[wp]:"\domain_fields P\ cap_revoke a \\_. domain_fields P\" - apply (rule cap_revoke_preservation2) - apply wp - done - + by (rule cap_revoke_preservation2; wp) lemma invoke_cnode_domain_fields[wp]: "\domain_fields P\ invoke_cnode a \\_. domain_fields P\" - apply (simp add: invoke_cnode_def) - apply (rule hoare_pre) - apply (wp | wpc | clarsimp simp: without_preemption_def crunch_simps | intro impI conjI | wp_once hoare_drop_imps hoare_vcg_all_lift)+ - done + unfolding invoke_cnode_def + by (wpsimp simp: without_preemption_def crunch_simps + wp: get_cap_wp hoare_vcg_all_lift hoare_vcg_imp_lift + | rule conjI)+ crunch domain_fields[wp]: set_domain,set_priority,switch_if_required_to,set_extra_badge,attempt_switch_to,handle_send,handle_recv,handle_reply "domain_fields P" (wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation @@ -68,7 +53,6 @@ crunch domain_fields[wp]: set_domain,set_priority,switch_if_required_to,set_extr crunch cur_domain[wp]: transfer_caps_loop, ethread_set, thread_set_priority, set_priority, set_domain, invoke_domain, cap_move_ext,timer_tick, cap_move,cancel_badged_sends, attempt_switch_to, switch_if_required_to - "\s. P (cur_domain s)" (wp: transfer_caps_loop_pres crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM const_on_failure ) lemma invoke_cnode_cur_domain[wp]: "\\s. P (cur_domain s)\ invoke_cnode a \\r s. P (cur_domain s)\" diff --git a/proof/infoflow/Retype_IF.thy b/proof/infoflow/Retype_IF.thy index cfbea1577..d9d0d217c 100644 --- a/proof/infoflow/Retype_IF.thy +++ b/proof/infoflow/Retype_IF.thy @@ -326,17 +326,13 @@ lemma get_pde_rev: "reads_equiv_valid_inv A aag (K (is_subject aag (ptr && ~~ mask pd_bits))) (get_pde ptr)" unfolding get_pde_def fun_app_def - apply(wp get_pd_rev) - apply(clarsimp) - done + by (wp get_pd_rev) lemma get_pde_revg: "reads_equiv_valid_g_inv A aag (\ s. (ptr && ~~ mask pd_bits) = arm_global_pd (arch_state s)) (get_pde ptr)" unfolding get_pde_def fun_app_def - apply(wp get_pd_revg) - apply(clarsimp) - done + by (wp get_pd_revg) lemma copy_global_mappings_reads_respects_g: "is_aligned x pd_bits \ @@ -564,7 +560,7 @@ lemma copy_global_mappings_globals_equiv: "\ globals_equiv s and (\ s. x \ arm_global_pd (arch_state s) \ is_aligned x pd_bits)\ copy_global_mappings x \ \_. globals_equiv s \" - unfolding copy_global_mappings_def + unfolding copy_global_mappings_def including no_pre apply simp apply wp apply(rule_tac Q="\_. globals_equiv s and (\ s. x \ arm_global_pd (arch_state s) \ is_aligned x pd_bits)" in hoare_strengthen_post) @@ -1304,7 +1300,7 @@ lemma reset_untyped_cap_globals_equiv: apply (clarsimp simp: reset_chunk_bits_def) apply (strengthen invs_valid_global_objs) apply (wp delete_objects_invs_ex - hoare_vcg_const_imp_lift get_cap_wp) + hoare_vcg_const_imp_lift get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state descendants_range_def2 is_cap_simps bits_of_def diff --git a/proof/infoflow/Scheduler_IF.thy b/proof/infoflow/Scheduler_IF.thy index 54dede0d0..d5adf98b7 100644 --- a/proof/infoflow/Scheduler_IF.thy +++ b/proof/infoflow/Scheduler_IF.thy @@ -423,7 +423,7 @@ lemma tcb_action_reads_respects_scheduler[wp]: "reads_respects_scheduler aag l ( ) apply (rule ext) apply clarsimp - apply wp + apply wp+ apply (clarsimp simp add: etcb_at_def split: option.splits) apply (frule(1) tcb_domain_wellformed) apply simp @@ -456,7 +456,7 @@ lemma dmo_no_mem_globals_equiv_scheduler: done lemma clearExMonitor_globals_equiv_scheduler[wp]: "\ globals_equiv_scheduler sta \ do_machine_op clearExMonitor \ \_. globals_equiv_scheduler sta \" - unfolding clearExMonitor_def + unfolding clearExMonitor_def including no_pre apply (wp dmo_no_mem_globals_equiv_scheduler) apply simp apply (simp add: simpler_modify_def valid_def) @@ -465,7 +465,7 @@ lemma clearExMonitor_globals_equiv_scheduler[wp]: "\ globals_equiv_sched lemma arch_switch_to_thread_globals_equiv_scheduler: "\invs and globals_equiv_scheduler sta\ arch_switch_to_thread thread \\_. globals_equiv_scheduler sta\" - unfolding arch_switch_to_thread_def storeWord_def + unfolding arch_switch_to_thread_def storeWord_def including no_pre apply (wp clearExMonitor_globals_equiv_scheduler dmo_wp modify_wp thread_get_wp') apply (rule_tac Q="\r s. invs s \ globals_equiv_scheduler sta s" in hoare_strengthen_post) apply wp @@ -648,14 +648,10 @@ lemma [wp]: "\\s. P (irq_state_of_state s)\ do_machine_o done lemma [wp]: "\\s. P (irq_state_of_state s)\ do_machine_op clearExMonitor \\_ s. P (irq_state_of_state s)\" - apply (rule hoare_pre) - apply (wp dmo_wp irq_state_clearExMonitor | simp)+ - done + by (wpsimp wp: dmo_wp irq_state_clearExMonitor) lemma [wp]: "\ scheduler_equiv aag st \ do_machine_op clearExMonitor \ \_. scheduler_equiv aag st \" - apply (rule scheduler_equiv_lift) - apply wp - done + by (rule scheduler_equiv_lift; wp) lemma dmo_ev: "(\s s'. equiv_valid (\ms ms'. I (s\machine_state := ms\) (s'\machine_state := ms'\)) @@ -840,10 +836,11 @@ lemma arch_switch_to_thread_globals_equiv_scheduler': "\invs and globals_equiv_scheduler sta\ set_vm_root t \\_. globals_equiv_scheduler sta\" + including no_pre apply (rule_tac Q="\r s. invs s \ globals_equiv_scheduler sta s" in hoare_strengthen_post) apply wp apply (rule globals_equiv_scheduler_inv') - apply (wp set_vm_root_globals_equiv) + apply (wp set_vm_root_globals_equiv)+ apply clarsimp+ done @@ -1105,7 +1102,7 @@ lemma switch_to_idle_thread_midstrength_reads_respects_scheduler[wp]: "midstreng apply (simp add: arch_switch_to_idle_thread_def bind_assoc) apply (rule bind_ev_general) apply (rule store_cur_thread_midstrength_reads_respects) - apply wp + apply wp+ apply (clarsimp simp add: scheduler_equiv_def domain_fields_equiv_def globals_equiv_scheduler_def) done @@ -1119,9 +1116,7 @@ lemma gets_read_queue_reads_respects_scheduler[wp]: "weak_reads_respects_schedul lemma gets_ready_queue_midstrength_equiv_scheduler[wp]: "equiv_valid_inv (scheduler_equiv aag) (midstrength_scheduler_affects_equiv aag l) (\s. pasDomainAbs aag d \ reads_scheduler aag l) (gets (\s. ready_queues s d))" - apply (rule weak_reads_respects_scheduler_to_midstrength) - apply wp - done + by (rule weak_reads_respects_scheduler_to_midstrength; wp) lemma gets_cur_domain_reads_respects_scheduler[wp]: "equiv_valid (scheduler_equiv aag) A A \ (gets cur_domain)" apply (rule equiv_valid_guard_imp) @@ -1162,7 +1157,7 @@ lemma choose_thread_reads_respects_scheduler_cur_domain: "midstrength_reads_resp apply (rule if_ev_bind) apply (rule switch_to_idle_thread_midstrength_reads_respects_scheduler) apply (rule guarded_switch_to_thread_midstrength_reads_respects_scheduler) - apply wp + apply wp+ apply clarsimp apply (erule any_valid_thread) apply (frule(1) tcb_with_domain_at) @@ -1331,7 +1326,7 @@ lemma next_domain_snippit: "reads_respects_scheduler aag l (invs and pas_refined apply (rule ev_weaken_pre_relation) apply wp apply fastforce - apply (wp next_domain_valid_queues) + apply (wp next_domain_valid_queues)+ apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def) done @@ -1437,7 +1432,8 @@ lemma reads_respects_scheduler_invisible_domain_switch: "reads_respects_schedule apply (simp add: equiv_valid_def2) apply (rule equiv_valid_rv_bind[where W=dc]) apply (rule equiv_valid_dc) - apply wp[2] + apply wp + apply wp apply (rule equiv_valid_2_bind_pre[where R'=dc]) apply (rule equiv_valid_2_bind_pre[where R'="op ="]) apply simp @@ -1455,26 +1451,27 @@ lemma reads_respects_scheduler_invisible_domain_switch: "reads_respects_schedule in equiv_valid_2_unobservable) apply wp apply (rule scheduler_equiv_lift) - apply wp + apply wp+ apply simp apply clarsimp apply wp apply (wp tcb_sched_action_unobservable) apply clarsimp - apply (wp scheduler_equiv_lift) + apply (wp scheduler_equiv_lift)+ apply (wp | simp)+ - apply (wp tcb_sched_action_unobservable) + apply (wp tcb_sched_action_unobservable)+ apply simp apply (fastforce+)[2] - apply wp + apply wp+ apply (force+)[2] apply (rule equiv_valid_2) apply (rule ev_gets_const) - apply wp + apply wp+ apply (force+)[2] apply (rule equiv_valid_dc) - apply wp[2] - apply (wp gts_wp) + apply wp + apply wp + apply (wp gts_wp)+ apply (force+)[2] apply wp apply clarsimp @@ -1495,10 +1492,10 @@ lemma schedule_no_domain_switch: "\(\s. domain_time s \ 0 apply (simp add: schedule_def) apply (wp | wpc)+ apply (rule hoare_pre_cont) - apply wp + apply wp+ apply simp apply wps - apply (wp gts_wp) + apply (wp gts_wp)+ apply clarsimp done @@ -1506,10 +1503,10 @@ lemma schedule_no_domain_fields: "\(\s. domain_time s \ 0 apply (simp add: schedule_def) apply (wp | wpc)+ apply (rule hoare_pre_cont) - apply wp + apply wp+ apply simp apply wps - apply (wp gts_wp) + apply (wp gts_wp)+ apply clarsimp done @@ -1537,10 +1534,9 @@ lemma choose_thread_unobservable: "\(\s. pasDomainAbs aag (cur_d apply simp done -lemma tcb_sched_action_scheduler_equiv[wp]: "\scheduler_equiv aag st\ tcb_sched_action f a\\_. scheduler_equiv aag st\" - apply (rule scheduler_equiv_lift) - apply wp - done +lemma tcb_sched_action_scheduler_equiv[wp]: + "\scheduler_equiv aag st\ tcb_sched_action f a\\_. scheduler_equiv aag st\" + by (rule scheduler_equiv_lift; wp) lemma cur_thread_cur_domain: "st_tcb_at (op = st) (cur_thread s) s \ \ idle st \ invs s \ guarded_pas_domain aag s \ pasObjectAbs aag (cur_thread s) = pasDomainAbs aag (cur_domain s)" @@ -1600,11 +1596,11 @@ lemma schedule_reads_respects_scheduler_cur_domain: "reads_respects_scheduler aa apply (rule ev_weaken_pre_relation) apply (rule guarded_switch_to_thread_midstrength_reads_respects_scheduler) apply fastforce - apply (wp when_ev)[2] + apply ((wp when_ev)+)[2] apply (rule bind_ev) apply simp apply (rule next_domain_snippit) - apply (wp_trace when_ev gts_wp get_thread_state_reads_respects_scheduler) + apply (wp_trace when_ev gts_wp get_thread_state_reads_respects_scheduler)+ apply (clarsimp simp: reads_lrefl) apply (intro impI conjI allI) apply (simp add: guarded_pas_domain_def) @@ -1956,12 +1952,12 @@ lemma ackInterrupt_reads_respects_scheduler: apply clarsimp apply ((wp silc_dom_lift dmo_wp | simp)+)[5] apply (rule scheduler_affects_equiv_unobservable) - apply (simp add: states_equiv_for_def[abs_def] equiv_for_def equiv_asids_def - equiv_asid_def) - apply (rule hoare_pre) - apply wps - apply (wp dmo_wp | simp add:ackInterrupt_def)+ - apply (wp mol_exclusive_state) + apply (simp add: states_equiv_for_def[abs_def] equiv_for_def equiv_asids_def equiv_asid_def) + apply (rule hoare_pre) + apply wps + apply (wp dmo_wp | simp add:ackInterrupt_def)+ + apply (wp mol_exclusive_state) + apply assumption done @@ -2009,14 +2005,7 @@ lemma dmo_distr: "do_machine_op (f >>= g) = ((do_machine_op f) >>= (\x. bind_def get_def return_def) apply (rule ext) apply safe - apply clarsimp - apply force - apply clarsimp - apply force - apply clarsimp - apply force - apply clarsimp - apply force + apply ((clarsimp, force)+)[5] apply (simp add: image_def) done @@ -2371,8 +2360,6 @@ lemma context_update_cur_thread_snippit: "equiv_valid_2 (scheduler_equiv aag) (s apply ((fastforce)+)[2] apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def) done - - lemma equiv_valid_2E: diff --git a/proof/infoflow/Syscall_IF.thy b/proof/infoflow/Syscall_IF.thy index 6d9a6d0db..652193831 100644 --- a/proof/infoflow/Syscall_IF.thy +++ b/proof/infoflow/Syscall_IF.thy @@ -419,7 +419,7 @@ lemma sts_authorised_for_globals_inv: "\authorised_for_globals_inv oper\ apply (rename_tac page_table_invocation) apply (case_tac page_table_invocation) apply simp+ - apply (wp set_thread_state_arm_global_pd) + apply (wp set_thread_state_arm_global_pd)+ apply simp apply wp apply simp @@ -519,7 +519,7 @@ lemma handle_invocation_reads_respects_g: | intro impI conjI | erule conjE | rule doesnt_touch_globalsI | - wp syscall_requiv_f_g gts_inv + (wp syscall_requiv_f_g gts_inv reads_respects_f_g'[OF lookup_extra_caps_reads_respects_g, where Q="\" and st=st] reads_respects_f_g'[OF lookup_ipc_buffer_reads_respects_g, where Q="\" and st=st] reads_respects_f_g'[OF cap_fault_on_failure_rev_g, where Q="\" and st=st] @@ -543,7 +543,7 @@ lemma handle_invocation_reads_respects_g: handle_fault_globals_equiv set_thread_state_globals_equiv - reply_from_kernel_globals_equiv | (rule hoare_drop_imps) + reply_from_kernel_globals_equiv)+ | (rule hoare_drop_imps) )+ apply (rule_tac Q'="\r s. silc_inv aag st s \ invs s \ is_subject aag rv \ is_subject aag (cur_thread s) \ rv \ idle_thread s" in hoare_post_imp_R) apply (wp pinv_invs perform_invocation_silc_inv) @@ -551,7 +551,7 @@ lemma handle_invocation_reads_respects_g: apply(wp reads_respects_f_g'[OF set_thread_state_reads_respects_g, where Q="\" and st=st] | simp)+ apply (simp | - wp set_thread_state_only_timer_irq_inv[where st=st'] + (wp set_thread_state_only_timer_irq_inv[where st=st'] set_thread_state_reads_respects_g set_thread_state_globals_equiv sts_Restart_invs @@ -569,7 +569,7 @@ lemma handle_invocation_reads_respects_g: lec_valid_fault lookup_extra_caps_authorised lookup_extra_caps_auth - lookup_ipc_buffer_has_read_auth' + lookup_ipc_buffer_has_read_auth')+ | (rule hoare_vcg_conj_liftE_R, rule hoare_drop_impE_R) )+ apply (rule hoare_pre) (*Weird schematic in precondition necessary*) @@ -590,7 +590,7 @@ lemma handle_invocation_reads_respects_g: apply (clarsimp simp: requiv_g_cur_thread_eq simp: reads_equiv_f_g_conj) apply (clarsimp simp: get_register_def invs_sym_refs invs_def valid_state_def valid_arch_state_ko_at_arm valid_pspace_vo valid_pspace_distinct) apply (rule context_conjI) - apply (simp add: ct_active_not_idle') + apply (simp add: ct_active_not_idle') apply (clarsimp simp: valid_pspace_def ct_in_state_def) apply (rule conjI) apply(fastforce intro: reads_lrefl) @@ -624,11 +624,12 @@ lemma lookup_cap_cap_fault: "\invs\ lookup_cap c b -, \\f s. valid_fault (CapFault x y f)\" apply (simp add: lookup_cap_def) apply wp - apply (case_tac xa) - apply (simp add: validE_E_def) - apply (wp) - apply (fold validE_E_def) - apply (wp lookup_slot_for_thread_cap_fault) + apply (case_tac xa) + apply (simp add: validE_E_def) + apply (wp) + apply (fold validE_E_def) + apply (wp lookup_slot_for_thread_cap_fault) + apply assumption done crunch pas_cur_domain[wp]: delete_caller_cap "pas_cur_domain aag" @@ -752,23 +753,19 @@ lemma handle_recv_reads_respects_f_g: lemma dmo_return_reads_respects: "reads_respects aag l \ (do_machine_op (return ()))" apply (rule use_spec_ev) - apply (rule do_machine_op_spec_reads_respects) - apply wp + apply (rule do_machine_op_spec_reads_respects; wp) done lemma dmo_return_globals_equiv: "\globals_equiv st\ do_machine_op (return ()) \\r .globals_equiv st\" - apply (rule dmo_no_mem_globals_equiv) - apply wp - done + by simp lemma get_irq_slot_reads_respects': "reads_respects aag l (K(aag_can_read_label aag (pasIRQAbs aag irq))) (get_irq_slot irq)" unfolding get_irq_slot_def apply(rule equiv_valid_guard_imp) apply(rule gets_ev) - apply(simp add: reads_equiv_def states_equiv_for_def equiv_for_def - affects_equiv_def) + apply(simp add: reads_equiv_def states_equiv_for_def equiv_for_def affects_equiv_def) done @@ -906,9 +903,9 @@ lemma handle_event_reads_respects_f_g: apply (simp add: validE_E_def) apply (rule_tac E="\r s. invs s \ is_subject aag rv \ is_subject aag (cur_thread s) \ valid_fault r \ pas_refined aag s \ pas_cur_domain aag s \ silc_inv aag st s \ rv \ idle_thread s" and Q="\\" in hoare_post_impErr) apply (rule hoare_vcg_E_conj) - apply (wp hv_invs handle_vm_fault_silc_inv) + apply (wp hv_invs handle_vm_fault_silc_inv)+ apply (simp add: invs_imps invs_mdb invs_valid_idle)+ - apply wp + apply wp+ apply (clarsimp simp: requiv_g_cur_thread_eq reads_equiv_f_g_conj ct_active_not_idle) done diff --git a/proof/infoflow/Tcb_IF.thy b/proof/infoflow/Tcb_IF.thy index c25300c0a..f46f57005 100644 --- a/proof/infoflow/Tcb_IF.thy +++ b/proof/infoflow/Tcb_IF.thy @@ -60,12 +60,9 @@ crunch globals_equiv[wp]: get_notification "globals_equiv st" lemma cancel_signal_globals_equiv: "\globals_equiv st and valid_ko_at_arm\ cancel_signal a b \\_. globals_equiv st\" unfolding cancel_signal_def - apply (wp set_thread_state_globals_equiv get_notification_valid_ko_at_arm - set_notification_globals_equiv set_notification_valid_ko_at_arm | wpc | clarsimp simp: crunch_simps hoare_drop_imps)+ - apply (rule hoare_pre) - apply (wp hoare_drop_imps) - apply simp -done + by (wpsimp wp: set_thread_state_globals_equiv get_notification_valid_ko_at_arm + set_notification_globals_equiv set_notification_valid_ko_at_arm hoare_drop_imps + simp: crunch_simps) crunch globals_equiv[wp]: cancel_ipc "globals_equiv st" (wp: mapM_x_wp select_inv hoare_drop_imps hoare_vcg_if_lift2 cancel_signal_valid_ko_at_arm @@ -85,18 +82,7 @@ lemma as_user_globals_equiv[wp]: apply (wp set_object_globals_equiv | simp add: split_def)+ apply (simp add: valid_ko_at_arm_def) apply (clarsimp simp: get_tcb_def obj_at_def) -done - -lemma as_user_valid_ko_at_arm[wp]: - "\ valid_ko_at_arm \ - as_user thread f - \ \_. valid_ko_at_arm\" - unfolding as_user_def - apply wp - apply (case_tac x) - apply (simp | wp select_wp)+ - apply(fastforce simp: valid_ko_at_arm_def get_tcb_ko_at obj_at_def) -done + done lemma cap_ne_global_pd : "ex_nonz_cap_to word s \ valid_global_refs s \ word \ arm_global_pd (arch_state s)" unfolding ex_nonz_cap_to_def @@ -107,7 +93,7 @@ lemma cap_ne_global_pd : "ex_nonz_cap_to word s \ valid_global_r apply clarsimp apply (unfold cap_range_def) apply blast -done + done lemma globals_equiv_ioc_update[simp]: "globals_equiv st (is_original_cap_update f s) = globals_equiv st s" apply (simp add: globals_equiv_def idle_equiv_def) @@ -193,14 +179,14 @@ next apply (simp only: split_def) apply (rule hoare_pre_spec_validE) apply wp - apply (wp set_cap_P set_cap_Q "2.hyps", assumption+) + apply (wp set_cap_P set_cap_Q "2.hyps")+ apply ((wp preemption_point_Q preemption_point_P | simp | wp_once preemption_point_inv)+)[1] apply (simp(no_asm)) apply (rule spec_strengthen_postE) apply (rule spec_valid_conj_liftE1, rule valid_validE_R, rule rec_del_invs) apply (rule spec_valid_conj_liftE1, rule reduce_zombie_cap_to) apply (rule spec_valid_conj_liftE1, rule rec_del_emptyable) - apply (rule "2.hyps", assumption+) + apply (rule "2.hyps") apply simp apply (simp add: conj_comms) apply (wp set_cap_P set_cap_Q replace_cap_invs @@ -302,24 +288,23 @@ lemma rec_del_globals_equiv: apply (wp rec_del_preservation2[where Q="valid_ko_at_arm" and R="valid_global_objs and valid_arch_state and pspace_aligned and valid_arch_objs and valid_global_refs and valid_vs_lookup"] finalise_cap_globals_equiv) - apply simp - apply (wp set_cap_globals_equiv'') - apply simp - apply (wp set_cap_valid_ko_at_arm empty_slot_globals_equiv) - apply simp - apply (wp empty_slot_valid_ko_at_arm) - apply simp - apply (simp add: invs_valid_ko_at_arm) - apply (simp add: invs_def valid_state_def valid_arch_caps_def valid_pspace_def) - apply (wp preemption_point_inv | simp)+ -done + apply simp + apply (wp set_cap_globals_equiv'') + apply simp + apply (wp set_cap_valid_ko_at_arm empty_slot_globals_equiv)+ + apply simp + apply (wp empty_slot_valid_ko_at_arm)+ + apply simp + apply (simp add: invs_valid_ko_at_arm) + apply (simp add: invs_def valid_state_def valid_arch_caps_def valid_pspace_def) + apply (wp preemption_point_inv | simp)+ + done lemma cap_delete_globals_equiv : "\globals_equiv st and invs and emptyable a\ (cap_delete a) \\_. globals_equiv st\" unfolding cap_delete_def - apply (rule hoare_pre) - apply (wp rec_del_globals_equiv) + apply (wp rec_del_globals_equiv) apply simp -done + done lemma no_cap_to_idle_thread': "valid_global_refs s \ \ ex_nonz_cap_to (idle_thread s) s" apply (clarsimp simp add: ex_nonz_cap_to_def valid_global_refs_def valid_refs_def) @@ -434,7 +419,7 @@ lemma invoke_tcb_NotificationControl_globals_equiv: invoke_tcb (NotificationControl t ntfn) \\_. globals_equiv st\" apply (case_tac ntfn, simp_all) - apply (wp unbind_notification_globals_equiv bind_notification_globals_equiv) + apply (wp unbind_notification_globals_equiv bind_notification_globals_equiv)+ done crunch globals_equiv: set_mcpriority "globals_equiv st" @@ -443,6 +428,7 @@ lemma invoke_tcb_globals_equiv: "\ invs and globals_equiv st and Tcb_AI.tcb_inv_wf ti\ invoke_tcb ti \\_. globals_equiv st\" + including no_pre apply(case_tac ti) prefer 4 apply (simp del: invoke_tcb.simps Tcb_AI.tcb_inv_wf.simps) @@ -673,6 +659,7 @@ lemma invoke_tcb_reads_respects_f: static_imp_wp [wp] shows "reads_respects_f aag l (silc_inv aag st and only_timer_irq_inv irq st' and einvs and simple_sched_action and pas_refined aag and pas_cur_domain aag and Tcb_AI.tcb_inv_wf ti and (\s. is_subject aag (cur_thread s)) and K (authorised_tcb_inv aag ti \ authorised_tcb_inv_extra aag ti)) (invoke_tcb ti)" + including no_pre apply(case_tac ti) apply(wp when_ev restart_reads_respects_f as_user_reads_respects_f static_imp_wp | simp)+ apply(auto intro: requiv_cur_thread_eq intro!: det_zipWithM simp: det_setRegister det_getRestartPC det_setNextPC authorised_tcb_inv_def simp: reads_equiv_f_def)[1] diff --git a/proof/invariant-abstract/AInvs.thy b/proof/invariant-abstract/AInvs.thy index a93733fe0..5b225cb57 100644 --- a/proof/invariant-abstract/AInvs.thy +++ b/proof/invariant-abstract/AInvs.thy @@ -53,7 +53,7 @@ lemma ct_running_machine_op: "\ct_running\ do_machine_op f \\_. ct_running\" apply (simp add: ct_in_state_def pred_tcb_at_def obj_at_def) apply (rule hoare_lift_Pf [where f=cur_thread]) - by wp + by wp+ lemma kernel_entry_invs: "\invs and (\s. e \ Interrupt \ ct_running s)\ @@ -104,7 +104,6 @@ lemma user_memory_update[wp]: valid_def bind_def gets_def return_def get_def select_f_def) - lemma do_user_op_invs: "\invs and ct_running\ do_user_op f tc diff --git a/proof/invariant-abstract/ARM/ArchAcc_AI.thy b/proof/invariant-abstract/ARM/ArchAcc_AI.thy index 494a9acf0..4f65f0f5b 100644 --- a/proof/invariant-abstract/ARM/ArchAcc_AI.thy +++ b/proof/invariant-abstract/ARM/ArchAcc_AI.thy @@ -31,6 +31,7 @@ bundle unfold_objects = obj_at_def[simp] kernel_object.splits[split] arch_kernel_obj.splits[split] + get_object_wp [wp] bundle unfold_objects_asm = obj_at_def[simp] @@ -64,10 +65,7 @@ lemmas set_asid_pool_typ_ats [wp] = abs_typ_at_lifts [OF set_asid_pool_typ_at] lemma get_pd_wp [wp]: "\\s. \pd. ko_at (ArchObj (PageDirectory pd)) p s \ Q pd s\ get_pd p \Q\" - apply (simp add: get_pd_def get_object_def) - apply (wp|wpc)+ - apply (clarsimp simp: obj_at_def) - done + unfolding get_pd_def including unfold_objects by wpsimp lemma get_pde_wp: @@ -79,7 +77,7 @@ lemma get_pde_wp: lemma get_pde_inv [wp]: "\P\ get_pde p \\_. P\" - by (wp get_pde_wp) simp + by (wpsimp wp: get_pde_wp) bundle pagebits = pd_bits_def[simp] pt_bits_def[simp] @@ -103,8 +101,7 @@ lemma get_master_pde_wp: lemma store_pde_typ_at [wp]: "\\s. P (typ_at T p s)\ store_pde ptr pde \\_ s. P (typ_at T p s)\" apply (simp add: store_pde_def set_pd_def set_object_def get_object_def) - apply wp - apply (clarsimp simp: obj_at_def a_type_def) + apply (wpsimp simp: obj_at_def a_type_def) done @@ -114,8 +111,7 @@ lemmas store_pde_typ_ats [wp] = abs_typ_at_lifts [OF store_pde_typ_at] lemma get_pt_wp [wp]: "\\s. \pt. ko_at (ArchObj (PageTable pt)) p s \ Q pt s\ get_pt p \Q\" apply (simp add: get_pt_def get_object_def) - apply (wp|wpc)+ - apply (clarsimp simp: obj_at_def) + apply (wpsimp simp: obj_at_def) done @@ -129,7 +125,7 @@ lemma get_pte_wp: lemma get_pte_inv [wp]: "\P\ get_pte p \\_. P\" - by (wp get_pte_wp) simp + by (wpsimp wp: get_pte_wp) lemma get_master_pte_wp: @@ -148,8 +144,7 @@ lemma get_master_pte_wp: lemma store_pte_typ_at: "\\s. P (typ_at T p s)\ store_pte ptr pte \\_ s. P (typ_at T p s)\" apply (simp add: store_pte_def set_pt_def set_object_def get_object_def) - apply wp - apply (clarsimp simp: obj_at_def a_type_def) + apply (wpsimp simp: obj_at_def a_type_def) done @@ -166,8 +161,8 @@ lemma lookup_pt_slot_inv: lemma lookup_pt_slot_inv_any: "\\s. \x. Q x s\ lookup_pt_slot pd vptr \Q\,-" "\E\ lookup_pt_slot pd vptr -, \\ft. E\" - apply (simp_all add: lookup_pt_slot_def) - apply (wp get_pde_wp | simp | wpc)+ + apply (simp_all add: lookup_pt_slot_def) + apply (wpsimp wp: get_pde_wp)+ done crunch cte_wp_at[wp]: set_irq_state "\s. P (cte_wp_at P' p s)" @@ -209,27 +204,21 @@ lemma set_asid_pool_cte_wp_at: lemma set_pt_pred_tcb_at[wp]: "\pred_tcb_at proj P t\ set_pt ptr val \\_. pred_tcb_at proj P t\" apply (simp add: set_pt_def set_object_def) - apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (clarsimp simp: pred_tcb_at_def obj_at_def) + apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def) done lemma set_pd_pred_tcb_at[wp]: "\pred_tcb_at proj P t\ set_pd ptr val \\_. pred_tcb_at proj P t\" apply (simp add: set_pd_def set_object_def) - apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (clarsimp simp: pred_tcb_at_def obj_at_def) + apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def) done lemma set_asid_pool_pred_tcb_at[wp]: "\pred_tcb_at proj P t\ set_asid_pool ptr val \\_. pred_tcb_at proj P t\" apply (simp add: set_asid_pool_def set_object_def) - apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (clarsimp simp: pred_tcb_at_def obj_at_def) + apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def) done lemmas word_simps = @@ -354,7 +343,7 @@ lemma arch_derive_cap_valid_cap: \valid_cap \ cap.ArchObjectCap\, -" apply(simp add: arch_derive_cap_def) apply(cases arch_cap, simp_all add: arch_derive_cap_def o_def) - apply(rule hoare_pre, wpc?, wp, + apply(rule hoare_pre, wpc?, wp+; clarsimp simp add: cap_aligned_def valid_cap_def split: option.splits)+ done @@ -362,7 +351,7 @@ lemma arch_derive_cap_valid_cap: lemma arch_derive_cap_inv: "\P\ arch_derive_cap arch_cap \\rv. P\" apply(simp add: arch_derive_cap_def, cases arch_cap, simp_all) - apply(rule hoare_pre, wpc?, wp, simp)+ + apply(rule hoare_pre, wpc?, wp+; simp)+ done definition @@ -412,21 +401,18 @@ lemma ucast_ucast_asid_high_bits [simp]: lemma mask_asid_low_bits_ucast_ucast: "((asid::word32) && mask asid_low_bits) = ucast (ucast asid :: 10 word)" - apply (rule word_eqI) - apply (simp add: word_size nth_ucast asid_low_bits_def) - done - + by (rule word_eqI) (simp add: word_size nth_ucast asid_low_bits_def) lemma set_asid_pool_cur [wp]: "\\s. P (cur_thread s)\ set_asid_pool p a \\_ s. P (cur_thread s)\" - unfolding set_asid_pool_def by (wp get_object_wp) simp + unfolding set_asid_pool_def by (wpsimp wp: get_object_wp) lemma set_asid_pool_cur_tcb [wp]: "\\s. cur_tcb s\ set_asid_pool p a \\_ s. cur_tcb s\" unfolding cur_tcb_def - by (rule hoare_lift_Pf [where f=cur_thread]) wp + by (rule hoare_lift_Pf [where f=cur_thread]; wp) crunch arch [wp]: set_asid_pool "\s. P (arch_state s)" @@ -435,7 +421,7 @@ crunch arch [wp]: set_asid_pool "\s. P (arch_state s)" lemma set_asid_pool_valid_arch [wp]: "\valid_arch_state\ set_asid_pool p a \\_. valid_arch_state\" - by (rule valid_arch_state_lift) (wp set_asid_pool_typ_at) + by (rule valid_arch_state_lift) (wp set_asid_pool_typ_at)+ lemma set_asid_pool_valid_objs [wp]: @@ -776,10 +762,6 @@ lemma create_mapping_entries_valid [wp]: apply (cases sz) apply (rule hoare_pre) apply (wp|simp add: valid_mapping_entries_def)+ - apply (rule hoare_pre) - apply (wp|simp add: valid_mapping_entries_def)+ - apply (rule hoare_pre) - apply wp apply clarsimp apply (erule (1) page_directory_pde_at_lookupI) apply (rule hoare_pre) @@ -935,10 +917,7 @@ lemma set_asid_pool_distinct [wp]: lemma store_pde_arch [wp]: "\\s. P (arch_state s)\ store_pde p pde \\_ s. P (arch_state s)\" - apply (simp add: store_pde_def set_pd_def get_object_def) - apply (wp|wpc)+ - apply clarsimp - done + by (simp add: store_pde_def set_pd_def get_object_def) wpsimp lemma store_pte_valid_pte [wp]: @@ -954,8 +933,7 @@ lemma store_pde_valid_pde [wp]: lemma set_pd_typ_at [wp]: "\\s. P (typ_at T p s)\ set_pd ptr pd \\_ s. P (typ_at T p s)\" apply (simp add: set_pd_def set_object_def get_object_def) - apply wp - apply clarsimp + apply wpsimp apply (erule rsubst [where P=P]) including unfold_objects by (clarsimp simp: a_type_def) @@ -1005,13 +983,8 @@ lemma set_pd_zombies_state_refs: lemma set_pd_cdt: - "\\s. P (cdt s)\ - set_pd p pd - \\_ s. P (cdt s)\" - apply (clarsimp simp: set_pd_def) - apply (wp get_object_wp) - apply simp - done + "\\s. P (cdt s)\ set_pd p pd \\_ s. P (cdt s)\" + unfolding set_pd_def by (wpsimp wp: get_object_wp) lemma set_pd_valid_mdb: @@ -1019,32 +992,22 @@ lemma set_pd_valid_mdb: set_pd p pd \\_ s. valid_mdb s\" apply (rule valid_mdb_lift) - apply (wp set_pd_cdt) + apply (wp set_pd_cdt)+ apply (clarsimp simp: set_pd_def) - apply (wp get_object_wp) - apply simp + apply (wpsimp wp: get_object_wp) done lemma set_pd_valid_idle: - "\\s. valid_idle s\ - set_pd p pd - \\_ s. valid_idle s\" - apply (wp valid_idle_lift) - apply (simp add: set_pd_def) - apply (wp get_object_wp) - apply simp - done - + "\\s. valid_idle s\ set_pd p pd \\_ s. valid_idle s\" + by (wpsimp wp: valid_idle_lift get_object_wp simp: set_pd_def) lemma set_pd_ifunsafe: "\\s. if_unsafe_then_cap s\ set_pd p pd \\_ s. if_unsafe_then_cap s\" - apply (simp add: set_pd_def) - apply (wp get_object_wp set_object_ifunsafe) - including unfold_objects - by clarsimp + unfolding set_pd_def including unfold_objects + by (wpsimp wp: get_object_wp set_object_ifunsafe) lemma set_pd_reply_caps: @@ -1102,7 +1065,6 @@ lemma set_pd_cur: \\_ s. cur_tcb s\" apply (simp add: cur_tcb_def set_pd_def set_object_def) apply (wp get_object_wp) - apply clarsimp apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) apply (clarsimp simp: obj_at_def is_tcb_def) done @@ -1129,8 +1091,7 @@ declare graph_of_Some_update[simp] lemma set_pt_typ_at [wp]: "\\s. P (typ_at T p s)\ set_pt ptr pt \\_ s. P (typ_at T p s)\" apply (simp add: set_pt_def set_object_def get_object_def) - apply wp - apply clarsimp + apply wpsimp apply (erule rsubst [where P=P]) including unfold_objects by (clarsimp simp: a_type_def) @@ -1153,92 +1114,55 @@ lemma set_pt_iflive: "\\s. if_live_then_nonz_cap s\ set_pt p pt \\_ s. if_live_then_nonz_cap s\" - apply (simp add: set_pt_def) - apply (wp get_object_wp set_object_iflive) - apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) - apply (clarsimp simp: obj_at_def) - done + unfolding set_pt_def including unfold_objects + by (wpsimp wp: get_object_wp) lemma set_pt_zombies: "\\s. zombies_final s\ set_pt p pt \\_ s. zombies_final s\" - apply (simp add: set_pt_def) - apply (wp get_object_wp set_object_zombies) - apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) - apply (clarsimp simp: obj_at_def) - done + unfolding set_pt_def including unfold_objects + by (wpsimp wp: get_object_wp) lemma set_pt_zombies_state_refs: "\\s. P (state_refs_of s)\ set_pt p pt \\_ s. P (state_refs_of s)\" - apply (clarsimp simp: set_pt_def set_object_def) - apply (wp get_object_wp) - apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) + unfolding set_pt_def set_object_def including unfold_objects + apply wpsimp apply (erule rsubst [where P=P]) apply (rule ext) - apply (clarsimp simp: obj_at_def state_refs_of_def split: option.splits) + apply (clarsimp simp: state_refs_of_def split: option.splits) done lemma set_pt_cdt: - "\\s. P (cdt s)\ - set_pt p pt - \\_ s. P (cdt s)\" - apply (clarsimp simp: set_pt_def) - apply (wp get_object_wp) - apply simp - done + "\\s. P (cdt s)\ set_pt p pt \\_ s. P (cdt s)\" + unfolding set_pt_def including unfold_objects by wpsimp lemma set_pt_valid_mdb: - "\\s. valid_mdb s\ - set_pt p pt - \\_ s. valid_mdb s\" - apply (rule valid_mdb_lift) - apply (wp set_pt_cdt) - apply (clarsimp simp: set_pt_def) - apply (wp get_object_wp) - apply simp - done - + "\\s. valid_mdb s\ set_pt p pt \\_ s. valid_mdb s\" + including unfold_objects + by (wpsimp wp: set_pt_cdt valid_mdb_lift simp: set_pt_def) lemma set_pt_valid_idle: - "\\s. valid_idle s\ - set_pt p pt - \\_ s. valid_idle s\" - apply (wp valid_idle_lift) - apply (simp add: set_pt_def) - apply (wp get_object_wp) - apply simp - done - + "\\s. valid_idle s\ set_pt p pt \\_ s. valid_idle s\" + including unfold_objects + by (wpsimp wp: valid_idle_lift simp: set_pt_def) lemma set_pt_ifunsafe: - "\\s. if_unsafe_then_cap s\ - set_pt p pt - \\_ s. if_unsafe_then_cap s\" - apply (simp add: set_pt_def) - apply (wp get_object_wp set_object_ifunsafe) - apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) - apply (clarsimp simp: obj_at_def) - done - + "\\s. if_unsafe_then_cap s\ set_pt p pt \\_ s. if_unsafe_then_cap s\" + including unfold_objects by (wpsimp simp: set_pt_def) lemma set_pt_reply_caps: - "\\s. valid_reply_caps s\ - set_pt p pt - \\_ s. valid_reply_caps s\" + "\\s. valid_reply_caps s\ set_pt p pt \\_ s. valid_reply_caps s\" by (wp valid_reply_caps_st_cte_lift) - lemma set_pt_reply_masters: - "\valid_reply_masters\ - set_pt p pt - \\_. valid_reply_masters\" + "\valid_reply_masters\ set_pt p pt \\_. valid_reply_masters\" by (wp valid_reply_masters_cte_lift) @@ -1331,7 +1255,7 @@ lemma set_pt_vs_lookup [wp]: lemma store_pte_vs_lookup [wp]: "\\s. P (vs_lookup s)\ store_pte x pte \\_ s. P (vs_lookup s)\" - unfolding store_pte_def by wp simp + unfolding store_pte_def by wpsimp lemma unique_table_caps_ptD: @@ -1607,7 +1531,7 @@ lemma set_pt_asid_map [wp]: "\valid_asid_map\ set_pt p pt \\_. valid_asid_map\" apply (simp add: valid_asid_map_def vspace_at_asid_def) apply (rule hoare_lift_Pf2 [where f="arch_state"]) - apply wp + apply wp+ done @@ -1945,56 +1869,41 @@ lemma set_asid_pool_cdt [wp]: "\\s. P (cdt s)\ set_asid_pool p ap \\_ s. P (cdt s)\" - apply (clarsimp simp: set_asid_pool_def) - apply (wp get_object_wp) - apply simp - done - + unfolding set_asid_pool_def including unfold_objects + by wpsimp lemma set_asid_pool_caps_of_state [wp]: "\\s. P (caps_of_state s)\ set_asid_pool p ap \\_ s. P (caps_of_state s)\" - apply (simp add: set_asid_pool_def get_object_def bind_assoc set_object_def) - apply wp - apply clarsimp + unfolding set_asid_pool_def set_object_def including unfold_objects + apply wpsimp apply (subst cte_wp_caps_of_lift) prefer 2 apply assumption - subgoal for _ y - by (cases y, auto simp: cte_wp_at_cases) + subgoal for _ _ y by (cases y, auto simp: cte_wp_at_cases) done lemma set_asid_pool_valid_mdb [wp]: "\\s. valid_mdb s\ set_asid_pool p ap \\_ s. valid_mdb s\" - apply (rule valid_mdb_lift) - apply wp - apply (clarsimp simp: set_asid_pool_def) - apply (wp get_object_wp) - apply simp - done + including unfold_objects + by (wpsimp wp: valid_mdb_lift simp: set_asid_pool_def) lemma set_asid_pool_valid_idle [wp]: "\\s. valid_idle s\ set_asid_pool p ap \\_ s. valid_idle s\" - apply (wp valid_idle_lift) - apply (simp add: set_asid_pool_def) - apply (wp get_object_wp) - apply simp - done + including unfold_objects + by (wpsimp wp: valid_idle_lift simp: set_asid_pool_def) lemma set_asid_pool_ifunsafe [wp]: "\\s. if_unsafe_then_cap s\ set_asid_pool p ap \\_ s. if_unsafe_then_cap s\" - apply (simp add: set_asid_pool_def) - apply (wp get_object_wp set_object_ifunsafe) - apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits) - apply (clarsimp simp: obj_at_def) - done + including unfold_objects + by (wpsimp simp: set_asid_pool_def) lemma set_asid_pool_reply_caps [wp]: @@ -2044,13 +1953,9 @@ lemma set_asid_pool_arch_objs_unmap': "\valid_arch_objs and (\s. (\\p) s \ valid_arch_obj (ASIDPool ap) s) and obj_at (\ko. \ap'. ko = ArchObj (ASIDPool ap') \ graph_of ap \ graph_of ap') p\ set_asid_pool p ap \\_. valid_arch_objs\" - apply (simp add: set_asid_pool_def) - apply (wp get_object_wp set_object_arch_objs) - apply (clarsimp simp: obj_at_def obj_at_def) - apply (rule conjI) - apply (clarsimp simp: a_type_def split: kernel_object.splits arch_kernel_obj.splits) - apply (clarsimp simp: vs_refs_def) - apply fastforce + unfolding set_asid_pool_def including unfold_objects + apply (wpsimp wp: set_object_arch_objs) + apply (fastforce simp: a_type_def vs_refs_def) done diff --git a/proof/invariant-abstract/ARM/ArchArch_AI.thy b/proof/invariant-abstract/ARM/ArchArch_AI.thy index a37108198..996353128 100644 --- a/proof/invariant-abstract/ARM/ArchArch_AI.thy +++ b/proof/invariant-abstract/ARM/ArchArch_AI.thy @@ -537,7 +537,7 @@ lemma cap_insert_simple_arch_caps_ap: hoare_vcg_disj_lift set_cap_reachable_pg_cap set_cap.vs_lookup_pages | clarsimp)+ apply (wp set_cap_arch_obj set_cap_valid_table_caps hoare_vcg_ball_lift - get_cap_wp static_imp_wp) + get_cap_wp static_imp_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps) apply (rule conjI) apply (clarsimp simp: vs_cap_ref_def) @@ -649,12 +649,13 @@ lemma perform_asid_control_invocation_st_tcb_at: and ct_active and invs and valid_aci aci\ perform_asid_control_invocation aci \\y. st_tcb_at P t\" + including no_pre apply (clarsimp simp: perform_asid_control_invocation_def split: asid_control_invocation.splits) apply (rename_tac word1 a b aa ba word2) apply (wp hoare_vcg_const_imp_lift retype_region_st_tcb_at set_cap_no_overlap|simp)+ apply (strengthen invs_valid_objs invs_psp_aligned) apply (clarsimp simp:conj_comms) - apply (wp max_index_upd_invs_simple get_cap_wp) + apply (wp max_index_upd_invs_simple get_cap_wp)+ apply (rule hoare_name_pre_state) apply (subgoal_tac "is_aligned word1 page_bits") prefer 2 @@ -939,6 +940,7 @@ lemma sts_valid_arch_inv: lemma ensure_safe_mapping_inv [wp]: "\P\ ensure_safe_mapping m \\_. P\" + including no_pre apply (cases m, simp_all) apply (case_tac a, simp) apply (case_tac aa, simp_all)[1] @@ -952,9 +954,7 @@ lemma ensure_safe_mapping_inv [wp]: (* the induct rule matches the wrong parameters first -> crunch blows up *) lemma create_mapping_entries_inv [wp]: "\P\ create_mapping_entries base vptr vmsz R A pd \\_. P\" - apply (induct vmsz) - apply (simp, wp lookup_pt_slot_inv)+ - done + by (induct vmsz; wpsimp wp: lookup_pt_slot_inv) crunch_ignore (add: select_ext) @@ -965,13 +965,7 @@ crunch inv [wp]: arch_decode_invocation "P" lemma create_mappings_empty [wp]: "\\\ create_mapping_entries base vptr vmsz R A pd \\m s. empty_refs m\, -" - apply (cases vmsz, simp_all add: empty_refs_def) - apply (wp|simp)+ - apply (rule hoare_pre) - apply (wp|simp add: pde_ref_def)+ - apply (rule hoare_pre) - apply (wp|simp add: pde_ref_def)+ - done + by (cases vmsz; wpsimp simp: pde_ref_def empty_refs_def) lemma empty_pde_atI: diff --git a/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy b/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy index 4766c4216..ec083871d 100644 --- a/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy @@ -23,6 +23,7 @@ lemma set_cap_in_device_frame[wp]: (* unused *) lemma derive_cap_objrefs [CNodeInv_AI_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" + including no_pre apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] apply (rename_tac arch_cap) @@ -31,21 +32,21 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]: apply (rename_tac word option) apply (case_tac option) apply simp - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply simp - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply (simp add: aobj_ref_cases) apply (rename_tac word option) apply (case_tac option, simp) - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply simp apply (rule hoare_pre, wp) apply clarsimp done - lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" + including no_pre apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] apply (rename_tac arch_cap) @@ -54,13 +55,13 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: apply (rename_tac option) apply (case_tac option) apply simp - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply simp - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply (simp add: aobj_ref_cases) apply (rename_tac option) apply (case_tac option, simp) - apply (rule hoare_pre, wp) + apply (rule hoare_pre, wp+) apply simp apply (rule hoare_pre, wp) apply clarsimp @@ -611,7 +612,7 @@ next apply (rule hoare_pre_spec_validE) apply (wp replace_cap_invs | simp)+ apply (erule finalise_cap_not_reply_master) - apply (wp "2.hyps", assumption+) + apply (wp "2.hyps") apply (wp preemption_point_Q | simp)+ apply (wp preemption_point_inv, simp+) apply (wp preemption_point_Q) @@ -625,7 +626,7 @@ next | wp replace_cap_invs set_cap_sets final_cap_same_objrefs set_cap_cte_cap_wp_to static_imp_wp | erule finalise_cap_not_reply_master)+ - apply (wp hoare_vcg_const_Ball_lift) + apply (wp hoare_vcg_const_Ball_lift)+ apply (rule hoare_strengthen_post) apply (rule_tac Q="\fin s. Q s \ invs s \ replaceable s slot (fst fin) rv \ cte_wp_at (op = rv) slot s \ s \ (fst fin) @@ -851,7 +852,7 @@ next apply (rule hoare_pre_spec_validE) apply wp apply ((wp | simp)+)[1] - apply (wp wp, assumption+) + apply (wp wp) apply ((wp preemption_point_inv | simp)+)[1] apply (simp(no_asm)) apply (rule wp, assumption+) @@ -955,6 +956,7 @@ lemma cap_move_invs[wp, CNodeInv_AI_assms]: and K (\ is_master_reply_cap cap)\ cap_move cap ptr ptr' \\rv. invs\" + including no_pre unfolding invs_def valid_state_def valid_pspace_def apply (simp add: pred_conj_def conj_comms [where Q = "valid_mdb S" for S]) apply wp diff --git a/proof/invariant-abstract/ARM/ArchCSpace_AI.thy b/proof/invariant-abstract/ARM/ArchCSpace_AI.thy index 49a47ea2c..8253109a0 100644 --- a/proof/invariant-abstract/ARM/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/ARM/ArchCSpace_AI.thy @@ -274,7 +274,7 @@ lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: apply (erule iffD2[OF caps_of_state_cteD']) apply (wp set_untyped_cap_as_full_cte_wp_at hoare_vcg_all_lift hoare_vcg_imp_lift set_untyped_cap_as_full_cte_wp_at_neg hoare_vcg_ex_lift | clarsimp)+ - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (intro conjI allI impI disj_subst) apply simp apply clarsimp @@ -515,7 +515,7 @@ lemma cap_insert_simple_arch_caps_no_ap: set_untyped_cap_as_full_empty_table_at hoare_vcg_ex_lift set_untyped_cap_as_full_caps_of_state_diff[where dest=dest] | wps)+ - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (intro conjI impI allI) by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps) diff --git a/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy index d70dd8d5a..891681854 100644 --- a/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy @@ -79,11 +79,10 @@ lemma invoke_untyped_etcb_at [DetSchedAux_AI_assms]: apply (cases ui) apply (simp add: mapM_x_def[symmetric] invoke_untyped_def whenE_def split del: if_split) - apply (rule hoare_pre) - apply (wp retype_region_etcb_at mapM_x_wp' - create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift - hoare_convert_imp[OF create_cap_no_pred_tcb_at] - hoare_convert_imp[OF _ init_arch_objects_exst] + apply (wp retype_region_etcb_at mapM_x_wp' + create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift + hoare_convert_imp[OF create_cap_no_pred_tcb_at] + hoare_convert_imp[OF _ init_arch_objects_exst] | simp | (wp_once hoare_drop_impE_E))+ done @@ -123,10 +122,10 @@ lemma perform_asid_control_etcb_at:"\(\s. etcb_at P t s) and val \\r s. st_tcb_at (Not \ inactive) t s \ etcb_at P t s\" apply (simp add: perform_asid_control_invocation_def) apply (rule hoare_pre) - apply ( wp | wpc | simp)+ + apply (wp | wpc | simp)+ apply (wp hoare_imp_lift_something typ_at_pred_tcb_at_lift)[1] apply (rule hoare_drop_imps) - apply (wp retype_region_etcb_at) + apply (wp retype_region_etcb_at)+ apply simp done @@ -150,15 +149,15 @@ lemma perform_asid_control_invocation_valid_sched: \\_. valid_sched\" apply (rule hoare_pre) apply (rule_tac I="invs and ct_active and valid_aci aci" in valid_sched_tcb_state_preservation) - apply (wp perform_asid_control_invocation_st_tcb_at) - apply simp - apply (wp perform_asid_control_etcb_at) - apply (rule hoare_strengthen_post, rule aci_invs) - apply (simp add: invs_def valid_state_def) + apply (wp perform_asid_control_invocation_st_tcb_at) + apply simp + apply (wp perform_asid_control_etcb_at)+ + apply (rule hoare_strengthen_post, rule aci_invs) + apply (simp add: invs_def valid_state_def) apply (rule hoare_lift_Pf[where f="\s. scheduler_action s"]) apply (rule hoare_lift_Pf[where f="\s. cur_domain s"]) apply (rule hoare_lift_Pf[where f="\s. idle_thread s"]) - apply wp + apply wp+ apply simp done diff --git a/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy b/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy index 12695236a..02bcda886 100644 --- a/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy @@ -99,7 +99,8 @@ lemma arch_decode_invocation_empty_fail[wp]: apply (find_goal \succeeds \erule arch_decode_ARMASIDControlMakePool_empty_fail\\) apply (find_goal \succeeds \erule arch_decode_ARMASIDPoolAssign_empty_fail\\) apply ((simp add: arch_decode_ARMASIDControlMakePool_empty_fail arch_decode_ARMASIDPoolAssign_empty_fail)+)[2] - by ((simp add: arch_decode_invocation_def Let_def split: arch_cap.splits cap.splits option.splits | wp | intro conjI impI allI)+) + including no_pre + by ((simp add: arch_decode_invocation_def Let_def split: arch_cap.splits cap.splits option.splits | (wp+) | intro conjI impI allI)+) end diff --git a/proof/invariant-abstract/ARM/ArchFinalise_AI.thy b/proof/invariant-abstract/ARM/ArchFinalise_AI.thy index 192b2b5b6..3a065d776 100644 --- a/proof/invariant-abstract/ARM/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/ARM/ArchFinalise_AI.thy @@ -96,7 +96,7 @@ lemma delete_asid_pool_invs[wp]: apply (rule hoare_vcg_conj_lift, (rule mapM_invalidate[where ptr=pptr])?, ((wp mapM_wp' | simp add: if_apply_def2)+)[1])+ - apply wp + apply wp+ apply (clarsimp simp: is_aligned_mask[symmetric]) apply (rule conjI) apply (rule vs_lookupI) @@ -112,7 +112,7 @@ lemma delete_asid_invs[wp]: apply (simp add: delete_asid_def cong: option.case_cong) apply (wp set_asid_pool_invs_unmap | wpc)+ apply (simp add: invalidate_asid_entry_def invalidate_asid_def invalidate_hw_asid_entry_def) - apply (wp load_hw_asid_wp) + apply (wp load_hw_asid_wp)+ apply (simp add: flush_space_def) apply (wp load_hw_asid_wp|wpc)+ apply (clarsimp simp del: fun_upd_apply) @@ -148,9 +148,9 @@ lemma delete_asid_pool_unmapped[wp]: apply (simp add: delete_asid_pool_def) apply wp apply (rule hoare_strengthen_post [where Q="\_. \"]) - apply wp + apply wp+ defer - apply wp + apply wp+ apply (clarsimp simp: vs_lookup_def vs_asid_refs_def dest!: graph_ofD) apply (erule rtranclE) @@ -228,7 +228,7 @@ lemma unmap_page_tcb_cap_valid: apply (rule tcb_cap_valid_typ_st) apply wp apply (simp add: pred_tcb_at_def2) - apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift) + apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift)+ done global_naming Arch @@ -525,6 +525,7 @@ lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]: valid_arch_state s)\ finalise_cap cap x \\rv s. replaceable s sl (fst rv) cap\" + including no_pre apply (cases cap, simp_all add: replaceable_def reachable_pg_cap_def split del: if_split) prefer 10 @@ -898,17 +899,17 @@ lemma delete_asid_empty_table_pd: \ obj_at (empty_table (set (arm_global_pts (arch_state s)))) word s\ delete_asid a word \\_ s. obj_at (empty_table (set (arm_global_pts (arch_state s)))) word s\" - apply (simp add: delete_asid_def) - apply (wp | wpc)+ - apply wps - apply wp - apply (simp add: set_asid_pool_def) - apply wp - apply (case_tac "x2 = word") - defer + apply (simp add: delete_asid_def) + apply (wp | wpc)+ apply wps - apply (rule set_object_at_obj) - apply (wp get_object_ret | wps)+ + apply wp+ + apply (simp add: set_asid_pool_def) + apply wp + apply (case_tac "x2 = word") + defer + apply wps + apply (rule set_object_at_obj) + apply (wp get_object_ret | wps)+ apply (clarsimp simp: obj_at_def empty_table_def)+ done @@ -1655,7 +1656,7 @@ lemma delete_asid_pool_unmapped2: apply simp apply (wp mapM_wp') apply clarsimp - apply wp + apply wp+ apply clarsimp done diff --git a/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy b/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy index 33769d7f3..3dc5c8615 100644 --- a/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy @@ -121,7 +121,6 @@ lemma invoke_irq_handler_invs'[Interrupt_AI_asms]: show ?thesis apply (cases i, simp_all) apply (wp maskInterrupt_invs_ARCH) - apply simp apply simp apply (rename_tac irq cap prod) apply (rule hoare_pre) diff --git a/proof/invariant-abstract/ARM/ArchInvariants_AI.thy b/proof/invariant-abstract/ARM/ArchInvariants_AI.thy index dcc3b7d82..dea3be353 100644 --- a/proof/invariant-abstract/ARM/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/ARM/ArchInvariants_AI.thy @@ -977,8 +977,8 @@ lemma valid_arch_objs_stateI: lemma valid_arch_cap_typ: assumes P: "\T p. \\s. (typ_at (AArch T) p s )\ f \\rv s. (typ_at (AArch T) p s)\" shows "\\s. valid_arch_cap c s\ f \\rv s. valid_arch_cap c s\" - apply (simp add: valid_arch_cap_def) - apply (case_tac c, simp_all) + unfolding valid_arch_cap_def + apply (case_tac c; simp) apply (wp P hoare_vcg_ball_lift hoare_vcg_imp_lift hoare_vcg_conj_lift | clarsimp)+ done @@ -990,11 +990,11 @@ lemma valid_arch_obj_typ: apply (rule hoare_vcg_all_lift) apply (rename_tac "fun" x) apply (case_tac "fun x",simp_all add: data_at_def hoare_vcg_prop P) - apply (wp hoare_vcg_disj_lift P) + apply (wp hoare_vcg_disj_lift P)+ apply (rule hoare_vcg_ball_lift) apply (rename_tac "fun" x) apply (case_tac "fun x", simp_all add: data_at_def hoare_vcg_prop P) - apply (wp hoare_vcg_disj_lift P) + apply (wp hoare_vcg_disj_lift P)+ done @@ -1228,7 +1228,7 @@ lemma valid_arch_state_lift: apply (simp add: valid_arch_state_def valid_asid_table_def valid_global_pts_def) apply (rule hoare_lift_Pf[where f="\s. arch_state s"]) - apply (wp arch typs hoare_vcg_conj_lift hoare_vcg_const_Ball_lift ) + apply (wp arch typs hoare_vcg_conj_lift hoare_vcg_const_Ball_lift)+ done lemma aobj_at_default_arch_cap_valid: diff --git a/proof/invariant-abstract/ARM/ArchIpc_AI.thy b/proof/invariant-abstract/ARM/ArchIpc_AI.thy index 549eabfff..49f08b9e9 100644 --- a/proof/invariant-abstract/ARM/ArchIpc_AI.thy +++ b/proof/invariant-abstract/ARM/ArchIpc_AI.thy @@ -97,7 +97,7 @@ lemma derive_cap_is_derived [Ipc_AI_assms]: | erule cte_wp_at_weakenE | simp split: cap.split_asm)+)[11] apply(wp, simp add: o_def) - apply(rule hoare_pre, wp hoare_drop_imps arch_derive_cap_is_derived) + apply(wp hoare_drop_imps arch_derive_cap_is_derived) apply(clarify, drule cte_wp_at_eqD, clarify) apply(frule(1) cte_wp_at_valid_objs_valid_cap) apply(erule cte_wp_at_weakenE) @@ -184,7 +184,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_assms]: arch_derive_cap cap \\rv s. P (set_option (aobj_ref rv)) False s\,-" apply(cases cap, simp_all add: is_zombie_def arch_derive_cap_def) - apply(rule hoare_pre, wpc?, wp, simp)+ + apply(rule hoare_pre, wpc?, wp+, simp)+ done lemma obj_refs_remove_rights[simp, Ipc_AI_assms]: @@ -462,6 +462,7 @@ lemma do_ipc_transfer_respects_device_region[Ipc_AI_cont_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" + including no_pre apply (simp add: do_ipc_transfer_def) apply (wp|wpc)+ apply (simp add: do_normal_transfer_def transfer_caps_def bind_assoc) @@ -472,13 +473,13 @@ lemma do_ipc_transfer_respects_device_region[Ipc_AI_cont_assms]: apply (subst ball_conj_distrib) apply (wp get_rs_cte_at2 thread_get_wp static_imp_wp grs_distinct hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift | simp)+ - apply (rule hoare_strengthen_post[where Q = "\r s. cap_refs_respects_device_region s - \ valid_objs s \ valid_mdb s \ obj_at (\ko. \tcb. ko = TCB tcb) t s"]) + apply (rule hoare_strengthen_post[where Q = "\r s. cap_refs_respects_device_region s + \ valid_objs s \ valid_mdb s \ obj_at (\ko. \tcb. ko = TCB tcb) t s"]) apply wp - apply (clarsimp simp: obj_at_def is_tcb_def) - apply (simp split: kernel_object.split_asm) - apply auto - done + apply (clarsimp simp: obj_at_def is_tcb_def) + apply (simp split: kernel_object.split_asm) + apply auto + done end @@ -487,4 +488,5 @@ interpretation Ipc_AI?: Ipc_AI_cont interpret Arch . case 1 show ?case by (unfold_locales;(fact Ipc_AI_cont_assms)?) qed + end diff --git a/proof/invariant-abstract/ARM/ArchKHeap_AI.thy b/proof/invariant-abstract/ARM/ArchKHeap_AI.thy index 9bba181aa..4588d7abb 100644 --- a/proof/invariant-abstract/ARM/ArchKHeap_AI.thy +++ b/proof/invariant-abstract/ARM/ArchKHeap_AI.thy @@ -267,7 +267,7 @@ lemma valid_vs_lookup_lift: apply (rule hoare_lift_Pf [where f=vs_lookup_pages]) apply (rule hoare_lift_Pf [where f="\s. (caps_of_state s)"]) apply (rule hoare_lift_Pf [where f="\s. arm_global_pts (arch_state s)"]) - apply (wp lookup cap pts) + apply (wp lookup cap pts)+ done @@ -279,7 +279,7 @@ lemma valid_table_caps_lift: unfolding valid_table_caps_def apply (rule hoare_lift_Pf [where f="\s. (caps_of_state s)"]) apply (rule hoare_lift_Pf [where f="\s. arm_global_pts (arch_state s)"]) - apply (wp cap pts hoare_vcg_all_lift hoare_vcg_const_imp_lift obj) + apply (wp cap pts hoare_vcg_all_lift hoare_vcg_const_imp_lift obj)+ done lemma valid_arch_caps_lift: @@ -364,7 +364,7 @@ lemma arch_lifts: subgoal apply (rule valid_global_objs_lift) - apply (wp arch) + apply (wp arch)+ apply (simp add: valid_ao_at_def) apply (rule hoare_vcg_ex_lift) apply (rule hoare_vcg_conj_lift) @@ -407,6 +407,7 @@ lemma arch_lifts: apply (simp add: valid_arch_state_def valid_asid_table_def) apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch]) apply (wp hoare_vcg_conj_lift hoare_vcg_ball_lift valid_global_pts | (rule aobj_at, clarsimp))+ + apply simp done done @@ -420,7 +421,7 @@ lemma equal_kernel_mappings_lift: apply (rule hoare_convert_imp) apply simp apply (rule hoare_convert_imp) - apply (wp aobj_at[OF arch_obj_pred_arch_obj_l]) + apply (wp aobj_at[OF arch_obj_pred_arch_obj_l])+ done lemma valid_machine_state_lift: @@ -432,25 +433,9 @@ lemma valid_machine_state_lift: apply (rule hoare_vcg_all_lift) apply (rule hoare_vcg_disj_lift[OF _ hoare_vcg_prop]) apply (rule in_user_frame_lift) - apply (wp aobj_at) - apply simp + apply (wp aobj_at; simp) done -(* -lemma bool_pred_exhaust: - "(P = (\x. x)) \ (P = (\x. \x)) \ (P = (\_. True)) \ (P = (\_. False))" - apply (cases "P True"; cases "P False") - apply (rule disjI2, rule disjI2, rule disjI1, rule ext) - defer - apply (rule disjI1, rule ext) - defer - apply (rule disjI2, rule disjI1, rule ext) - defer - apply (rule disjI2, rule disjI2, rule disjI2, rule ext) - apply (match conclusion in "P x = _" for x \ \cases x; fastforce\)+ - done -*) - lemma valid_ao_at_lift: assumes z: "\P p T. \\s. P (typ_at (AArch T) p s)\ f \\rv s. P (typ_at (AArch T) p s)\" and y: "\ao. \\s. ko_at (ArchObj ao) p s\ f \\rv s. ko_at (ArchObj ao) p s\" diff --git a/proof/invariant-abstract/ARM/ArchRetype_AI.thy b/proof/invariant-abstract/ARM/ArchRetype_AI.thy index bf451f5ad..e31b8371f 100644 --- a/proof/invariant-abstract/ARM/ArchRetype_AI.thy +++ b/proof/invariant-abstract/ARM/ArchRetype_AI.thy @@ -162,8 +162,8 @@ lemma clearMemory_vms: apply (simp add: clearMemory_def cleanCacheRange_PoU_def machine_op_lift_def machine_rest_lift_def split_def) apply (wp hoare_drop_imps | simp | wp mapM_x_wp_inv)+ - apply (simp add: storeWord_def | wp)+ - apply (simp add: word_rsplit_0) + apply (simp add: storeWord_def | wp)+ + apply (simp add: word_rsplit_0)+ done crunch device_state_inv[wp]: clearMemory "\ms. P (device_state ms)" @@ -486,7 +486,6 @@ lemma copy_global_invs_mappings_restricted: apply (rule hoare_gen_asm) apply (simp add: valid_pspace_def pred_conj_def) apply (rule hoare_conjI, wp copy_global_equal_kernel_mappings_restricted) - apply assumption apply (clarsimp simp: global_refs_def) apply (rule valid_prove_more, rule hoare_vcg_conj_lift, rule hoare_TrueI) apply (simp add: copy_global_mappings_def valid_pspace_def) @@ -521,18 +520,18 @@ lemma copy_global_invs_mappings_restricted: lemma copy_global_mappings_valid_ioc[wp]: "\valid_ioc\ copy_global_mappings pd \\_. valid_ioc\" - by (simp add: copy_global_mappings_def, wp mapM_x_wp[of UNIV]) simp+ + by (wpsimp wp: mapM_x_wp[of UNIV] simp: copy_global_mappings_def) lemma copy_global_mappings_vms[wp]: "\valid_machine_state\ copy_global_mappings pd \\_. valid_machine_state\" - by (simp add: copy_global_mappings_def, wp mapM_x_wp[of UNIV]) simp+ + by (wpsimp wp: mapM_x_wp[of UNIV] simp: copy_global_mappings_def) lemma copy_global_mappings_invs: "\invs and (\s. pd \ global_refs s) and K (is_aligned pd pd_bits)\ copy_global_mappings pd \\rv. invs\" apply (fold all_invs_but_equal_kernel_mappings_restricted_eq) - apply (rule hoare_pre, rule copy_global_invs_mappings_restricted) + apply (wp copy_global_invs_mappings_restricted) apply (clarsimp simp: equal_kernel_mappings_def obj_at_def restrict_map_def) done @@ -548,13 +547,9 @@ lemma mapM_copy_global_invs_mappings_restricted: \\rv. invs\" apply (fold all_invs_but_equal_kernel_mappings_restricted_eq) apply (induct pds, simp_all only: mapM_x_Nil mapM_x_Cons K_bind_def) - apply (wp, simp) + apply wpsimp apply (rule hoare_seq_ext, assumption, thin_tac "P" for P) - apply (rule hoare_conjI) - apply (rule hoare_pre, rule copy_global_invs_mappings_restricted) - apply clarsimp - apply (rule hoare_pre, wp) - apply clarsimp + apply (wpsimp wp: copy_global_invs_mappings_restricted) done @@ -1326,8 +1321,7 @@ lemma clearMemory_um_eq_0: \\_ m. underlying_memory m p = 0\" apply (clarsimp simp: clearMemory_def) apply (wp mapM_x_wp_inv | simp)+ - apply (rule hoare_pre) - apply (wp hoare_drop_imps storeWord_um_eq_0) + apply (wp hoare_drop_imps storeWord_um_eq_0) apply (fastforce simp: ignore_failure_def split: if_split_asm) done diff --git a/proof/invariant-abstract/ARM/ArchSchedule_AI.thy b/proof/invariant-abstract/ARM/ArchSchedule_AI.thy index 81d4201cb..9e40bbb1d 100644 --- a/proof/invariant-abstract/ARM/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/ARM/ArchSchedule_AI.thy @@ -86,7 +86,7 @@ lemma stt_invs [wp,Schedule_AI_asms]: valid_irq_node_def valid_machine_state_def) apply (fastforce simp: cur_tcb_def obj_at_def elim: valid_pspace_eqI ifunsafe_pspaceI) - apply wp + apply wp+ apply clarsimp apply (simp add: is_tcb_def) done diff --git a/proof/invariant-abstract/ARM/ArchVSpaceEntries_AI.thy b/proof/invariant-abstract/ARM/ArchVSpaceEntries_AI.thy index 1a8289cce..ff8c7dd29 100644 --- a/proof/invariant-abstract/ARM/ArchVSpaceEntries_AI.thy +++ b/proof/invariant-abstract/ARM/ArchVSpaceEntries_AI.thy @@ -12,6 +12,7 @@ theory ArchVSpaceEntries_AI imports "../VSpaceEntries_AI" begin + context Arch begin global_naming ARM (*FIXME: arch_split*) lemma a_type_pdD: @@ -378,14 +379,15 @@ lemma unmap_page_valid_pdpt[wp]: apply (wp) prefer 2 apply (rule valid_validE[OF find_pd_for_asid_inv]) - apply (rule hoare_pre) - apply (wp get_object_wp get_pte_wp get_pde_wp lookup_pt_slot_inv_any - store_invalid_pte_valid_pdpt - store_invalid_pde_valid_pdpt - mapM_x_store_invalid_pte_valid_pdpt mapM_x_store_pde_valid_pdpt_objs - | simp add: mapM_x_map - | wpc | simp add: check_mapping_pptr_def)+ - apply (simp add: fun_upd_def[symmetric] is_aligned_mask[symmetric]) + apply (rule hoare_pre) + apply (wp get_object_wp get_pte_wp get_pde_wp lookup_pt_slot_inv_any + store_invalid_pte_valid_pdpt + store_invalid_pde_valid_pdpt + mapM_x_store_invalid_pte_valid_pdpt mapM_x_store_pde_valid_pdpt_objs + | simp add: mapM_x_map + | wpc | simp add: check_mapping_pptr_def)+ + apply (simp add: fun_upd_def[symmetric] is_aligned_mask[symmetric]) + apply assumption done crunch valid_pdpt_objs[wp]: flush_table "valid_pdpt_objs" @@ -395,7 +397,8 @@ crunch kheap[wp]: flush_table "\s. P (kheap s)" (wp: crunch_wps simp: crunch_simps) lemma unmap_page_table_valid_pdpt_objs[wp]: - "\valid_pdpt_objs\ unmap_page_table asid vptr pt \\rv. valid_pdpt_objs\" + notes hoare_pre [wp_pre del] + shows "\valid_pdpt_objs\ unmap_page_table asid vptr pt \\rv. valid_pdpt_objs\" apply (simp add: unmap_page_table_def) apply (wp get_object_wp store_invalid_pde_valid_pdpt | wpc)+ apply (simp add: obj_at_def) @@ -442,11 +445,10 @@ lemma mapM_x_copy_pde_updates: apply (clarsimp simp: obj_at_def fun_upd_idem dest!: a_type_pdD) apply (simp add: mapM_x_Cons) apply wp - apply assumption - apply (thin_tac "valid P f Q" for P f Q) - apply (simp add: store_pde_def set_pd_def set_object_def - cong: bind_cong split del: if_split) - apply (wp get_object_wp get_pde_wp) + apply (thin_tac "valid P f Q" for P f Q) + apply (simp add: store_pde_def set_pd_def set_object_def + cong: bind_cong split del: if_split) + apply (wp get_object_wp get_pde_wp) apply (clarsimp simp: obj_at_def a_type_simps mask_out_add_aligned[symmetric] split del: if_split) apply (simp add: a_type_simps, safe) @@ -461,6 +463,8 @@ lemma mapM_x_copy_pde_updates: done lemma copy_global_mappings_valid_pdpt_objs[wp]: + notes hoare_pre [wp_pre del] + shows "\valid_pdpt_objs and valid_arch_state and pspace_aligned and K (is_aligned p pd_bits)\ copy_global_mappings p \\rv. valid_pdpt_objs\" diff --git a/proof/invariant-abstract/ARM/ArchVSpace_AI.thy b/proof/invariant-abstract/ARM/ArchVSpace_AI.thy index a9da8af2f..7a3582871 100644 --- a/proof/invariant-abstract/ARM/ArchVSpace_AI.thy +++ b/proof/invariant-abstract/ARM/ArchVSpace_AI.thy @@ -49,7 +49,6 @@ declare glob_vs_refs_arch_def[simp] definition "glob_vs_refs \ arch_obj_fun_lift glob_vs_refs_arch {}" - crunch pspace_in_kernel_window[wp]: perform_page_invocation "pspace_in_kernel_window" (simp: crunch_simps wp: crunch_wps) @@ -249,9 +248,6 @@ lemma invalidate_hw_asid_entry_asid_map [wp]: done - - - lemma invalidate_asid_asid_map [wp]: "\valid_asid_map\ invalidate_asid asid \\_. valid_asid_map\" apply (simp add: invalidate_asid_def) @@ -378,7 +374,7 @@ lemma invalidate_tlb_by_asid_invs[wp]: "\invs\ invalidate_tlb_by_asid asid \\_. invs\" apply (clarsimp simp: invalidate_tlb_by_asid_def | wp | wpc)+ apply (rule_tac Q="K invs" in hoare_post_imp) - apply (clarsimp simp: load_hw_asid_invs)+ + apply (clarsimp|wp load_hw_asid_invs)+ done crunch typ_at [wp]: flush_space "\s. P (typ_at T p s)" @@ -386,10 +382,8 @@ crunch typ_at [wp]: flush_space "\s. P (typ_at T p s)" lemmas flush_space_typ_ats [wp] = abs_typ_at_lifts [OF flush_space_typ_at] - crunch cur_tcb [wp]: flush_space cur_tcb - crunch valid_arch [wp]: flush_space valid_arch_state crunch valid_objs [wp]: flush_space valid_objs @@ -607,7 +601,7 @@ lemma dmo_cleanCaches_PoU_invs[wp]: "\invs\ do_machine_op cleanC lemma flush_space_invs[wp]: "\invs\ flush_space asid \\_. invs\" apply (simp add: flush_space_def | wp | wpc)+ - apply (rule_tac Q="K invs" in hoare_post_imp, simp+, wp) + apply (rule_tac Q="K invs" in hoare_post_imp, (simp|wp)+) done crunch valid_vs_lookup[wp]: flush_space "valid_vs_lookup" @@ -905,16 +899,16 @@ crunch valid_objs [wp]: set_vm_root_for_flush valid_objs lemma store_hw_asid_valid_arch: - "\valid_arch_state and + notes hoare_pre [wp_pre del] + shows "\valid_arch_state and (\s. arm_asid_map (arch_state s) asid = None \ arm_hwasid_table (arch_state s) hw_asid = None)\ store_hw_asid asid hw_asid \\_. valid_arch_state\" apply (simp add: store_hw_asid_def) apply wp - apply (simp add: valid_arch_state_def fun_upd_def[symmetric] - comp_upd_simp) - apply (rule hoare_pre, wp) + apply (simp add: valid_arch_state_def fun_upd_def[symmetric] comp_upd_simp) + apply wp apply clarsimp apply (frule is_inv_NoneD[rotated]) apply simp @@ -968,9 +962,7 @@ lemma svmrff_asid_mapped [wp]: get_hw_asid_def store_hw_asid_def find_free_hw_asid_def load_hw_asid_def cong: if_cong option.case_cong) - apply (wp|wpc|simp add: valid_asid_def)+ - apply (wp hoare_vcg_all_lift hoare_drop_imps) - apply (simp add: valid_asid_def) + apply (wp|wpc|simp add: valid_asid_def|wp hoare_vcg_all_lift hoare_drop_imps)+ done @@ -983,7 +975,6 @@ lemma find_pd_for_asid_assert_wp: apply (simp add: find_pd_for_asid_assert_def find_pd_for_asid_def assertE_def split del: if_split) - apply (rule hoare_pre) apply (wp get_pde_wp get_asid_pool_wp | wpc)+ apply clarsimp apply (drule spec, erule mp) @@ -2004,7 +1995,7 @@ lemma set_pd_valid_arch_caps: apply (simp add: set_pd_def set_object_def) apply (wp get_object_wp) apply (clarsimp simp: obj_at_def simp del: fun_upd_apply - split: Structures_A.kernel_object.split arch_kernel_obj.split) + split: Structures_A.kernel_object.splits arch_kernel_obj.splits) apply (clarsimp simp: valid_arch_caps_def) apply (subst caps_of_state_after_update[folded fun_upd_def], simp add: obj_at_def)+ @@ -2617,11 +2608,9 @@ lemma mapM_swp_store_pte_invs[wp]: prefer 2 apply (rule mapM_wp') apply simp_all - apply (wp hoare_vcg_imp_lift hoare_vcg_ex_lift hoare_vcg_ball_lift + apply (wp mapM_wp' hoare_vcg_imp_lift hoare_vcg_ex_lift hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_imp_lift) - apply clarsimp+ - apply (intro conjI) - apply clarsimp+ + apply clarsimp apply (fastforce simp: cte_wp_at_caps_of_state is_pt_cap_def cap_asid_def) done @@ -2715,8 +2704,7 @@ lemma same_refs_lD: \ (\p. pte_ref_pages pte = Some p \ p \ obj_refs cap) \ (\ref. (ref \ (p && ~~ mask pt_bits)) s \ vs_cap_ref cap = Some (VSRef (p && mask pt_bits >> 2) (Some APageTable) # ref))" - apply (clarsimp simp:same_refs_def split:list.splits) - done + by (clarsimp simp:same_refs_def split:list.splits) lemma same_refs_rD: "\same_refs (Inr(pde,p # slots)) cap s\ @@ -3320,10 +3308,8 @@ lemma store_pde_unmap_pt: \ ([VSRef (vaddr >> 20) (Some APageDirectory), VSRef (asid && mask asid_low_bits) (Some AASIDPool), VSRef (ucast (asid_high_bits_of asid)) None] \ pt) s\" - apply (simp add: store_pde_def) - apply wp - apply (simp add: set_pd_def set_object_def) - apply (wp get_object_wp) + apply (simp add: store_pde_def set_pd_def set_object_def) + apply (wp get_object_wp) apply (clarsimp simp: obj_at_def fun_upd_def[symmetric]) apply (clarsimp simp: vs_lookup_def vs_asid_refs_def dest!: graph_ofD vs_lookup1_rtrancl_iterations) @@ -3361,10 +3347,8 @@ lemma store_pde_unmap_page: \ ([VSRef (vaddr >> 20) (Some APageDirectory), VSRef (asid && mask asid_low_bits) (Some AASIDPool), VSRef (ucast (asid_high_bits_of asid)) None] \ pde) s\" - apply (simp add: store_pde_def vs_lookup_pages_eq_ap) - apply wp - apply (simp add: set_pd_def set_object_def) - apply (wp get_object_wp) + apply (simp add: store_pde_def vs_lookup_pages_eq_ap set_pd_def set_object_def) + apply (wp get_object_wp) apply (clarsimp simp: obj_at_def fun_upd_def[symmetric]) apply (clarsimp simp: vs_lookup_pages_def vs_asid_refs_def dest!: graph_ofD vs_lookup_pages1_rtrancl_iterations) @@ -3553,8 +3537,7 @@ lemma no_irq_do_flush: lemma cleanCacheRange_PoU_respects_device_region[wp]: "\\ms. P (device_state ms)\ cleanCacheRange_PoU a b c \\_ ms. P (device_state ms)\" apply (clarsimp simp: cleanCacheRange_PoU_def cacheRangeOp_def) - apply (wp mapM_x_wp | wpc | clarsimp)+ - apply fastforce + apply (wp mapM_x_wp | wpc | clarsimp | fastforce)+ done lemma cacheRangeOp_respects_device_region[wp]: @@ -3565,23 +3548,6 @@ lemma cacheRangeOp_respects_device_region[wp]: apply (wp mapM_x_wp valid_f | wpc | clarsimp | assumption)+ done -lemma pspace_respects_device_region_dmo: - assumes valid_f: "\P. \\ms. P (device_state ms)\ f \\r ms. P (device_state ms)\" - shows "\pspace_respects_device_region\do_machine_op f\\r. pspace_respects_device_region\" - apply (clarsimp simp: do_machine_op_def gets_def select_f_def simpler_modify_def bind_def valid_def - get_def return_def) - apply (drule_tac P1 = "op = (device_state (machine_state s))" in use_valid[OF _ valid_f]) - apply auto - done - -lemma cap_refs_respects_device_region_dmo: - assumes valid_f: "\P. \\ms. P (device_state ms)\ f \\r ms. P (device_state ms)\" - shows "\cap_refs_respects_device_region\do_machine_op f\\r. cap_refs_respects_device_region\" - apply (clarsimp simp: do_machine_op_def gets_def select_f_def simpler_modify_def bind_def valid_def - get_def return_def) - apply (drule_tac P1 = "op = (device_state (machine_state s))" in use_valid[OF _ valid_f]) - apply auto - done lemma machine_op_lift_device_state[wp]: "\\ms. P (device_state ms)\ machine_op_lift f \\_ ms. P (device_state ms)\" @@ -3657,7 +3623,7 @@ lemma perform_page_directory_invocation_invs[wp]: done lemma perform_page_table_invocation_invs[wp]: - notes no_irq[wp] + notes no_irq[wp] hoare_pre [wp_pre del] shows "\invs and valid_pti pti\ perform_page_table_invocation pti @@ -3679,7 +3645,7 @@ lemma perform_page_table_invocation_invs[wp]: valid_irq_node_typ valid_pde_lift set_cap_typ_at set_cap_irq_handlers set_cap_empty_pde hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_imp_lift - set_cap_arch_obj set_cap_obj_at_impossible set_cap_valid_arch_caps) + set_cap_arch_obj set_cap_obj_at_impossible set_cap_valid_arch_caps)+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (rule exI, rule conjI, assumption) apply (clarsimp simp: is_pt_cap_def is_arch_update_def @@ -3707,7 +3673,7 @@ lemma perform_page_table_invocation_invs[wp]: apply (simp add: cte_wp_at_caps_of_state) apply (wpc, wp, wpc) apply (rule hoare_lift_Pf2[where f=caps_of_state]) - apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift) + apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift)+ apply (rule hoare_vcg_conj_lift) apply (wp dmo_invs) apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift @@ -3715,7 +3681,7 @@ lemma perform_page_table_invocation_invs[wp]: mapM_x_swp_store_pte_invs[unfolded cte_wp_at_caps_of_state] mapM_x_swp_store_empty_table valid_cap_typ[OF unmap_page_table_typ_at] - unmap_page_table_unmapped3) + unmap_page_table_unmapped3)+ apply (rule hoare_pre_imp[of _ \], assumption) apply (clarsimp simp: valid_def split_def) apply safe[1] @@ -3808,7 +3774,7 @@ lemma flush_page_invs: in use_valid) apply ((clarsimp | wp)+)[3] apply(erule use_valid, wp no_irq_invalidateTLB_VAASID no_irq, assumption) - apply (wp set_vm_root_for_flush_invs hoare_drop_imps, simp) + apply (wp set_vm_root_for_flush_invs hoare_drop_imps|simp)+ done lemma find_pd_for_asid_lookup_slot [wp]: @@ -4151,7 +4117,7 @@ crunch cte_wp_at [wp]: unmap_page "\s. P (cte_wp_at P' p s)" lemma "\\s. P (vs_lookup s) (valid_pte pte s)\ set_cap cap cptr \\_ s. P (vs_lookup s) (valid_pte pte s)\" apply (rule hoare_lift_Pf[where f=vs_lookup]) apply (rule hoare_lift_Pf[where f="valid_pte pte"]) - apply (wp set_cap.vs_lookup set_cap_valid_pte_stronger) + apply (wp set_cap.vs_lookup set_cap_valid_pte_stronger)+ done lemma reachable_page_table_not_global: @@ -4805,7 +4771,7 @@ lemma perform_page_invs [wp]: split: option.splits vmpage_size.splits cap.splits) apply (simp add: cte_wp_at_caps_of_state) apply (wp unmap_page_invs hoare_vcg_ex_lift hoare_vcg_all_lift - hoare_vcg_imp_lift unmap_page_unmapped) + hoare_vcg_imp_lift unmap_page_unmapped)+ apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state) apply (clarsimp simp: is_arch_diminished_def) apply (drule (2) diminished_is_update') diff --git a/proof/invariant-abstract/ARM/Machine_AI.thy b/proof/invariant-abstract/ARM/Machine_AI.thy index 5f8baded2..2e0de9da4 100644 --- a/proof/invariant-abstract/ARM/Machine_AI.thy +++ b/proof/invariant-abstract/ARM/Machine_AI.thy @@ -223,10 +223,7 @@ lemma no_fail_resetTimer[wp]: "no_fail \ resetTimer" lemma loadWord_inv: "\P\ loadWord x \\x. P\" - apply (simp add: loadWord_def) - apply wp - apply simp - done + unfolding loadWord_def by wpsimp lemma getRestartPC_inv: "\P\ getRestartPC \\rv. P\" @@ -248,10 +245,7 @@ lemma getIFSR_inv: "\P\ getIFSR \\_. P\" lemma no_fail_cacheRangeOp[simp, wp]: assumes nf: "\a b. no_fail \ (oper a b)" shows "no_fail \ (cacheRangeOp oper s e p)" - apply (simp add: cacheRangeOp_def mapM_x_mapM) - apply (rule no_fail_pre) - apply (wp_trace no_fail_mapM nf | wpc | clarsimp)+ - done + by (simp add: cacheRangeOp_def mapM_x_mapM) (wpsimp wp: no_fail_mapM nf) lemma no_fail_cleanCacheRange_PoU[simp, wp]: "no_fail \ (cleanCacheRange_PoU s e p)" @@ -487,8 +481,7 @@ lemma no_irq_mapM: apply (rule mapM_wp) prefer 2 apply (rule order_refl) - apply wp - apply simp + apply (wp; simp) done @@ -499,8 +492,7 @@ lemma no_irq_mapM_x: apply (rule mapM_x_wp) prefer 2 apply (rule order_refl) - apply wp - apply simp + apply (wp; simp) done diff --git a/proof/invariant-abstract/Arch_AI.thy b/proof/invariant-abstract/Arch_AI.thy index 52b9e8638..41969c594 100644 --- a/proof/invariant-abstract/Arch_AI.thy +++ b/proof/invariant-abstract/Arch_AI.thy @@ -161,6 +161,7 @@ lemma set_cap_empty_tables[wp]: apply (clarsimp simp: empty_table_caps_of) done + lemma cte_wp_at_eq_to_op_eq: "cte_wp_at (\c. c = cap) = cte_wp_at (op = cap)" by (simp add: cte_wp_at_caps_of_state fun_eq_iff) @@ -194,12 +195,14 @@ lemma sts_pspace_no_overlap [wp]: "\pspace_no_overlap S\ set_thread_state t st \\rv. pspace_no_overlap S\" by (wp pspace_no_overlap_typ_at_lift) + lemma diminished_cte_wp_at_valid_cap: "cte_wp_at (diminished c) p s \ valid_objs s \ s \ c" apply (drule(1) cte_wp_at_valid_objs_valid_cap) apply (clarsimp simp: diminished_def) done + lemma delete_objects_st_tcb_at: "\pred_tcb_at proj P t and invs and K (t \ {ptr .. ptr + 2 ^ bits - 1})\ delete_objects ptr bits @@ -207,6 +210,4 @@ lemma delete_objects_st_tcb_at: by (wp|simp add: delete_objects_def do_machine_op_def split_def)+ - - end diff --git a/proof/invariant-abstract/BCorres2_AI.thy b/proof/invariant-abstract/BCorres2_AI.thy index c2c735bec..0519d16ac 100644 --- a/proof/invariant-abstract/BCorres2_AI.thy +++ b/proof/invariant-abstract/BCorres2_AI.thy @@ -239,24 +239,17 @@ crunch all_but_exst[wp]: set_scheduler_action,tcb_sched_action,next_domain, crunch (empty_fail) empty_fail[wp]: cap_move_ext global_interpretation set_scheduler_action_extended: is_extended "set_scheduler_action a" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) global_interpretation tcb_sched_action_extended: is_extended "tcb_sched_action a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) global_interpretation next_domain_extended: is_extended "next_domain" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) global_interpretation cap_move_ext: is_extended "cap_move_ext a b c d" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) + lemmas rec_del_simps_ext = rec_del.simps [THEN ext[where f="rec_del args" for args]] @@ -355,37 +348,35 @@ lemma resolve_address_bits_bcorres[wp]: "bcorres (resolve_address_bits a) (resol lemma bcorres_cap_fault_on_failure[wp]: "bcorres f f' \ bcorres (cap_fault_on_failure a b f) (cap_fault_on_failure a b f')" apply (simp add: cap_fault_on_failure_def) - apply (wp | wpc | simp)+ + apply wpsimp done lemmas in_use_frame_truncate[simp] = more_update.in_user_frame_update[where f="\_.()"] lemma lookup_error_on_failure_bcorres[wp]: "bcorres b b' \ bcorres (lookup_error_on_failure a b) (lookup_error_on_failure a b')" apply (simp add: lookup_error_on_failure_def) - apply (wp | wpc | simp)+ + apply wpsimp done lemma empty_on_failure_bcorres[wp]: "bcorres f f' \ bcorres (empty_on_failure f) (empty_on_failure f')" apply (simp add: empty_on_failure_def) - apply (wp | simp)+ + apply wpsimp done lemma unify_failure_bcorres[wp]: "bcorres f f' \ bcorres (unify_failure f) (unify_failure f')" apply (simp add: unify_failure_def) - apply (wp | simp)+ + apply wpsimp done lemma const_on_failure_bcorres[wp]: "bcorres f f' \ bcorres (const_on_failure c f) (const_on_failure c f')" apply (simp add: const_on_failure_def) - apply (wp | simp)+ + apply wpsimp done crunch (bcorres)bcorres[wp]: lookup_target_slot,lookup_cap,load_cap_transfer truncate_state (simp: gets_the_def ignore: loadWord) lemma get_receive_slots_bcorres[wp]: "bcorres (get_receive_slots a b) (get_receive_slots a b)" - apply (cases b) - apply (wp | simp)+ - done + by (cases b; wpsimp) lemma (in BCorres2_AI) make_fault_msg_bcorres[wp]: "bcorres (make_fault_msg a b :: 'a state \ _) (make_fault_msg a b)" diff --git a/proof/invariant-abstract/Bits_AI.thy b/proof/invariant-abstract/Bits_AI.thy index b5b3ae056..8a5f055e3 100644 --- a/proof/invariant-abstract/Bits_AI.thy +++ b/proof/invariant-abstract/Bits_AI.thy @@ -104,9 +104,6 @@ lemma NullCap_valid [simp]: "s \ cap.NullCap" lemma empty_on_failure_wp[wp]: "\P\ m \Q\,\\rv. Q []\ \ \P\ empty_on_failure m \Q\" - apply (simp add: empty_on_failure_def) - apply wp - apply assumption - done + by (simp add: empty_on_failure_def) wp end diff --git a/proof/invariant-abstract/CNodeInv_AI.thy b/proof/invariant-abstract/CNodeInv_AI.thy index 9cf09d42b..8c394a85c 100644 --- a/proof/invariant-abstract/CNodeInv_AI.thy +++ b/proof/invariant-abstract/CNodeInv_AI.thy @@ -363,9 +363,8 @@ lemma mask_cap_hoare_helper: lemma derive_cap_untyped: "\\s. P (untyped_range cap)\ derive_cap slot cap \\rv s. rv \ cap.NullCap \ P (untyped_range rv)\,-" - apply (cases cap, simp_all add: derive_cap_def is_zombie_def) - apply (wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+ - done + unfolding derive_cap_def is_zombie_def + by (cases cap; (wp ensure_no_children_inv | simp add: o_def)+) lemma zombies_final_helper: @@ -449,6 +448,7 @@ lemma decode_cnode_inv_wf[wp]: (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) \ decode_cnode_invocation mi args cap cs \valid_cnode_inv\,-" + including no_pre apply (rule decode_cnode_cases2[where args=args and exs=cs and label=mi]) -- "Move/Insert" apply (simp add: decode_cnode_invocation_def unlessE_whenE @@ -487,11 +487,10 @@ lemma decode_cnode_inv_wf[wp]: apply (fastforce simp: is_untyped_update_cap_data weak_derived_update_cap_data[OF _ weak_derived_refl]) - apply (wp get_cap_cte_wp_at ensure_empty_cte_wp_at) + apply (wp get_cap_cte_wp_at ensure_empty_cte_wp_at)+ apply simp apply (fold validE_R_def) - apply (rule hoare_pre) - apply (wp lookup_slot_for_cnode_op_cap_to) + apply (rule hoare_pre, wp lookup_slot_for_cnode_op_cap_to) apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) -- "Revoke" apply (simp add: decode_cnode_invocation_def unlessE_whenE cong: if_cong) @@ -531,14 +530,14 @@ lemma decode_cnode_inv_wf[wp]: \ ex_cte_cap_wp_to is_cnode_cap rv s \ ex_cte_cap_wp_to is_cnode_cap x s \ invs s" in hoare_post_imp_R) - apply wp + apply wp+ apply (clarsimp simp: cte_wp_at_caps_of_state dest!: real_cte_at_cte del: impI) apply (frule invs_valid_objs) apply (simp add: update_cap_data_validI weak_derived_update_cap_data caps_of_state_valid_cap) - apply (auto,(clarsimp simp:is_cap_simps update_cap_data_def)+)[1](* Bad practise *) - apply wp + subgoal by (auto,(clarsimp simp:is_cap_simps update_cap_data_def)+)[1](* Bad practise *) + apply wp+ apply clarsimp apply (elim disjE exE conjE, simp_all add: decode_cnode_invocation_def validE_R_def @@ -724,12 +723,8 @@ lemma cap_swap_fd_not_recursive: \ p1 \ p2\ cap_swap_for_delete p1 p2 \\rv s. card (not_recursive_cspaces s) < n\" - apply(simp add: cap_swap_for_delete_def) - apply(wp cap_swap_not_recursive) - apply(clarsimp) - apply(wp get_cap_wp) - apply(clarsimp) - done + unfolding cap_swap_for_delete_def + by (wpsimp wp: cap_swap_not_recursive get_cap_wp) lemma set_mrs_typ_at [wp]: @@ -1034,7 +1029,7 @@ next show ?case apply (subst rec_del_simps) apply (simp only: split_def) - apply (wp wp "2.hyps", assumption+) + apply (wp wp "2.hyps") apply (wp wp)[1] apply (simp only: simp_thms) apply (rule "2.hyps", assumption+) @@ -1377,7 +1372,7 @@ lemma cap_swap_mdb [wp]: apply (simp add: valid_mdb_def2 cap_swap_def set_cdt_def bind_assoc set_original_def) apply (wp | simp del: fun_upd_apply split del: if_split)+ apply (fold swap_mdb_def [simplified Let_def]) - apply (wp set_cap_caps_of_state2 get_cap_wp) + apply (wp set_cap_caps_of_state2 get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state simp del: fun_upd_apply) apply (subgoal_tac "mdb_swap_abs_invs (cdt s) a b s cap capb c c'") prefer 2 @@ -1390,7 +1385,7 @@ lemma cap_swap_mdb [wp]: apply assumption apply (erule (3) mdb_swap_abs_invs_axioms.intro) apply (unfold swap_mdb_def Let_def) - apply (simp add: mdb_swap_abs_invs.no_mloop_n + apply (simp add: mdb_swap_abs_invs.no_mloop_n mdb_swap_abs_invs.untyped_mdb_n mdb_swap_abs_invs.mdb_cte_n mdb_swap_abs_invs.reply_mdb_n @@ -1400,7 +1395,7 @@ lemma cap_swap_mdb [wp]: apply (erule mdb_swap_abs_invs.descendants_inc_n) apply (rule conjI) apply (erule mdb_swap_abs_invs.untyped_inc_n) - apply (clarsimp simp: cte_wp_at_caps_of_state)+ + apply (clarsimp simp:cte_wp_at_caps_of_state)+ apply (rule conjI) apply (simp add: ut_revocable_def weak_derived_ranges del: split_paired_All) apply (rule conjI) @@ -1445,7 +1440,7 @@ lemma cap_swap_iflive[wp]: apply (simp only: if_live_then_nonz_cap_def ex_nonz_cap_to_def cte_wp_at_caps_of_state imp_conv_disj) apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift hoare_vcg_ex_lift - get_cap_wp) + get_cap_wp)+ apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (frule(1) if_live_then_nonz_capD) apply assumption @@ -1503,7 +1498,7 @@ lemma cap_swap_caps_of_state[wp]: cap_swap c a c' b \\rv s. P (caps_of_state s)\" apply (simp add: cap_swap_def) - apply (wp get_cap_wp | simp split del: if_split)+ + apply (wp get_cap_wp | simp del: fun_upd_apply split del: if_split)+ done @@ -1913,17 +1908,16 @@ context CNodeInv_AI begin lemma cap_swap_cap_refs_respects_device_region[wp]: "\cap_refs_respects_device_region and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\rv. cap_refs_respects_device_region\" - apply (rule hoare_pre) apply (simp add:cap_swap_def) apply wp - apply (simp add: cap_refs_respects_device_region_def) - apply (rule hoare_strengthen_post[OF CSpace_AI.set_cdt_cap_refs_respects_device_region]) - apply simp - apply wp - apply (clarsimp simp add: cap_refs_respects_device_region_def cte_wp_at_caps_of_state - cap_range_respects_device_region_def - simp del: split_paired_All split_paired_Ex split_paired_all - | wp hoare_vcg_all_lift hoare_vcg_imp_lift)+ + apply (simp add: cap_refs_respects_device_region_def) + apply (rule hoare_strengthen_post[OF CSpace_AI.set_cdt_cap_refs_respects_device_region]) + apply simp + apply wp+ + apply (clarsimp simp add: cap_refs_respects_device_region_def cte_wp_at_caps_of_state + cap_range_respects_device_region_def + simp del: split_paired_All split_paired_Ex + | (wp hoare_vcg_all_lift hoare_vcg_imp_lift)+)+ apply (frule_tac x = a in spec) apply (frule_tac x = b in spec) apply (clarsimp simp: weak_derived_cap_range) @@ -2030,7 +2024,7 @@ lemma rec_del_abort_cases: apply (simp only: rec_del_call.simps split_def) apply wp apply (simp add: cte_wp_at_caps_of_state) - apply (wp wp, assumption+) + apply (wp wp)+ apply (wp irq_state_independent_AI | simp)+ apply (rule hoare_strengthen_post) apply (rule finalise_cap_cases[where slot=slot]) @@ -2041,6 +2035,7 @@ lemma rec_del_abort_cases: qed (simp_all add: rec_del_fails) done + lemma rec_del_delete_cases: "\sl ex. \\ :: 'state_ext state \ bool\ @@ -2050,16 +2045,18 @@ lemma rec_del_delete_cases: using rec_del_abort_cases [where args="FinaliseSlotCall sl ex"] apply (subst rec_del_simps_ext, simp add: split_def) apply wp - apply (rule hoare_strengthen_post [OF empty_slot_deletes]) + apply (rule hoare_strengthen_post [OF empty_slot_deletes]) + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (rule use_spec, rule spec_strengthen_postE, assumption) apply (clarsimp simp: cte_wp_at_caps_of_state) - apply (rule use_spec, rule spec_strengthen_postE) - apply assumption - apply (clarsimp simp: cte_wp_at_caps_of_state) + apply assumption done done lemma cap_delete_deletes: + notes hoare_pre [wp_pre del] + shows "\p. \\ :: 'state_ext state \ bool\ cap_delete p @@ -2250,28 +2247,12 @@ lemma of_bl_eq_0: "\ of_bl xs = (0 :: ('a :: len) word); length xs \ len_of TYPE('a) \ \ \n. xs = replicate n False" apply (rule exI) - apply (rule word_same_bl_memo_unify_word_type[where 'a='a]) - apply simp - apply simp - apply simp + apply (rule word_same_bl_memo_unify_word_type[where 'a='a]; simp) done -lemma cte_at_length: - "\ cte_at p s; valid_objs s \ - \ length (snd p) < (word_bits - cte_level_bits)" - unfolding cte_at_cases - apply (erule disjE) - apply clarsimp - apply (drule cap_table_at_length[rotated, where oref="fst p"]) - apply (fastforce simp: obj_at_def is_cap_table_def) - apply (clarsimp simp: well_formed_cnode_n_def) - apply (drule(1) dom_eqD) - apply clarsimp - apply (clarsimp simp: tcb_cap_cases_def tcb_cnode_index_def to_bl_1 - word_bits_def cte_level_bits_def) - apply auto - done +(* FIXME: eliminate *) +lemmas cte_at_length = cte_at_length_limit context CNodeInv_AI begin @@ -2404,8 +2385,7 @@ crunch emptyable[wp]: cancel_signal "emptyable sl" lemma cap_delete_one_emptyable[wp]: "\invs and emptyable sl and cte_at sl'\ cap_delete_one sl' \\_. emptyable sl\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) - apply (wp hoare_strengthen_post [OF get_cap_inv]) - apply simp + apply (wpsimp wp: get_cap_wp) done @@ -2787,11 +2767,11 @@ lemma cap_delete_rvk_prog: cap_delete ptr \\rv s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s)\,-" unfolding cap_delete_def validE_R_def - apply (wp | simp)+ - apply (rule hoare_pre, - rule use_spec) + apply wpsimp + apply (unfold validE_R_def) + apply (rule use_spec) apply (rule rec_del_rvk_prog) - apply simp + apply (simp add: o_def) done end @@ -3028,8 +3008,8 @@ proof (induct rule: cap_revoke_induct) case (1 slot) show ?case apply (subst cap_revoke_simps) - apply (wp "1.hyps", assumption+) - apply (wp x p hoare_drop_imps select_wp) + apply (wp "1.hyps") + apply (wp x p hoare_drop_imps select_wp)+ apply simp_all done qed @@ -3052,8 +3032,8 @@ proof (induct rule: cap_revoke_induct) case (1 slot) show ?case apply (subst cap_revoke_simps) - apply (wp "1.hyps", assumption+) - apply (wp x p hoare_drop_imps select_wp) + apply (wp "1.hyps") + apply (wp x p hoare_drop_imps select_wp)+ apply (simp_all add: y) done qed @@ -3183,12 +3163,11 @@ lemma set_cdt_caps_of_state[wp]: lemma cap_move_caps_of_state: - "\\s. P ((caps_of_state s) (ptr' \ cap, ptr \ cap.NullCap ))\ - cap_move cap ptr ptr' - \\rv s. P (caps_of_state s)\" - apply (simp add: cap_move_def) - apply (wp | simp)+ - done + notes fun_upd_apply [simp del] + shows "\\s. P ((caps_of_state s) (ptr' \ cap, ptr \ cap.NullCap ))\ + cap_move cap ptr ptr' + \\rv s. P (caps_of_state s)\" + by (wpsimp simp: cap_move_def) lemma zombies_duplicate_creation: @@ -3249,7 +3228,7 @@ lemma cap_move_if_live[wp]: apply (rule hoare_post_imp, simp only: if_live_then_nonz_cap_def) apply (simp only: ex_nonz_cap_to_def cte_wp_at_caps_of_state imp_conv_disj) - apply (wp hoare_vcg_disj_lift hoare_vcg_all_lift) + apply (wp hoare_vcg_disj_lift hoare_vcg_all_lift)+ apply (clarsimp simp: if_live_then_nonz_cap_def ex_nonz_cap_to_def cte_wp_at_caps_of_state del: allI @@ -3292,7 +3271,7 @@ lemma cap_move_if_unsafe [wp]: apply (wp | simp)+ apply (rule hoare_post_imp, simp only: if_unsafe_then_cap_def) apply (simp only: ex_cte_cap_wp_to_def cte_wp_at_caps_of_state) - apply wp + apply wp+ apply (clarsimp simp: if_unsafe_then_cap_def ex_cte_cap_wp_to_def cte_wp_at_caps_of_state simp del: split_paired_All split_paired_Ex @@ -3600,19 +3579,12 @@ lemma invoke_cnode_invs[wp]: apply (intro conjI, (fastforce simp: cte_wp_at_caps_of_state dest: real_cte_weak_derived_not_reply_masterD)+)[1] - apply simp - apply (rule hoare_pre) - apply (wp hoare_drop_imps|wpc)+ - apply simp - apply (wp get_cap_wp) - apply (clarsimp simp: all_rights_def) + apply (wpsimp wp: hoare_drop_imps get_cap_wp)+ apply (rule conjI) apply (clarsimp elim!: cte_wp_valid_cap) apply (clarsimp simp: real_cte_tcb_valid cte_wp_at_caps_of_state is_cap_simps ex_cte_cap_to_cnode_always_appropriate_strg) - apply simp - apply (rule hoare_pre) - apply (wp | wpc | simp)+ + apply (wpsimp) done end diff --git a/proof/invariant-abstract/CSpaceInv_AI.thy b/proof/invariant-abstract/CSpaceInv_AI.thy index feae94d90..f98e1bbf3 100644 --- a/proof/invariant-abstract/CSpaceInv_AI.thy +++ b/proof/invariant-abstract/CSpaceInv_AI.thy @@ -575,15 +575,8 @@ lemma set_cap_aligned [wp]: set_cap c p \\rv. pspace_aligned\" apply (simp add: set_cap_def split_def) - apply (rule hoare_seq_ext [OF _ get_object_sp]) - apply (wp set_object_aligned) - apply (case_tac obj, simp_all split del: if_split) - apply clarsimp - apply wp - apply (clarsimp simp: a_type_def obj_at_def wf_cs_upd - fun_upd_def[symmetric]) - apply (rule hoare_pre, wp) - apply (simp add: obj_at_def a_type_def) + apply (wp set_object_aligned get_object_wp | wpc)+ + apply (auto simp: a_type_def obj_at_def wf_cs_upd fun_upd_def[symmetric]) done @@ -592,69 +585,51 @@ lemma set_cap_refs_of [wp]: set_cap cp p \\rv s. P (state_refs_of s)\" apply (simp add: set_cap_def set_object_def split_def) - apply (rule hoare_seq_ext [OF _ get_object_sp]) - apply (case_tac obj, simp_all split del: if_split) - apply wp - apply (rule hoare_pre, wp) - apply (clarsimp elim!: rsubst[where P=P] - simp: state_refs_of_def obj_at_def - intro!: ext) - apply (rule hoare_pre, wp) - apply (clarsimp simp: state_refs_of_def obj_at_def) - apply (clarsimp elim!: rsubst[where P=P] intro!: ext | rule conjI)+ + apply (wp get_object_wp | wpc)+ + apply (auto elim!: rsubst[where P=P] + simp: state_refs_of_def obj_at_def + intro!: ext + split: if_split_asm) done lemma set_cap_distinct [wp]: "\pspace_distinct\ set_cap c p \\rv. pspace_distinct\" apply (simp add: set_cap_def split_def) - apply (rule hoare_seq_ext [OF _ get_object_sp]) - apply (wp set_object_distinct) - apply (case_tac obj, simp_all split del: if_split) - apply clarsimp - apply wpx - apply (clarsimp simp: a_type_def obj_at_def wf_cs_upd - fun_upd_def[symmetric]) - apply (rule hoare_pre, wp) - apply (simp add: obj_at_def a_type_def) + apply (wp set_object_distinct get_object_wp | wpc)+ + apply (auto simp: a_type_def obj_at_def wf_cs_upd fun_upd_def[symmetric]) done lemma set_cap_cur [wp]: "\cur_tcb\ set_cap c p \\rv. cur_tcb\" apply (simp add: set_cap_def set_object_def split_def) - apply (wp) - prefer 2 - apply (rule get_object_sp) - apply (case_tac obj, simp_all split del: if_split) - apply clarsimp - apply wp - apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb) - apply (rule hoare_pre, wp) - apply (clarsimp simp add: cur_tcb_def obj_at_def is_tcb) + apply (wp get_object_wp | wpc)+ + apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb) done lemma set_cap_pred_tcb [wp]: "\pred_tcb_at proj P t\ set_cap c p \\rv. pred_tcb_at proj P t\" apply (simp add: set_cap_def set_object_def split_def) - apply (wp) - prefer 2 - apply (rule get_object_sp) - apply (case_tac obj) - apply (simp_all del: fun_upd_apply) - apply (clarsimp simp: pred_tcb_at_def obj_at_def tcb_to_itcb_def |rule conjI|wp)+ + apply (wp get_object_wp | wpc)+ + apply (auto simp: pred_tcb_at_def obj_at_def tcb_to_itcb_def) done + lemma set_cap_live[wp]: "\\s. P (obj_at live p' s)\ set_cap cap p \\rv s. P (obj_at live p' s)\" apply (simp add: set_cap_def split_def set_object_def) + apply (wp get_object_wp | wpc)+ + apply (auto simp: obj_at_def) + (* apply (rule hoare_seq_ext [OF _ get_object_sp]) apply (case_tac obj, simp_all split del: if_split) apply (rule hoare_pre, wp) apply (clarsimp simp: obj_at_def) apply (rule hoare_pre, wp) apply (clarsimp simp: obj_at_def) + *) done @@ -759,10 +734,7 @@ crunch it[wp]: set_cap "\s. P (idle_thread s)" lemma set_cap_refs [wp]: "\\x. P (global_refs x)\ set_cap cap p \\_ x. P (global_refs x)\" - apply (rule global_refs_lift) - apply wp - done - + by (rule global_refs_lift) wp+ lemma set_cap_globals [wp]: "\valid_global_refs and (\s. global_refs s \ cap_range cap = {})\ @@ -1247,7 +1219,7 @@ lemma delete_duplicate_ifunsafe: wp hoare_vcg_all_lift hoare_vcg_disj_lift hoare_vcg_ex_lift) apply (rule hoare_use_eq [where f=interrupt_irq_node]) - apply (wp set_cap_cte_wp_at) + apply (wp set_cap_cte_wp_at)+ apply simp apply (elim conjE allEI) apply (clarsimp del: disjCI intro!: disjCI2) @@ -1317,6 +1289,10 @@ lemma set_cap_idle: "\\s. valid_idle s\ set_cap cap p \\rv. valid_idle\" + apply (simp add: valid_idle_def set_cap_def set_object_def split_def) + apply (wp get_object_wp|wpc)+ + apply (auto simp: pred_tcb_at_def obj_at_def is_tcb_def) + (* apply (simp add: valid_idle_def) apply (simp add: set_cap_def set_object_def split_def) apply wp @@ -1324,6 +1300,7 @@ lemma set_cap_idle: apply (rule get_object_sp) apply (case_tac obj, simp_all split del: if_split) apply ((clarsimp simp: pred_tcb_at_def obj_at_def is_tcb_def|rule conjI|wp)+)[2] + *) done @@ -1399,16 +1376,16 @@ lemma cap_irqs_must_be_irqhandler: "irq \ cap_irqs cap \ cap by (simp add: cap_irqs_def cap_irq_opt_def split: cap.splits) lemma cap_insert_irq_handlers[wp]: - "\\s. valid_irq_handlers s + shows "\\s. valid_irq_handlers s \ cte_wp_at (\cap'. \irq \ cap_irqs cap - cap_irqs cap'. irq_issued irq s) src s\ cap_insert cap src dest \\rv. valid_irq_handlers\" apply (simp add: cap_insert_def set_untyped_cap_as_full_def update_cdt_def set_cdt_def set_original_def) apply (wp | simp split del: if_split)+ - apply (wp set_cap_irq_handlers get_cap_wp) - apply (clarsimp simp: is_cap_simps ) - apply (wp set_cap_cte_wp_at get_cap_wp) + apply (wp set_cap_irq_handlers get_cap_wp)+ + apply (clarsimp simp: is_cap_simps) + apply (wp set_cap_cte_wp_at get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state valid_irq_handlers_def) apply (clarsimp simp: free_index_update_def dest!: cap_irqs_must_be_irqhandler @@ -1645,7 +1622,8 @@ lemma set_cap_cap_refs_respects_device_region_replaceable: done lemma set_cap_valid_ioc[wp]: - "\valid_ioc and (\s. p = cap.NullCap \ \ is_original_cap s pt)\ + notes hoare_pre [wp_pre del] + shows "\valid_ioc and (\s. p = cap.NullCap \ \ is_original_cap s pt)\ set_cap p pt \\_. valid_ioc\" apply (simp add: set_cap_def split_def) @@ -1666,7 +1644,8 @@ lemma set_cap_valid_ioc[wp]: obj_at_def valid_ioc_def cte_wp_at_cases split: Structures_A.kernel_object.splits) apply (intro conjI allI impI) - apply fastforce+ + apply fastforce + apply fastforce apply (rule ccontr, clarsimp) apply (drule spec, frule spec, erule impE, assumption) apply (drule_tac x="snd pt" in spec) @@ -1718,6 +1697,7 @@ lemma descendants_inc_minor: apply simp done + crunch cte_wp_at: set_cdt "cte_wp_at P p" @@ -1823,16 +1803,17 @@ lemma cap_insert_zombies: \\rv. zombies_final\" apply (simp add: cap_insert_def set_untyped_cap_as_full_def) apply (wp| simp split del: if_split)+ - apply (wp new_cap_zombies get_cap_wp set_cap_cte_wp_at) + apply (wp new_cap_zombies get_cap_wp set_cap_cte_wp_at)+ apply (rule hoare_vcg_conj_lift) apply (clarsimp simp: is_cap_simps) - apply (wp set_cap_zombies get_cap_wp set_cap_cte_wp_at hoare_allI) + apply (wp set_cap_zombies get_cap_wp set_cap_cte_wp_at hoare_allI)+ apply (clarsimp simp: is_cap_simps free_index_update_def cte_wp_at_caps_of_state | rule conjI)+ apply (fastforce) apply (clarsimp simp: is_cap_simps free_index_update_def cte_wp_at_caps_of_state | rule conjI)+ apply (fastforce) done + definition masked_as_full :: "cap \ cap \ cap" where "masked_as_full src_cap new_cap \ if is_untyped_cap src_cap \ is_untyped_cap new_cap \ @@ -1851,7 +1832,7 @@ lemma set_untyped_cap_as_full_cte_wp_at: apply (intro impI conjI allI) apply (wp set_cap_cte_wp_at) apply (clarsimp simp: free_index_update_def cte_wp_at_caps_of_state is_cap_simps - max_free_index_def masked_as_full_def) + max_free_index_def masked_as_full_def) apply (intro conjI,elim disjE) apply clarsimp+ apply wp @@ -1876,9 +1857,9 @@ lemma cap_insert_ex_cap: \\rv. ex_nonz_cap_to p\" apply (simp add: cap_insert_def) apply (wp|simp split del: if_split)+ - apply (wp set_cap_cap_to get_cap_wp set_cap_cte_wp_at set_untyped_cap_as_full_cte_wp_at) + apply (wp set_cap_cap_to get_cap_wp set_cap_cte_wp_at set_untyped_cap_as_full_cte_wp_at)+ apply (clarsimp simp: set_untyped_cap_as_full_def split del: if_splits) - apply (wp set_cap_cap_to get_cap_wp) + apply (wp set_cap_cap_to get_cap_wp)+ apply (clarsimp elim!: cte_wp_at_weakenE simp: is_cap_simps cte_wp_at_caps_of_state) apply (simp add: masked_as_full_def) done @@ -1889,7 +1870,7 @@ lemma cap_insert_iflive: apply (simp add: cap_insert_def set_untyped_cap_as_full_def) apply (wp get_cap_wp set_cap_cte_wp_at | simp split del: if_split)+ apply (rule new_cap_iflive) - apply (wp set_cap_iflive set_cap_cte_wp_at get_cap_wp) + apply (wp set_cap_iflive set_cap_cte_wp_at get_cap_wp)+ apply (clarsimp simp: is_cap_simps cte_wp_at_caps_of_state) done @@ -1924,7 +1905,7 @@ lemma cap_insert_ifunsafe: apply (wp get_cap_wp | simp split del: if_split)+ apply (rule new_cap_ifunsafe) apply (simp add: set_untyped_cap_as_full_def split del: if_splits) - apply (wp set_cap_cte_wp_at set_cap_ifunsafe set_cap_cte_cap_wp_to get_cap_wp) + apply (wp set_cap_cte_wp_at set_cap_ifunsafe set_cap_cte_cap_wp_to get_cap_wp)+ apply (clarsimp simp: is_cap_simps cte_wp_at_caps_of_state) apply (rule untyped_cap_update_ex_cte_cap_wp_to) apply (simp add: free_index_update_def)+ @@ -1973,7 +1954,7 @@ lemma cap_insert_cap_wp_to[wp]: apply (rule_tac x = a in exI) apply (rule_tac x = b in exI) apply clarsimp -done + done lemma ex_cte_cap_to_cnode_always_appropriate_strg: @@ -2041,11 +2022,10 @@ lemma set_untyped_cap_full_valid_objs: "\valid_objs and cte_wp_at (op = cap) slot\ set_untyped_cap_as_full cap cap_new slot \\r. valid_objs\" - apply (simp add: set_untyped_cap_as_full_def split del: if_splits) - apply (rule hoare_pre) + apply (simp add: set_untyped_cap_as_full_def split del: if_split) apply (wp set_cap_valid_objs) - apply (clarsimp simp: valid_cap_free_index_update tcb_cap_valid_caps_of_stateD - cte_wp_at_caps_of_state caps_of_state_valid_cap) + apply (clarsimp simp: valid_cap_free_index_update tcb_cap_valid_caps_of_stateD + cte_wp_at_caps_of_state caps_of_state_valid_cap) done @@ -2053,10 +2033,7 @@ lemma set_untyped_cap_as_full_valid_cap: "\valid_cap cap\ set_untyped_cap_as_full src_cap cap src \\rv. valid_cap cap\" - apply (clarsimp simp: set_untyped_cap_as_full_def) - apply (rule hoare_pre) - apply (wp set_cap_valid_cap,simp) - done + by (clarsimp simp:set_untyped_cap_as_full_def) (wp set_cap_valid_cap) lemma set_untyped_cap_as_full_tcb_cap_valid: diff --git a/proof/invariant-abstract/CSpace_AI.thy b/proof/invariant-abstract/CSpace_AI.thy index 5574f30ab..f011dcdcb 100644 --- a/proof/invariant-abstract/CSpace_AI.thy +++ b/proof/invariant-abstract/CSpace_AI.thy @@ -194,7 +194,7 @@ proof (induct args arbitrary: s rule: resolve_address_bits'.induct) apply (subst resolve_address_bits'.simps) apply (cases cap, simp_all split del: if_split) defer 6 (* CNode *) - apply wp[11] + apply (wp+)[11] apply (simp add: split_def cong: if_cong split del: if_split) apply (rule hoare_pre_spec_validE) apply (wp P [OF "1.hyps"], (simp add: in_monad | rule conjI refl)+) @@ -429,9 +429,7 @@ lemma get_cap_cte_wp_at: lemma get_cap_sp: "\P\ get_cap p \\rv. P and cte_wp_at (\c. c = rv) p\" - apply (wp get_cap_cte_wp_at) - apply simp - done + by (wp get_cap_cte_wp_at) lemma wf_cs_nD: "\ f x = Some y; well_formed_cnode_n n f \ \ length x = n" @@ -1930,29 +1928,29 @@ lemma cap_insert_mdb_cte_at: apply (wp update_cdt_mdb_cte_at set_cap_mdb_cte_at[simplified swp_def] | simp split del: if_split)+ apply wps apply (wp valid_case_option_post_wp hoare_vcg_if_lift hoare_impI mdb_cte_at_set_untyped_cap_as_full[simplified swp_def] - set_cap_cte_wp_at get_cap_wp) + set_cap_cte_wp_at get_cap_wp)+ apply (clarsimp simp:free_index_update_def split:cap.splits) - apply (wp) + apply (wp)+ apply (clarsimp simp:if_True conj_comms split del:if_splits cong:prod.case_cong_weak) apply (wps) apply (wp valid_case_option_post_wp get_cap_wp hoare_vcg_if_lift - hoare_impI set_untyped_cap_as_full_cte_wp_at ) + hoare_impI set_untyped_cap_as_full_cte_wp_at )+ apply (unfold swp_def) apply (intro conjI | clarify)+ - apply (clarsimp simp:free_index_update_def split:cap.splits) - apply (drule mdb_cte_at_cte_wp_at[simplified swp_def]) - apply simp - apply (simp add:cte_wp_at_caps_of_state) - apply (clarsimp split del:if_splits split:option.splits - simp: cte_wp_at_caps_of_state not_sym[OF is_derived_not_Null] neq_commute)+ + apply (clarsimp simp:free_index_update_def split:cap.splits) + apply (drule mdb_cte_at_cte_wp_at[simplified swp_def]) + apply simp + apply (simp add:cte_wp_at_caps_of_state) + apply (clarsimp split del: if_split split:option.splits + simp: cte_wp_at_caps_of_state not_sym[OF is_derived_not_Null] neq_commute)+ apply (drule imp_rev) - apply (clarsimp split:if_splits cap.splits - simp:free_index_update_def is_cap_simps masked_as_full_def) - apply (subst (asm) mdb_cte_at_def,elim allE impE,simp,clarsimp simp:cte_wp_at_caps_of_state)+ - apply (clarsimp split:if_splits cap.splits - simp:free_index_update_def is_cap_simps masked_as_full_def) - apply (subst (asm) mdb_cte_at_def,elim allE impE,simp,clarsimp simp:cte_wp_at_caps_of_state)+ -done + apply (clarsimp split:if_splits cap.splits + simp:free_index_update_def is_cap_simps masked_as_full_def) + apply (subst (asm) mdb_cte_at_def,elim allE impE,simp,clarsimp simp:cte_wp_at_caps_of_state)+ + apply (clarsimp split: if_splits cap.splits + simp: free_index_update_def is_cap_simps masked_as_full_def) + apply (subst (asm) mdb_cte_at_def,elim allE impE,simp,clarsimp simp:cte_wp_at_caps_of_state)+ + done lemma mdb_cte_at_rewrite: @@ -2046,7 +2044,7 @@ lemma reply_mdb_update_free_index: apply (drule_tac x = t in spec) apply (erule impE) apply (clarsimp split:cap.splits if_splits) - apply (auto intro:conjI impI) + apply auto done @@ -2054,18 +2052,17 @@ lemma set_untyped_cap_as_full_valid_mdb: "\valid_mdb and cte_wp_at (op = src_cap) src\ set_untyped_cap_as_full src_cap c src \\rv. valid_mdb\" - apply (simp add:valid_mdb_def set_untyped_cap_as_full_def split del:if_splits) - apply (rule hoare_pre) + apply (simp add:valid_mdb_def set_untyped_cap_as_full_def split del: if_split) apply (wp set_cap_mdb_cte_at) apply (wps set_cap_rvk_cdt_ct_ms) - apply wp + apply wp+ apply clarsimp apply (intro conjI impI) - apply (clarsimp simp:is_cap_simps free_index_update_def split:cap.splits)+ - apply (simp_all add:cte_wp_at_caps_of_state) - unfolding fun_upd_def[symmetric] - apply (simp_all add: untyped_mdb_update_free_index reply_mdb_update_free_index - untyped_inc_update_free_index) + apply (clarsimp simp:is_cap_simps free_index_update_def split:cap.splits)+ + apply (simp_all add:cte_wp_at_caps_of_state) + unfolding fun_upd_def[symmetric] + apply (simp_all add: untyped_mdb_update_free_index reply_mdb_update_free_index + untyped_inc_update_free_index) apply (erule descendants_inc_minor) apply (clarsimp simp:cte_wp_at_caps_of_state swp_def) apply (clarsimp simp: free_index_update_def cap_range_def split:cap.splits) @@ -2079,12 +2076,12 @@ lemma set_free_index_valid_mdb: \\rv s'. valid_mdb s'\" apply (simp add:valid_mdb_def) apply (rule hoare_pre) - apply (wp set_cap_mdb_cte_at) - apply (wps set_cap_rvk_cdt_ct_ms) - apply wp - apply (clarsimp simp:cte_wp_at_caps_of_state is_cap_simps free_index_of_def - reply_master_revocable_def irq_revocable_def reply_mdb_def - simp del:untyped_range.simps usable_untyped_range.simps) + apply (wp set_cap_mdb_cte_at) + apply (wps set_cap_rvk_cdt_ct_ms) + apply wp + apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps free_index_of_def + reply_master_revocable_def irq_revocable_def reply_mdb_def + simp del: untyped_range.simps usable_untyped_range.simps) unfolding fun_upd_def[symmetric] apply (simp) apply (frule(1) caps_of_state_valid) @@ -2105,17 +2102,17 @@ lemma set_free_index_valid_mdb: assume cmp: "f \ idx" "idx \ 2 ^ bits" have subset_range: "usable_untyped_range (cap.UntypedCap dev r bits idx) \ usable_untyped_range (cap.UntypedCap dev r bits f)" using cmp valid - apply (clarsimp simp:valid_cap_def cap_aligned_def) - apply (rule word_plus_mono_right) - apply (rule of_nat_mono_maybe_le[THEN iffD1]) + apply (clarsimp simp:valid_cap_def cap_aligned_def) + apply (rule word_plus_mono_right) + apply (rule of_nat_mono_maybe_le[THEN iffD1]) apply (subst word_bits_def[symmetric]) apply (erule less_le_trans[OF _ power_increasing]) apply simp apply simp - apply (subst word_bits_def[symmetric]) - apply (erule le_less_trans) - apply (erule less_le_trans[OF _ power_increasing]) - apply simp+ + apply (subst word_bits_def[symmetric]) + apply (erule le_less_trans) + apply (erule less_le_trans[OF _ power_increasing]) + apply simp+ apply (erule is_aligned_no_wrap') apply (rule word_of_nat_less) apply (simp add: word_bits_def) @@ -2125,21 +2122,21 @@ lemma set_free_index_valid_mdb: show "untyped_inc (cdt s) (caps_of_state s(cref \ cap.UntypedCap dev r bits idx))" using inc cstate apply (unfold untyped_inc_def) - apply (intro allI impI) - apply (drule_tac x = p in spec) - apply (drule_tac x = p' in spec) - apply (case_tac "p = cref") + apply (intro allI impI) + apply (drule_tac x = p in spec) + apply (drule_tac x = p' in spec) + apply (case_tac "p = cref") + apply (simp) + apply (case_tac "p' = cref") + apply simp + apply (simp add:untyped_range_simp) + apply (intro conjI impI) apply (simp) - apply (case_tac "p' = cref") - apply simp - apply (simp add:untyped_range_simp) - apply (intro conjI impI) - apply (simp) - apply (elim conjE) - apply (drule disjoint_subset2[OF subset_range,rotated]) - apply simp+ - using subset_range - apply clarsimp + apply (elim conjE) + apply (drule disjoint_subset2[OF subset_range,rotated]) + apply simp+ + using subset_range + apply clarsimp apply (case_tac "p' = cref") apply simp apply (intro conjI) @@ -2266,53 +2263,53 @@ lemma cap_insert_mdb [wp]: apply (subgoal_tac "mdb_insert_abs (cdt s) src dest") prefer 2 apply (rule mdb_insert_abs.intro,simp+) - apply (erule mdb_cte_at_cdt_null,simp) + apply (erule mdb_cte_at_cdt_null,simp) apply (rule mdb_cte_at_Null_descendants) - apply (assumption) + apply (assumption) apply (simp add:mdb_cte_at_rewrite) apply (subgoal_tac "mdb_insert_abs_sib (cdt s) src dest") prefer 2 apply (erule mdb_insert_abs_sib.intro) apply (fold revokable_def) apply (case_tac "should_be_parent_of capa (is_original_cap s src) cap (revokable capa cap)") - apply simp - apply (frule (4) mdb_insert_abs.untyped_mdb) - apply (frule (4) mdb_insert_abs.reply_mdb) - apply (simp) - apply (rule conjI) - apply (simp add: no_mloop_def mdb_insert_abs.parency) - apply (intro allI impI conjI) - apply (rule_tac m1 = "caps_of_state s(dest\ cap)" - and src1 = src in iffD2[OF untyped_mdb_update_free_index,rotated,rotated]) - apply (simp add:fun_upd_twist)+ - apply (drule_tac cs' = "caps_of_state s(src \ max_free_index_update capa)" in descendants_inc_minor) - apply (clarsimp simp:cte_wp_at_caps_of_state swp_def) - apply clarsimp - apply (subst upd_commute) - apply simp - apply (erule(1) mdb_insert_abs.descendants_inc) - apply simp - apply (clarsimp dest!:is_derived_cap_class_range) - apply (rule notI) - apply (simp add: mdb_insert_abs.dest_no_parent_trancl) - apply (erule mdb_insert_abs.untyped_inc_simple) - apply (rule_tac m = "caps_of_state s" and src = src in untyped_inc_update_free_index) - apply (simp add:fun_upd_twist)+ - apply (frule_tac p = src in caps_of_state_valid,assumption) - apply (clarsimp simp:valid_cap_def) - apply clarsimp+ - apply (clarsimp simp:is_cap_simps)+ - apply (simp add:is_derived_def) - apply (clarsimp simp:is_cap_simps) - apply (clarsimp simp:ut_revocable_def is_cap_simps revokable_def) - apply (clarsimp simp: irq_revocable_def) - apply (intro impI conjI) - apply (clarsimp simp:is_cap_simps free_index_update_def)+ - apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) - apply clarsimp - apply (rule_tac m1 = "caps_of_state s(dest\ cap)" - and src1 = src in reply_mdb_update_free_index[THEN iffD2]) - apply ((simp add:fun_upd_twist)+)[3] + apply simp + apply (frule (4) mdb_insert_abs.untyped_mdb) + apply (frule (4) mdb_insert_abs.reply_mdb) + apply (simp) + apply (rule conjI) + apply (simp add: no_mloop_def mdb_insert_abs.parency) + apply (intro allI impI conjI) + apply (rule_tac m1 = "caps_of_state s(dest\ cap)" + and src1 = src in iffD2[OF untyped_mdb_update_free_index,rotated,rotated]) + apply (simp add:fun_upd_twist)+ + apply (drule_tac cs' = "caps_of_state s(src \ max_free_index_update capa)" in descendants_inc_minor) + apply (clarsimp simp:cte_wp_at_caps_of_state swp_def) + apply clarsimp + apply (subst upd_commute) + apply simp + apply (erule(1) mdb_insert_abs.descendants_inc) + apply simp + apply (clarsimp dest!:is_derived_cap_class_range) + apply (rule notI) + apply (simp add: mdb_insert_abs.dest_no_parent_trancl) + apply (erule mdb_insert_abs.untyped_inc_simple) + apply (rule_tac m = "caps_of_state s" and src = src in untyped_inc_update_free_index) + apply (simp add:fun_upd_twist)+ + apply (frule_tac p = src in caps_of_state_valid,assumption) + apply (clarsimp simp:valid_cap_def) + apply clarsimp+ + apply (clarsimp simp:is_cap_simps)+ + apply (simp add:is_derived_def) + apply (clarsimp simp:is_cap_simps) + apply (clarsimp simp:ut_revocable_def is_cap_simps revokable_def) + apply (clarsimp simp: irq_revocable_def) + apply (intro impI conjI) + apply (clarsimp simp:is_cap_simps free_index_update_def)+ + apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) + apply clarsimp + apply (rule_tac m1 = "caps_of_state s(dest\ cap)" + and src1 = src in reply_mdb_update_free_index[THEN iffD2]) + apply ((simp add:fun_upd_twist)+)[3] apply (simp add: no_mloop_def mdb_insert_abs.parency) apply (intro impI conjI allI) apply (erule(1) mdb_insert_abs.descendants_inc) @@ -2322,67 +2319,66 @@ lemma cap_insert_mdb [wp]: apply (simp add: mdb_insert_abs.dest_no_parent_trancl) apply (frule_tac p = src in caps_of_state_valid,assumption) apply (erule mdb_insert_abs.untyped_inc) - apply simp+ - apply (simp add:valid_cap_def) - apply simp+ - apply (clarsimp simp:is_derived_def is_cap_simps cap_master_cap_simps dest!:cap_master_cap_eqDs) + apply simp+ + apply (simp add:valid_cap_def) + apply simp+ + apply (clarsimp simp:is_derived_def is_cap_simps cap_master_cap_simps dest!:cap_master_cap_eqDs) apply (clarsimp simp:ut_revocable_def is_cap_simps,simp add:revokable_def) apply (clarsimp simp: irq_revocable_def) apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) - apply (clarsimp) - apply (intro impI conjI allI) - apply (rule_tac m1 = "caps_of_state s(dest\ cap)" - and src1 = src in iffD2[OF untyped_mdb_update_free_index,rotated,rotated]) - apply (frule mdb_insert_abs_sib.untyped_mdb_sib) - apply (simp add:fun_upd_twist)+ - apply (drule_tac cs' = "caps_of_state s(src \ max_free_index_update capa)" in descendants_inc_minor) - apply (clarsimp simp:cte_wp_at_caps_of_state swp_def) - apply clarsimp - apply (subst upd_commute) - apply simp - apply (erule(1) mdb_insert_abs_sib.descendants_inc) - apply simp - apply (clarsimp dest!:is_derived_cap_class_range) - apply (simp add: no_mloop_def) - apply (simp add: mdb_insert_abs_sib.parent_n_eq) - apply (simp add: mdb_insert_abs.dest_no_parent_trancl) - apply (rule_tac m = "caps_of_state s(dest\ cap)" and src = src in untyped_inc_update_free_index) - apply (simp add:fun_upd_twist)+ - apply (frule(3) mdb_insert_abs_sib.untyped_inc) + apply (clarsimp) + apply (intro impI conjI allI) + apply (rule_tac m1 = "caps_of_state s(dest\ cap)" + and src1 = src in iffD2[OF untyped_mdb_update_free_index,rotated,rotated]) + apply (frule mdb_insert_abs_sib.untyped_mdb_sib) + apply (simp add:fun_upd_twist)+ + apply (drule_tac cs' = "caps_of_state s(src \ max_free_index_update capa)" in descendants_inc_minor) + apply (clarsimp simp:cte_wp_at_caps_of_state swp_def) + apply clarsimp + apply (subst upd_commute) + apply simp + apply (erule(1) mdb_insert_abs_sib.descendants_inc) + apply simp + apply (clarsimp dest!:is_derived_cap_class_range) + apply (simp add: no_mloop_def) + apply (simp add: mdb_insert_abs_sib.parent_n_eq) + apply (simp add: mdb_insert_abs.dest_no_parent_trancl) + apply (rule_tac m = "caps_of_state s(dest\ cap)" and src = src in untyped_inc_update_free_index) + apply (simp add:fun_upd_twist)+ + apply (frule(3) mdb_insert_abs_sib.untyped_inc) apply (frule_tac p = src in caps_of_state_valid,assumption) apply (simp add:valid_cap_def) apply (simp add:valid_cap_def, - clarsimp simp:ut_revocable_def,case_tac src, - clarsimp elim!: allE impE,simp) + clarsimp simp:ut_revocable_def,case_tac src, + clarsimp,simp) apply (clarsimp simp:ut_revocable_def is_cap_simps revokable_def) apply (clarsimp simp: irq_revocable_def) apply (intro impI conjI) apply (clarsimp simp:is_cap_simps free_index_update_def)+ apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) - apply (rule_tac m1 = "caps_of_state s(dest\ cap)" - and src1 = src in iffD2[OF reply_mdb_update_free_index,rotated,rotated]) + apply (rule_tac m1 = "caps_of_state s(dest\ cap)" + and src1 = src in iffD2[OF reply_mdb_update_free_index,rotated,rotated]) apply (frule mdb_insert_abs_sib.reply_mdb_sib,simp+) - apply (clarsimp simp:ut_revocable_def,case_tac src,clarsimp elim!: allE impE,simp) + apply (clarsimp simp:ut_revocable_def,case_tac src,clarsimp,simp) apply (simp add:fun_upd_twist)+ - apply (frule mdb_insert_abs_sib.untyped_mdb_sib) + apply (frule mdb_insert_abs_sib.untyped_mdb_sib) apply (simp add:fun_upd_twist)+ - apply (erule(1) mdb_insert_abs_sib.descendants_inc) - apply simp - apply (clarsimp dest!: is_derived_cap_class_range) - apply (simp add: no_mloop_def) - apply (simp add: mdb_insert_abs_sib.parent_n_eq) - apply (simp add: mdb_insert_abs.dest_no_parent_trancl) - apply (frule(3) mdb_insert_abs_sib.untyped_inc) - apply (simp add:valid_cap_def) - apply (case_tac src,clarsimp simp:ut_revocable_def elim!:allE impE) - apply simp - apply (clarsimp simp:ut_revocable_def is_cap_simps,simp add: revokable_def) + apply (erule(1) mdb_insert_abs_sib.descendants_inc) + apply simp + apply (clarsimp dest!: is_derived_cap_class_range) + apply (simp add: no_mloop_def) + apply (simp add: mdb_insert_abs_sib.parent_n_eq) + apply (simp add: mdb_insert_abs.dest_no_parent_trancl) + apply (frule(3) mdb_insert_abs_sib.untyped_inc) + apply (simp add:valid_cap_def) + apply (case_tac src,clarsimp simp:ut_revocable_def) + apply simp + apply (clarsimp simp:ut_revocable_def is_cap_simps,simp add: revokable_def) apply (clarsimp simp: irq_revocable_def) - apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) - apply (frule mdb_insert_abs_sib.reply_mdb_sib,simp+) - apply (clarsimp simp:reply_master_revocable_def,case_tac src,clarsimp elim!: allE impE) - apply simp - apply clarsimp + apply (clarsimp simp: reply_master_revocable_def is_derived_def is_master_reply_cap_def) + apply (frule mdb_insert_abs_sib.reply_mdb_sib,simp+) + apply (clarsimp simp:reply_master_revocable_def,case_tac src,clarsimp) + apply simp done lemma swp_cte_at_cdt_update [iff]: @@ -2448,23 +2444,20 @@ lemma connect_eqv_singleE': assumes single:"\p p'. ((p,p') \ m) = ((p,p')\ m')" shows "((p,p')\ m\<^sup>*) = ((p,p')\ m'\<^sup>*)" apply (case_tac "p = p'") - apply simp + apply simp apply (rule iffI) - apply (drule rtranclD) - apply clarsimp - apply (rule trancl_into_rtrancl) - apply (simp add:connect_eqv_singleE[OF single]) + apply (drule rtranclD) + apply clarsimp + apply (rule trancl_into_rtrancl) + apply (simp add:connect_eqv_singleE[OF single]) apply (drule rtranclD) apply clarsimp apply (rule trancl_into_rtrancl) apply (simp add:connect_eqv_singleE[OF single]) -done - -lemma identity_eq :"(op = x) = (\c. c = x)" - apply (rule ext) - apply auto done +lemma identity_eq :"(op = x) = (\c. c = x)" + by (rule ext) auto lemma forall_eq: "(\x. P x = Q x) \ (\x. P x) = (\b. Q b)" by auto @@ -2480,18 +2473,17 @@ lemma dom_in: lemma same_region_as_masked_as_full[simp]: "same_region_as (masked_as_full src_cap c) = same_region_as src_cap" apply (rule ext)+ - apply (case_tac src_cap) - apply (clarsimp simp:masked_as_full_def is_cap_simps free_index_update_def split:if_splits)+ -done + apply (case_tac src_cap; + clarsimp simp:masked_as_full_def is_cap_simps free_index_update_def split:if_splits) + done lemma should_be_parent_of_masked_as_full[simp]: "should_be_parent_of (masked_as_full src_cap c) = should_be_parent_of src_cap" apply (rule ext)+ apply (clarsimp simp:should_be_parent_of_def) - apply (case_tac src_cap) - apply (simp_all add:masked_as_full_def is_cap_simps free_index_update_def split:if_splits) -done + apply (case_tac src_cap; simp add:masked_as_full_def is_cap_simps free_index_update_def) + done lemma cte_at_get_cap: @@ -3491,17 +3483,19 @@ lemma set_cdt_iflive[wp]: lemma set_untyped_cap_as_full_cap_to: + notes hoare_pre [wp_pre del] + shows "\\s. if_live_then_nonz_cap s \ cte_wp_at (op = src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. if_live_then_nonz_cap s\" apply (clarsimp simp:if_live_then_nonz_cap_def set_untyped_cap_as_full_def | rule conjI | wp hoare_allI)+ - apply (wp hoare_vcg_imp_lift set_cap_cap_to) + apply (wp hoare_vcg_imp_lift set_cap_cap_to)+ apply clarsimp - apply (elim allE impE) + apply (elim allE impE) apply simp apply (simp add:cte_wp_at_caps_of_state) apply (clarsimp|wp)+ -done + done lemma tcb_cap_slot_regular: @@ -3532,10 +3526,9 @@ lemma set_free_index_valid_pspace: \\rv s'. valid_pspace s'\" apply (clarsimp simp: valid_pspace_def) apply (wp set_cap_valid_objs update_cap_iflive set_cap_zombies') - apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)+ + apply (clarsimp simp:cte_wp_at_caps_of_state is_cap_simps)+ apply (frule(1) caps_of_state_valid) - apply (clarsimp simp: valid_cap_def cap_aligned_def - free_index_update_def) + apply (clarsimp simp:valid_cap_def cap_aligned_def free_index_update_def) apply (intro conjI) apply (clarsimp simp: valid_untyped_def) apply (elim impE allE) @@ -3556,8 +3549,7 @@ lemma set_free_index_valid_pspace: apply (erule is_aligned_no_wrap') apply (rule word_of_nat_less) apply (simp add: word_bits_def) - apply (clarsimp simp add: pred_tcb_at_def tcb_cap_valid_def obj_at_def is_tcb - valid_ipc_buffer_cap_def + apply (clarsimp simp add: pred_tcb_at_def tcb_cap_valid_def obj_at_def is_tcb valid_ipc_buffer_cap_def split: option.split) apply (frule tcb_cap_slot_regular) apply simp+ @@ -3634,19 +3626,18 @@ lemma cap_insert_valid_pspace: apply (wp hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_imp_lift) apply clarsimp apply (wp hoare_vcg_disj_lift set_untyped_cap_as_full_cte_wp_at_neg - set_untyped_cap_as_full_cte_wp_at) - apply (wp get_cap_wp) + set_untyped_cap_as_full_cte_wp_at get_cap_wp)+ apply (intro allI impI conjI) - apply (clarsimp simp:cte_wp_at_caps_of_state )+ + apply (clarsimp simp: cte_wp_at_caps_of_state)+ apply (rule ccontr) - apply clarsimp - apply (drule bspec) + apply clarsimp + apply (drule bspec) apply simp - apply (drule_tac x = xa in spec,drule_tac x = xb in spec) - apply (subgoal_tac "(xa,xb) = src") - apply (clarsimp simp: masked_as_full_def if_distrib split:if_splits) - apply clarsimp -done + apply (drule_tac x = xa in spec,drule_tac x = xb in spec) + apply (subgoal_tac "(xa,xb) = src") + apply (clarsimp simp: masked_as_full_def if_distrib split:if_splits) + apply clarsimp + done lemma set_cdt_idle [wp]: @@ -3672,7 +3663,7 @@ lemmas cap_insert_typ_ats [wp] = abs_typ_at_lifts [OF cap_insert_typ_at] lemma cap_insert_idle [wp]: "\valid_idle\ cap_insert cap src dest \\_. valid_idle\" - by (rule valid_idle_lift) wp + by (rule valid_idle_lift; wp) crunch reply[wp]: set_cdt "valid_reply_caps" @@ -3684,7 +3675,7 @@ lemma set_untyped_cap_as_full_has_reply_cap: \\rv s. (has_reply_cap t s)\" apply (clarsimp simp:has_reply_cap_def) apply (wp hoare_ex_wp) - apply (wp set_untyped_cap_as_full_cte_wp_at) + apply (wp set_untyped_cap_as_full_cte_wp_at) apply (clarsimp simp:cte_wp_at_caps_of_state) apply (rule_tac x = a in exI) apply (rule_tac x = b in exI) @@ -3698,7 +3689,7 @@ lemma set_untyped_cap_as_full_has_reply_cap_neg: \\rv s. \ (has_reply_cap t s)\" apply (clarsimp simp:has_reply_cap_def) apply (wp hoare_vcg_all_lift) - apply (wp set_untyped_cap_as_full_cte_wp_at_neg) + apply (wp set_untyped_cap_as_full_cte_wp_at_neg) apply (clarsimp simp:cte_wp_at_caps_of_state) apply (drule_tac x = x in spec) apply (drule_tac x = xa in spec) @@ -3715,29 +3706,29 @@ lemma set_untyped_cap_as_full_unique_reply_caps: "\\s. unique_reply_caps (caps_of_state s) \ cte_wp_at (op = src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. unique_reply_caps (caps_of_state s)\" - apply (simp add:unique_reply_caps_def ) - apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift) + apply (simp add:unique_reply_caps_def) + apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift) apply (clarsimp simp:caps_of_state_cte_wp_at_neq) - apply (wp set_untyped_cap_as_full_cte_wp_at_neg) - apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift) + apply (wp set_untyped_cap_as_full_cte_wp_at_neg)+ + apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift)+ apply (clarsimp simp:caps_of_state_cte_wp_at_neq) - apply (wp set_untyped_cap_as_full_cte_wp_at_neg) + apply (wp set_untyped_cap_as_full_cte_wp_at_neg)+ apply clarsimp - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (drule_tac x = x in spec,drule_tac x = xa in spec) - apply (drule_tac x = xb in spec,drule_tac x = xc in spec) + apply (clarsimp simp:cte_wp_at_caps_of_state) + apply (drule_tac x = x in spec,drule_tac x = xa in spec) + apply (drule_tac x = xb in spec,drule_tac x = xc in spec) apply (case_tac "(x,xa) = src") - apply simp - apply (erule disjE) + apply simp + apply (erule disjE) apply (clarsimp simp:masked_as_full_def if_distrib split:if_splits) - apply (clarsimp simp:is_cap_simps masked_as_full_def free_index_update_def - split:if_splits) + apply (clarsimp simp:is_cap_simps masked_as_full_def free_index_update_def + split:if_splits) apply clarsimp apply (case_tac "(xb,xc) = src") - apply (clarsimp simp:is_cap_simps masked_as_full_def free_index_update_def - split:if_splits) + apply (clarsimp simp:is_cap_simps masked_as_full_def free_index_update_def + split:if_splits) apply clarsimp -done + done lemma set_untyped_cap_as_full_valid_reply_masters: @@ -3745,13 +3736,12 @@ lemma set_untyped_cap_as_full_valid_reply_masters: set_untyped_cap_as_full src_cap cap src \\rv s. valid_reply_masters s \" apply (clarsimp simp:set_untyped_cap_as_full_def) - apply (intro conjI impI) - apply wp - apply (clarsimp simp: cte_wp_at_caps_of_state free_index_update_def - split:cap.splits) + apply (intro conjI impI) + apply wp + apply (clarsimp simp: cte_wp_at_caps_of_state free_index_update_def split:cap.splits) apply wp apply clarsimp -done + done crunch global_refs[wp]: set_untyped_cap_as_full "\s. P (global_refs s)" @@ -3777,10 +3767,10 @@ lemma cap_insert_reply [wp]: | simp split del: if_split | rule hoare_drop_imp | clarsimp simp: valid_reply_caps_def)+ - apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift set_untyped_cap_as_full_has_reply_cap_neg - set_untyped_cap_as_full_unique_reply_caps set_untyped_cap_as_full_cte_wp_at get_cap_wp) + apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift set_untyped_cap_as_full_has_reply_cap_neg + set_untyped_cap_as_full_unique_reply_caps set_untyped_cap_as_full_cte_wp_at get_cap_wp)+ apply (clarsimp simp:cte_wp_at_caps_of_state valid_reply_caps_def)+ -done + done crunch reply_masters[wp]: set_cdt "valid_reply_masters" @@ -3799,7 +3789,7 @@ lemma cap_insert_reply_masters [wp]: lemma cap_insert_valid_arch [wp]: "\valid_arch_state\ cap_insert cap src dest \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift; wp) crunch caps [wp]: update_cdt "\s. P (caps_of_state s)" @@ -3810,7 +3800,7 @@ crunch irq_node [wp]: update_cdt "\s. P (interrupt_irq_node s)" lemma update_cdt_global [wp]: "\valid_global_refs\ update_cdt m \\_. valid_global_refs\" - by (rule valid_global_refs_cte_lift) wp + by (rule valid_global_refs_cte_lift; wp) lemma cap_insert_valid_global_refs[wp]: @@ -3818,11 +3808,9 @@ lemma cap_insert_valid_global_refs[wp]: cap_insert cap src dest \\_. valid_global_refs\" apply (simp add: cap_insert_def) - apply (rule hoare_pre) - apply (wp get_cap_wp|simp split del: if_split)+ + apply (wp get_cap_wp|simp split del: if_split)+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (simp add: valid_global_refs_def valid_refs_def2) - apply (drule bspec, blast intro: ranI) apply blast done @@ -3856,16 +3844,16 @@ lemma unique_table_refs_upd_eqD: apply (erule_tac x=p in allE) apply (erule_tac x=p' in allE) apply (erule_tac x=b' in allE) - apply simp + apply simp apply (case_tac "a=p'") + apply (erule_tac x=p in allE) + apply (erule_tac x=p' in allE) + apply (erule_tac x=cap in allE) + apply simp apply (erule_tac x=p in allE) apply (erule_tac x=p' in allE) apply (erule_tac x=cap in allE) apply simp - apply (erule_tac x=p in allE) - apply (erule_tac x=p' in allE) - apply (erule_tac x=cap in allE) - apply simp apply (intro allI impI) apply (case_tac "p=p'") apply (thin_tac " \p. P p" for P) @@ -3874,7 +3862,7 @@ lemma unique_table_refs_upd_eqD: apply (erule_tac x=p in allE) apply (erule_tac x=p' in allE) apply (erule_tac x=b in allE) - apply simp + apply simp apply (case_tac "a=p'") apply (erule_tac x=p in allE) apply (erule_tac x=p' in allE) @@ -3938,8 +3926,8 @@ lemma set_untyped_cap_as_full_obj_at_impossible: \\rv s. P (obj_at P' p s)\" apply (clarsimp simp:set_untyped_cap_as_full_def) apply (intro conjI impI) - apply (wp set_cap_obj_at_impossible) - apply clarsimp + apply (wp set_cap_obj_at_impossible)+ + apply clarsimp done @@ -4147,7 +4135,7 @@ lemma prop_is_preserved_imp: lemma derive_cap_inv[wp]: "\P\ derive_cap slot c \\rv. P\" - apply (case_tac c, simp_all add: derive_cap_def ensure_no_children_def whenE_def is_zombie_def, wp) + apply (case_tac c, simp_all add: derive_cap_def ensure_no_children_def whenE_def is_zombie_def, wp+) apply clarsimp apply (wp arch_derive_cap_inv | simp)+ done @@ -4204,6 +4192,7 @@ lemma cap_swap_cte_at: lemma tcb_cap_valid_typ_st: + notes hoare_pre [wp_pre del] assumes x: "\P t. \\s. P (typ_at ATCB t s)\ f \\rv s. P (typ_at ATCB t s)\" and y: "\P t. \st_tcb_at P t\ f \\rv. st_tcb_at P t\" and z: "\P t. \\s. \tcb. ko_at (TCB tcb) t s \ P (tcb_ipc_buffer tcb)\ @@ -4286,13 +4275,7 @@ locale CSpace_AI_7 = CSpace_AI_6 state_ext_t lemma lookup_cap_valid: "\valid_objs\ lookup_cap t c \\rv. valid_cap rv\,-" - apply (simp add: lookup_cap_def split_def) - apply wp - apply (rule hoare_post_impErr) - apply (rule valid_validE) - apply (rule lookup_slot_for_thread_inv) - apply auto - done + by (simp add: lookup_cap_def split_def) wp lemma mask_cap_is_zombie[simp]: @@ -4318,9 +4301,10 @@ lemma guarded_lookup_valid_cap: "\valid_objs\ null_cap_on_failure (lookup_cap t c) \\rv. valid_cap rv \" apply (simp add: null_cap_on_failure_def) apply wp - apply (rule hoare_strengthen_post) - apply (rule lookup_cap_valid [unfolded validE_R_def validE_def]) - apply (simp split: sum.splits) + apply (rule hoare_strengthen_post) + apply (rule lookup_cap_valid [unfolded validE_R_def validE_def]) + apply (simp split: sum.splits) + apply assumption done crunch inv[wp]: lookup_slot_for_cnode_op "P" @@ -4333,9 +4317,8 @@ lemma lsfco_cte_at[wp]: \\rv. cte_at rv\,-" apply (simp add: lookup_slot_for_cnode_op_def split_def unlessE_def whenE_def split del: if_split cong: if_cong) - apply (rule hoare_pre) - apply (wp | wpc | simp)+ - apply (wp hoare_drop_imps resolve_address_bits_cte_at) + apply (wp | wpc | simp)+ + apply (wp hoare_drop_imps resolve_address_bits_cte_at)+ apply auto done @@ -4353,7 +4336,7 @@ proof - apply (wp | simp)+ apply (rule hoare_drop_imps) apply (unfold unlessE_def whenE_def) - apply (wp rab_cte_cap_to) + apply (wp rab_cte_cap_to)+ apply clarsimp done qed @@ -4411,12 +4394,11 @@ lemma ensure_empty_stronger: "\\s. cte_wp_at (\c. c = cap.NullCap) p s \ P s\ ensure_empty p \\rv. P\,-" apply (simp add: ensure_empty_def whenE_def) apply wp - apply simp - apply (simp only: imp_conv_disj) - apply (rule hoare_vcg_disj_lift) - apply (wp get_cap_cte_wp_at3) - apply (simp add: pred_neg_def) - apply wp + apply simp + apply (simp only: imp_conv_disj) + apply (rule hoare_vcg_disj_lift) + apply (wp get_cap_cte_wp_at3)+ + apply (simp add: pred_neg_def) done @@ -5038,11 +5020,10 @@ proof - show ?thesis apply (simp add: lookup_slot_for_cnode_op_def split_def x split del: if_split cong: if_cong) - apply (rule hoare_pre) - apply (wp | simp)+ - apply (rule hoare_drop_imps) - apply (unfold unlessE_def whenE_def) - apply (wp rab_cte_cap_to) + apply (wp | simp)+ + apply (rule hoare_drop_imps) + apply (unfold unlessE_def whenE_def) + apply (wp rab_cte_cap_to)+ apply clarsimp done qed diff --git a/proof/invariant-abstract/DetSchedAux_AI.thy b/proof/invariant-abstract/DetSchedAux_AI.thy index 43a98ea48..104305d69 100644 --- a/proof/invariant-abstract/DetSchedAux_AI.thy +++ b/proof/invariant-abstract/DetSchedAux_AI.thy @@ -121,16 +121,13 @@ lemma typ_at_pred_tcb_at_lift: lemma create_cap_no_pred_tcb_at: "\\s. \ pred_tcb_at proj P t s\ create_cap apiobject_type nat' prod' dev x \\r s. \ pred_tcb_at proj P t s\" - apply (rule typ_at_pred_tcb_at_lift) - apply wp - done + by (rule typ_at_pred_tcb_at_lift; wp) -lemma cap_insert_no_pred_tcb_at: "\\s. \ pred_tcb_at proj P t s\ - cap_insert cap src dest - \\r s. \ pred_tcb_at proj P t s\" - apply (rule typ_at_pred_tcb_at_lift) - apply wp - done +lemma cap_insert_no_pred_tcb_at: + "\\s. \ pred_tcb_at proj P t s\ + cap_insert cap src dest + \\r s. \ pred_tcb_at proj P t s\" + by (rule typ_at_pred_tcb_at_lift; wp) locale DetSchedAux_AI = @@ -161,11 +158,7 @@ locale DetSchedAux_AI_det_ext = DetSchedAux_AI "TYPE(det_ext)" + lemma delete_objects_valid_etcbs[wp]: "\valid_etcbs\ delete_objects a b \\_. valid_etcbs\" apply (simp add: delete_objects_def) - apply wp - apply (simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def) - apply (rule hoare_pre) - apply (simp add: do_machine_op_def) - apply (wp|wpc)+ + apply (wpsimp simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def do_machine_op_def) apply (simp add: valid_etcbs_def st_tcb_at_kh_def obj_at_kh_def obj_at_def is_etcb_at_def) done @@ -208,11 +201,7 @@ lemma retype_region_valid_blocked[wp]: lemma delete_objects_valid_blocked[wp]: "\valid_blocked\ delete_objects a b \\_. valid_blocked\" apply (simp add: delete_objects_def) - apply wp - apply (simp add: detype_def detype_ext_def wrap_ext_det_ext_ext_def) - apply (rule hoare_pre) - apply (simp add: do_machine_op_def) - apply (wp|wpc)+ + apply (wpsimp simp: detype_def detype_ext_def wrap_ext_det_ext_ext_def do_machine_op_def) apply (simp add: valid_blocked_def st_tcb_at_kh_def obj_at_kh_def obj_at_def is_etcb_at_def) done @@ -276,11 +265,9 @@ lemma valid_sched_tcb_state_preservation: apply (simp add: ct_in_state_def) apply (erule pred_tcb_weakenE) apply simp - apply (case_tac "itcb_state tcb") - apply simp+ + apply (case_tac "itcb_state tcb"; simp) apply (erule pred_tcb_weakenE) - apply (case_tac "itcb_state tcb") - apply simp+ + apply (case_tac "itcb_state tcb"; simp) apply (rule conjI) apply clarsimp apply (rule_tac use_valid[OF _ st_tcb],assumption) @@ -330,25 +317,25 @@ lemma invoke_untyped_valid_sched: "\invs and valid_untyped_inv ui and ct_active and valid_sched and valid_idle \ invoke_untyped ui \ \_ . valid_sched \" + including no_pre apply (rule hoare_pre) apply (rule_tac I="invs and valid_untyped_inv ui and ct_active" in valid_sched_tcb_state_preservation) apply (wp invoke_untyped_st_tcb_at) apply simp - apply (wp invoke_untyped_etcb_at) + apply (wp invoke_untyped_etcb_at)+ apply (rule hoare_post_impErr, rule hoare_pre, rule invoke_untyp_invs, simp_all add: invs_valid_idle)[1] apply (rule_tac f="\s. P (scheduler_action s)" in hoare_lift_Pf) apply (rule_tac f="\s. x (ready_queues s)" in hoare_lift_Pf) - apply wp - apply simp + apply wp+ + apply simp+ done end + lemmas hoare_imp_lift_something = hoare_convert_imp - - crunch valid_queues[wp]: create_cap,cap_insert valid_queues (wp: valid_queues_lift) diff --git a/proof/invariant-abstract/DetSchedDomainTime_AI.thy b/proof/invariant-abstract/DetSchedDomainTime_AI.thy index c21d3740d..cbf60912b 100644 --- a/proof/invariant-abstract/DetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/DetSchedDomainTime_AI.thy @@ -323,9 +323,10 @@ lemma schedule_domain_time_left: apply (simp add: schedule_def) apply (wp|wpc)+ apply (rule_tac Q="\_. valid_domain_list" in hoare_post_imp, fastforce) - apply wp + apply wp+ apply (rule_tac Q="\_. ?P" in hoare_post_imp, fastforce) - apply wp + apply wp+ + apply assumption done lemma reschedule_required_valid_domain_time: @@ -352,7 +353,7 @@ lemma handle_interrupt_valid_domain_time: apply (rule_tac Q="\_ s. 0 < domain_time s" in hoare_post_imp, fastforce) apply wp apply (rule_tac Q="\_ s. 0 < domain_time s" in hoare_post_imp, fastforce) - apply wp + apply wp+ apply simp (* dxo_eq *) apply (clarsimp simp: timer_tick_def num_domains_def) apply (wp reschedule_required_valid_domain_time @@ -377,11 +378,10 @@ lemma call_kernel_domain_time_inv_det_ext: apply wp apply fastforce+ (* now non-interrupt case; may throw but does not touch domain_time in handle_event *) - apply (rule hoare_pre) - apply (wp schedule_domain_time_left without_preemption_wp handle_interrupt_valid_domain_time) + apply (wp schedule_domain_time_left without_preemption_wp handle_interrupt_valid_domain_time) apply (rule_tac Q="\_ s. 0 < domain_time s \ valid_domain_list s" in hoare_post_imp) apply fastforce - apply (wp handle_event_domain_time_inv) + apply (wp handle_event_domain_time_inv)+ apply (rule_tac Q'="\_ s. 0 < domain_time s" in hoare_post_imp_R) apply (wp handle_event_domain_time_inv) apply fastforce+ diff --git a/proof/invariant-abstract/DetSchedInvs_AI.thy b/proof/invariant-abstract/DetSchedInvs_AI.thy index 8a3186e2e..4d2fddeef 100644 --- a/proof/invariant-abstract/DetSchedInvs_AI.thy +++ b/proof/invariant-abstract/DetSchedInvs_AI.thy @@ -315,12 +315,12 @@ lemma valid_blocked_lift: and d: "\P. \\s. P (ready_queues s)\ f \\rv s. P (ready_queues s)\" shows "\valid_blocked\ f \\rv. valid_blocked\" apply (rule hoare_pre) - apply (wps c e d) - apply (simp add: valid_blocked_def) - apply (wp_trace hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift static_imp_wp a) - apply (rule hoare_convert_imp) - apply (rule typ_at_st_tcb_at_lift) - apply (wp a t) + apply (wps c e d) + apply (simp add: valid_blocked_def) + apply (wp_trace hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift static_imp_wp a) + apply (rule hoare_convert_imp) + apply (rule typ_at_st_tcb_at_lift) + apply (wp a t)+ apply (simp add: valid_blocked_def) done @@ -382,7 +382,7 @@ lemma valid_sched_action_lift: apply (rule hoare_vcg_conj_lift) apply (rule hoare_lift_Pf[where f="\s. scheduler_action s", OF _ c]) apply (simp add: is_activatable_def) - apply (wp weak_valid_sched_action_lift switch_in_cur_domain_lift static_imp_wp a b c d e) + apply (wp weak_valid_sched_action_lift switch_in_cur_domain_lift static_imp_wp a b c d e)+ done lemma valid_sched_lift: @@ -397,8 +397,8 @@ lemma valid_sched_lift: assumes i: "\P. \\s. P (idle_thread s)\ f \\rv s. P (idle_thread s)\" shows "\valid_sched\ f \\rv. valid_sched\" apply (simp add: valid_sched_def) - apply (intro hoare_vcg_conj_lift) - apply (wp valid_etcbs_lift valid_queues_lift ct_not_in_q_lift ct_in_cur_domain_lift valid_sched_action_lift valid_blocked_lift a b c d e f g h i) + apply (wp valid_etcbs_lift valid_queues_lift ct_not_in_q_lift ct_in_cur_domain_lift + valid_sched_action_lift valid_blocked_lift a b c d e f g h i hoare_vcg_conj_lift) done lemma valid_etcbs_tcb_etcb: @@ -414,7 +414,7 @@ lemma valid_etcbs_get_tcb_get_etcb: lemma valid_etcbs_ko_etcb: "\ valid_etcbs s; kheap s ptr = Some ko \ \ \tcb. (ko = TCB tcb = (\etcb. ekheap s ptr = Some etcb))" - apply (clarsimp simp: valid_etcbs_def valid_etcbs_def st_tcb_at_def obj_at_def is_etcb_at_def) + apply (clarsimp simp: valid_etcbs_def st_tcb_at_def obj_at_def is_etcb_at_def) apply (erule_tac x="ptr" in allE) apply auto done diff --git a/proof/invariant-abstract/DetSchedSchedule_AI.thy b/proof/invariant-abstract/DetSchedSchedule_AI.thy index e342520a1..f3adaed05 100644 --- a/proof/invariant-abstract/DetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/DetSchedSchedule_AI.thy @@ -376,7 +376,7 @@ lemma reschedule_required_valid_blocked: "\valid_blocked\ reschedule_required \\_. valid_blocked\" apply (simp add: reschedule_required_def | wp set_scheduler_action_cnt_valid_blocked tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift | wpc)+ apply (simp add: tcb_sched_action_def) - apply wp + apply wp+ apply clarsimp apply (rule conjI) apply clarsimp @@ -573,7 +573,7 @@ lemma set_thread_state_valid_blocked_except: apply (rule hoare_strengthen_post) apply (rule set_scheduler_action_cnt_valid_blocked_weak) apply simp - apply (wp gts_wp) + apply (wp gts_wp)+ apply (clarsimp simp: valid_blocked_def valid_blocked_except_def st_tcb_at_def obj_at_def) done @@ -646,7 +646,7 @@ lemma switch_to_idle_thread_ct_not_in_q[wp]: apply (simp add: switch_to_idle_thread_def) apply wp apply (simp add: arch_switch_to_idle_thread_def) - apply wp + apply wp+ apply (fastforce simp: valid_queues_def ct_not_in_q_def not_queued_def valid_idle_def pred_tcb_at_def obj_at_def) done @@ -658,7 +658,7 @@ lemma switch_to_idle_thread_valid_sched_action[wp]: apply (simp add: switch_to_idle_thread_def) apply wp apply (simp add: arch_switch_to_idle_thread_def do_machine_op_def split_def) - apply wp + apply wp+ apply (clarsimp simp: valid_sched_action_def valid_idle_def is_activatable_def pred_tcb_at_def obj_at_def) done @@ -724,6 +724,7 @@ context begin interpretation Arch . (*FIXME: arch_split*) lemma switch_to_thread_ct_not_queued[wp]: "\valid_queues\ switch_to_thread t \\rv s. not_queued (cur_thread s) s\" apply (simp add: switch_to_thread_def) + including no_pre apply wp prefer 4 apply (rule get_wp) @@ -756,8 +757,8 @@ lemma switch_to_thread_valid_sched_action[wp]: \\_. valid_sched_action\" apply (simp add: switch_to_thread_def) apply wp - apply simp - apply (wp tcb_sched_action_dequeue_valid_sched_action_2_ct_upd) + apply simp + apply (wp tcb_sched_action_dequeue_valid_sched_action_2_ct_upd)+ apply simp done end @@ -766,10 +767,10 @@ lemma tcb_sched_action_dequeue_ct_in_cur_domain': "\\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\ tcb_sched_action tcb_sched_dequeue thread \\_ s. ct_in_cur_domain (s\cur_thread := thread\)\" -apply (simp add: tcb_sched_action_def) -apply wp -apply (simp add: etcb_at_def split: option.split) -done + apply (simp add: tcb_sched_action_def) + apply wp + apply (simp add: etcb_at_def split: option.split) + done context Arch begin global_naming ARM (*FIXME: arch_split*) crunch ct_in_cur_domain_2[wp]: set_vm_root "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)" @@ -787,6 +788,7 @@ context begin interpretation Arch . (*FIXME: arch_split*) lemma switch_to_thread_ct_in_cur_domain[wp]: "\\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (ekheap s)\ switch_to_thread thread \\_. ct_in_cur_domain\" + including no_pre apply (simp add: switch_to_thread_def) apply wp prefer 4 @@ -1171,7 +1173,7 @@ lemma schedule_valid_sched: apply (wp gts_wp tcb_sched_action_enqueue_valid_blocked tcb_sched_enqueue_cur_ct_in_q)+ apply (auto simp: valid_sched_def weak_valid_sched_action_def valid_etcbs_def switch_in_cur_domain_def - valid_sched_action_def weak_valid_sched_action_def + valid_sched_action_def not_cur_thread_def valid_blocked_def valid_blocked_except_def ct_in_q_def etcb_at_def st_tcb_def2 split: option.splits) @@ -1391,7 +1393,7 @@ lemma set_thread_state_not_runnable_valid_blocked: apply (rule hoare_strengthen_post) apply (rule set_scheduler_action_cnt_valid_blocked_weak) apply simp - apply (wp gts_wp) + apply (wp gts_wp)+ apply (clarsimp simp: valid_blocked_def valid_blocked_except_def st_tcb_at_def obj_at_def get_tcb_def) apply (case_tac ts, simp_all) done @@ -1667,6 +1669,7 @@ lemma tc_valid_sched[wp]: "\valid_sched and simple_sched_action\ invoke_tcb (ThreadControl a sl b mcp pr e f g) \\rv. valid_sched\" + including no_pre apply (simp add: split_def set_mcpriority_def cong: option.case_cong) apply (rule hoare_vcg_precond_imp) apply (wp check_cap_inv thread_set_not_state_valid_sched hoare_vcg_all_lift gts_wp static_imp_wp @@ -1686,10 +1689,10 @@ lemma set_scheduler_action_swt_weak_valid_sched: lemma possible_switch_to_valid_sched: "\valid_sched and st_tcb_at runnable target and (\s. \ on_same_prio \ not_cur_thread target s) and (\s. target \ idle_thread s)\ possible_switch_to target on_same_prio \\rv. valid_sched\" - apply (simp add: possible_switch_to_def | wp static_imp_conj_wp static_imp_wp + apply (simp add: possible_switch_to_def | (wp static_imp_conj_wp static_imp_wp tcb_sched_action_enqueue_valid_blocked reschedule_required_valid_sched - set_scheduler_action_swt_weak_valid_sched | wpc)+ + set_scheduler_action_swt_weak_valid_sched)+ | wpc)+ apply (fastforce simp: etcb_at'_def not_cur_thread_2_def valid_sched_def valid_sched_action_def in_cur_domain_def ct_in_cur_domain_2_def valid_blocked_def valid_blocked_except_def split: option.splits) done @@ -1740,6 +1743,7 @@ crunch etcb_at[wp]: setup_reply_master "etcb_at P t" lemma restart_valid_sched[wp]: "\valid_sched and (\s. thread \ idle_thread s)\ restart thread \\rv. valid_sched\" + including no_pre apply (simp add: restart_def | wp set_thread_state_runnable_valid_queues set_thread_state_runnable_valid_sched_action set_thread_state_valid_blocked_except @@ -1766,11 +1770,10 @@ lemma as_user_valid_sched[wp]: apply (simp add: as_user_def set_object_def) apply (wp | wpc)+ apply clarsimp - apply (fastforce simp: valid_sched_def valid_etcbs_def valid_queues_def - valid_sched_action_def is_activatable_def - weak_valid_sched_action_def st_tcb_at_kh_split_if - st_tcb_def2 valid_blocked_def) - done + by (fastforce simp: valid_sched_def valid_etcbs_def valid_queues_def + valid_sched_action_def is_activatable_def + weak_valid_sched_action_def st_tcb_at_kh_split_if + st_tcb_def2 valid_blocked_def) crunch valid_sched[wp]: bind_notification "valid_sched" @@ -1780,10 +1783,10 @@ crunch it[wp]: suspend "\ s. P (idle_thread s)" lemma invoke_tcb_valid_sched[wp]: "\invs and valid_sched and simple_sched_action and tcb_inv_wf ti\ invoke_tcb ti \\rv. valid_sched\" apply (cases ti, simp_all only:) - apply (wp mapM_x_wp | simp | rule subset_refl | clarsimp simp:invs_valid_objs invs_valid_global_refs idle_no_ex_cap | intro impI conjI)+ - apply (rename_tac option) - apply (case_tac option) - apply (wp mapM_x_wp | simp | rule subset_refl | clarsimp simp:invs_valid_objs invs_valid_global_refs idle_no_ex_cap | intro impI conjI)+ + apply (wp mapM_x_wp | simp | rule subset_refl | clarsimp simp:invs_valid_objs invs_valid_global_refs idle_no_ex_cap | intro impI conjI)+ + apply (rename_tac option) + apply (case_tac option) + apply (wp mapM_x_wp | simp | rule subset_refl | clarsimp simp:invs_valid_objs invs_valid_global_refs idle_no_ex_cap | intro impI conjI)+ done lemma runnable_eq_active: "runnable = active" @@ -1831,7 +1834,7 @@ lemma reschedule_required_switch_valid_blocked: reschedule_required \\_. valid_blocked\" apply (simp add: reschedule_required_def | wp set_scheduler_action_cnt_valid_blocked tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift | wpc)+ apply (simp add: tcb_sched_action_def) - apply wp + apply wp+ apply (force simp: etcb_at_def tcb_sched_enqueue_def valid_blocked_def valid_blocked_except_def split: option.splits) done @@ -1854,12 +1857,12 @@ lemma possible_switch_to_valid_sched': "\valid_sched_except_blocked and valid_blocked_except target and st_tcb_at runnable target and (\s. \ on_same_prio \ not_cur_thread target s) and (\s. target \ idle_thread s)\ possible_switch_to target on_same_prio \\rv. valid_sched\" apply (simp add: possible_switch_to_def) - apply (simp | wp static_imp_conj_wp reschedule_required_switch_valid_sched + apply (simp | (wp static_imp_conj_wp reschedule_required_switch_valid_sched tcb_sched_action_enqueue_valid_blocked - set_scheduler_action_swt_weak_valid_sched' | wpc + set_scheduler_action_swt_weak_valid_sched')+ | wpc | wp_once hoare_vcg_all_lift)+ - apply (simp add: tcb_sched_action_def) - apply (wp static_imp_wp) + apply (simp add: tcb_sched_action_def) + apply (wp static_imp_wp)+ apply (clarsimp simp: etcb_at'_def not_cur_thread_2_def valid_sched_def valid_sched_action_def in_cur_domain_def ct_in_cur_domain_2_def valid_blocked_def valid_blocked_except_def split: option.splits) apply (intro conjI impI) apply (force+)[8] @@ -1891,12 +1894,12 @@ lemma valid_blocked_except_lift: and d: "\P. \\s. P (ready_queues s)\ f \\rv s. P (ready_queues s)\" shows "\valid_blocked_except thread\ f \\rv. valid_blocked_except thread\" apply (rule hoare_pre) - apply (wps c e d) - apply (simp add: valid_blocked_except_def) - apply (wp static_imp_wp hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift a) - apply (rule hoare_convert_imp) - apply (rule typ_at_st_tcb_at_lift) - apply (wp a t) + apply (wps c e d) + apply (simp add: valid_blocked_except_def) + apply (wp static_imp_wp hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift a) + apply (rule hoare_convert_imp) + apply (rule typ_at_st_tcb_at_lift) + apply (wp a t)+ apply (simp add: valid_blocked_except_def) done @@ -1904,7 +1907,7 @@ crunch valid_blocked_except[wp]: as_user "valid_blocked_except thread" (wp: valid_blocked_except_lift) -(* FIXME - Move *) +(* FIXME: Move *) lemma set_notification_valid_sched_action[wp]: "\valid_sched_action\ set_notification ptr ntfn \\rv. valid_sched_action\" @@ -1940,7 +1943,7 @@ lemma set_thread_state_runnable_valid_blocked: apply (rule hoare_strengthen_post) apply (rule set_scheduler_action_cnt_valid_blocked_weak) apply simp - apply (wp gts_wp) + apply (wp gts_wp)+ apply (clarsimp simp: valid_blocked_def st_tcb_at_def obj_at_def get_tcb_def) apply (case_tac "tcb_state y", simp_all) done @@ -2206,10 +2209,10 @@ crunch valid_sched[wp]: cap_move valid_sched lemma invoke_cnode_valid_sched: "\valid_sched and invs and valid_cnode_inv a and simple_sched_action\ invoke_cnode a \\rv. valid_sched\" - apply (rule hoare_pre) apply (simp add: invoke_cnode_def) + apply (rule hoare_pre) apply wpc - apply (simp add: liftE_def | wp hoare_vcg_all_lift | wp_once hoare_drop_imps | wpc)+ + apply (simp add: liftE_def | (wp hoare_vcg_all_lift)+ | wp_once hoare_drop_imps | wpc)+ apply force done @@ -2238,7 +2241,7 @@ lemma do_reply_transfer_valid_sched[wp]: apply (rule_tac Q="\_. valid_sched and (\s. receiver \ idle_thread s)" in hoare_strengthen_post) apply wp apply (simp add: valid_sched_def) - apply (wp attempt_switch_to_valid_sched') + apply (wp attempt_switch_to_valid_sched')+ apply simp apply (rule conjI) apply clarsimp @@ -2315,7 +2318,9 @@ lemma possible_switch_to_sched_act_not[wp]: possible_switch_to target b \\_. scheduler_act_not t\" apply (simp add: possible_switch_to_def reschedule_required_def - set_scheduler_action_def tcb_sched_action_def | wp | wpc)+ + set_scheduler_action_def tcb_sched_action_def + split del: if_split + | wp | wpc)+ apply (clarsimp simp: etcb_at_def scheduler_act_not_def split: option.splits) done @@ -2325,7 +2330,7 @@ lemma possible_switch_to_not_queued: possible_switch_to target b \\_. not_queued t\" apply (simp add: possible_switch_to_def reschedule_required_def - set_scheduler_action_def tcb_sched_action_def | wp | wpc)+ + set_scheduler_action_def tcb_sched_action_def split del: if_split | wp | wpc)+ by (fastforce simp: etcb_at_def tcb_sched_enqueue_def simple_sched_action_def not_queued_def scheduler_act_not_def split: option.splits) @@ -2372,37 +2377,31 @@ lemma send_ipc_valid_sched: send_ipc block call badge can_grant thread epptr \\rv. valid_sched\" apply (simp add: send_ipc_def) apply (wp set_thread_state_sched_act_not_valid_sched | wpc )+ - apply ((wp set_thread_state_sched_act_not_valid_sched setup_caller_cap_sched_act_not_valid_sched attempt_switch_to_valid_sched' hoare_vcg_if_lift2 hoare_drop_imps | simp)+)[5] apply (wp set_thread_state_runnable_valid_queues set_thread_state_runnable_valid_sched_action - set_thread_state_valid_blocked_except sts_st_tcb_at')[1] + set_thread_state_valid_blocked_except sts_st_tcb_at') apply simp apply (rule_tac Q="\_. valid_sched and scheduler_act_not thread and not_queued thread and (\s. x21 \ idle_thread s \ x21 \ thread)" in hoare_strengthen_post) apply ((wp|wpc)+)[1] apply (clarsimp simp: valid_sched_def) - apply (simp | wp gts_wp hoare_vcg_all_lift)+ - apply (wp hoare_vcg_imp_lift) - apply ((simp add: set_endpoint_def set_object_def | wp hoare_drop_imps | wpc)+)[1] - apply (wp hoare_vcg_imp_lift get_object_wp | simp add: get_endpoint_def | wpc | - wp_once hoare_vcg_all_lift)+ - apply (subst st_tcb_at_kh_simp[symmetric]) - apply (clarsimp simp: st_tcb_at_kh_split_if pred_tcb_at_def2 obj_at_def - valid_sched_def valid_sched_action_def - weak_valid_sched_action_def)+ - apply (clarsimp simp: scheduler_act_not_def) - apply (subgoal_tac "xb \ idle_thread s") - apply fastforce - apply clarsimp - apply (frule invs_valid_idle) - apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def) - apply (force simp: scheduler_act_not_def) - apply (clarsimp simp: st_tcb_at_kh_split_if pred_tcb_at_def2 obj_at_def - valid_sched_def valid_sched_action_def - weak_valid_sched_action_def)+ + apply (simp | wp gts_wp hoare_vcg_all_lift)+ + apply (wp hoare_vcg_imp_lift) + apply ((simp add: set_endpoint_def set_object_def | wp hoare_drop_imps | wpc)+)[1] + apply (wp hoare_vcg_imp_lift get_object_wp | simp add: get_endpoint_def | wpc | + wp_once hoare_vcg_all_lift)+ + apply (subst st_tcb_at_kh_simp[symmetric]) + apply (clarsimp simp: st_tcb_at_kh_split_if pred_tcb_at_def2 obj_at_def + valid_sched_def valid_sched_action_def weak_valid_sched_action_def)+ + apply (clarsimp simp: scheduler_act_not_def) + apply (subgoal_tac "xb \ idle_thread s") + apply fastforce + apply clarsimp + apply (frule invs_valid_idle) + apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def) done crunch not_queued[wp]: thread_set "not_queued t" @@ -2452,23 +2451,26 @@ lemma handle_double_fault_valid_sched: handle_double_fault tptr ex1 ex2 \\rv. valid_sched\" apply (simp add: valid_sched_def) - apply (wp handle_double_fault_valid_queues handle_double_fault_valid_sched_action set_thread_state_not_runnable_valid_blocked | rule hoare_conjI | simp add: handle_double_fault_def | fastforce simp: simple_sched_action_def)+ + including no_pre + apply (wp handle_double_fault_valid_queues handle_double_fault_valid_sched_action + set_thread_state_not_runnable_valid_blocked + | rule hoare_conjI | simp add: handle_double_fault_def | fastforce simp: simple_sched_action_def)+ done lemma send_fault_ipc_error_sched_act_not[wp]: "\scheduler_act_not t\ send_fault_ipc tptr fault -, \\rv. scheduler_act_not t\" by (simp add: send_fault_ipc_def Let_def | - wp hoare_drop_imps hoare_vcg_all_lift_R | wpc)+ + (wp hoare_drop_imps hoare_vcg_all_lift_R)+ | wpc)+ lemma send_fault_ipc_error_cur_thread[wp]: "\\s. P (cur_thread s)\ send_fault_ipc tptr fault -, \\rv s. P (cur_thread s)\" by (simp add: send_fault_ipc_def Let_def | - wp hoare_drop_imps hoare_vcg_all_lift_R | wpc)+ + (wp hoare_drop_imps hoare_vcg_all_lift_R)+ | wpc)+ lemma send_fault_ipc_error_not_queued[wp]: "\not_queued t\ send_fault_ipc tptr fault -, \\rv. not_queued t\" by (simp add: send_fault_ipc_def Let_def | - wp hoare_drop_imps hoare_vcg_all_lift_R | wpc)+ + (wp hoare_drop_imps hoare_vcg_all_lift_R)+ | wpc)+ lemma handle_fault_valid_sched: "\valid_sched and st_tcb_at active thread and not_queued thread and scheduler_act_not thread and invs and (\_. valid_fault ex)\ @@ -2537,6 +2539,7 @@ lemma receive_ipc_valid_sched: receive_ipc thread cap is_blocking \\rv. valid_sched\" apply (simp add: receive_ipc_def) + including no_pre apply (wp | wpc | simp)+ apply (wp set_thread_state_sched_act_not_valid_sched | wpc)+ apply ((wp set_thread_state_sched_act_not_valid_sched @@ -2804,7 +2807,7 @@ lemma handle_recv_valid_sched: apply (simp add: lookup_cap_def lookup_slot_for_thread_def) apply wp apply (simp add: split_def) - apply (wp resolve_address_bits_valid_fault2) + apply (wp resolve_address_bits_valid_fault2)+ apply (simp add: valid_fault_def) apply (wp hoare_drop_imps hoare_vcg_all_lift_R) apply (wp delete_caller_cap_not_queued | simp | strengthen invs_valid_tcb_ctable_strengthen)+ @@ -2816,16 +2819,14 @@ lemma handle_recv_valid_sched': "\invs and valid_sched and ct_active and ct_not_queued and scheduler_act_sane\ handle_recv is_blocking \\_. valid_sched\" - apply (rule hoare_pre) - apply (wp handle_recv_valid_sched) + apply (wp handle_recv_valid_sched) apply (simp add: invs_def valid_state_def valid_pspace_def) done crunch valid_sched[wp]: reply_from_kernel valid_sched crunch etcb_at[wp]: cap_insert "\s. etcb_at P t s" - (wp: crunch_wps - simp : cap_insert_ext_def) + (wp: crunch_wps simp: cap_insert_ext_def) context Arch begin global_naming ARM (*FIXME: arch_split*) crunch valid_sched[wp]: perform_page_invocation,perform_page_table_invocation,perform_asid_pool_invocation, perform_page_directory_invocation valid_sched (wp: mapM_x_wp' mapM_wp') @@ -2900,8 +2901,7 @@ lemma ethread_set_valid_blocked_except: lemma tcb_sched_action_valid_idle_etcb[wp]: "\valid_idle_etcb\ tcb_sched_action blah t \\rv. valid_idle_etcb\" - apply(wp valid_idle_etcb_lift) - done + by (wp valid_idle_etcb_lift) context begin interpretation Arch . (*FIXME: arch_split*) lemma invoke_domain_valid_sched[wp]: @@ -2909,9 +2909,15 @@ lemma invoke_domain_valid_sched[wp]: and simple_sched_action and valid_idle\ invoke_domain t d \\_. valid_sched\" apply (simp add: invoke_domain_def) + including no_pre apply wp apply (simp add: set_domain_def thread_set_domain_def) - apply (wp_trace gts_st_tcb_at hoare_vcg_if_lift hoare_vcg_if_lift2 hoare_vcg_imp_lift hoare_vcg_disj_lift ethread_set_not_queued_valid_queues reschedule_required_valid_sched tcb_sched_action_enqueue_valid_blocked ethread_set_valid_blocked_except ethread_set_valid_blocked ethread_set_ssa_valid_sched_action ethread_set_not_cur_ct_in_cur_domain ethread_set_not_idle_valid_sched ethread_set_not_idle_valid_idle_etcb) + apply (wp gts_st_tcb_at hoare_vcg_if_lift hoare_vcg_if_lift2 hoare_vcg_imp_lift + hoare_vcg_disj_lift ethread_set_not_queued_valid_queues reschedule_required_valid_sched + tcb_sched_action_enqueue_valid_blocked ethread_set_valid_blocked_except + ethread_set_valid_blocked ethread_set_ssa_valid_sched_action + ethread_set_not_cur_ct_in_cur_domain ethread_set_not_idle_valid_sched + ethread_set_not_idle_valid_idle_etcb) apply(wp static_imp_wp static_imp_conj_wp tcb_dequeue_not_queued tcb_sched_action_dequeue_valid_blocked_except) apply simp apply (wp hoare_vcg_disj_lift) @@ -2919,7 +2925,8 @@ lemma invoke_domain_valid_sched[wp]: apply (wp tcb_sched_action_dequeue_valid_sched_not_runnable tcb_dequeue_not_queued) apply (simp add: valid_sched_def valid_sched_action_def) apply simp - apply (wp hoare_vcg_disj_lift tcb_dequeue_not_queued tcb_sched_action_dequeue_valid_blocked_except tcb_sched_action_dequeue_valid_sched_not_runnable) + apply (wp hoare_vcg_disj_lift tcb_dequeue_not_queued tcb_sched_action_dequeue_valid_blocked_except + tcb_sched_action_dequeue_valid_sched_not_runnable)+ apply (clarsimp simp: valid_sched_def not_cur_thread_def valid_sched_action_def not_pred_tcb) apply (force simp: pred_tcb_at_def obj_at_def) apply (clarsimp simp: valid_sched_def not_cur_thread_def valid_sched_action_def not_pred_tcb) @@ -2962,7 +2969,7 @@ lemma handle_invocation_valid_sched: apply (simp add: handle_invocation_def) apply (wp syscall_valid handle_fault_valid_sched | wpc)+ apply (wp set_thread_state_runnable_valid_sched)[1] - apply wp + apply wp+ apply (wp gts_wp hoare_vcg_all_lift) apply (rule_tac Q="\_. valid_sched" and E="\_. valid_sched" in hoare_post_impErr) apply wp diff --git a/proof/invariant-abstract/Deterministic_AI.thy b/proof/invariant-abstract/Deterministic_AI.thy index fdc82449b..2ac6ec234 100644 --- a/proof/invariant-abstract/Deterministic_AI.thy +++ b/proof/invariant-abstract/Deterministic_AI.thy @@ -1503,25 +1503,13 @@ definition valid_mdb_weak where "valid_mdb_weak s \ mdb_cte_at (swp (cte_wp_at (op \ NullCap)) s) (cdt s) \ no_mloop (cdt s)" lemma self_parent_eq: "m src = Some src \ m(dest \ src) = m (dest := m src)" - apply simp - done + by simp -lemma "\\!x. P x; (THE x. P x) = a; y \ a\ \ \P y" - apply (rule notI) - apply (frule(1) the1_equality) - apply simp - done - - -lemma ex1_False: "(\x. \P x) \ \ (\!x. P x)" - apply (rule notI) - apply (erule ex1E) - apply simp - done +lemma ex1_False: "(\x. \P x) \ \ (\!x. P x)" by auto lemma set_cap_match: "(\s x. P s = P (s\kheap := x\)) \ \P\ set_cap a b \\_.P\" apply (simp add: set_cap_def split_def set_object_def get_object_def) - apply (wp| wpc | simp)+ + apply wpsimp done crunch all_but_exst[wp]: cap_insert_ext "all_but_exst P" @@ -1529,9 +1517,7 @@ crunch all_but_exst[wp]: cap_insert_ext "all_but_exst P" crunch (empty_fail) empty_fail[wp]: cap_insert_ext interpretation cap_insert_ext_extended: is_extended "cap_insert_ext a b c d e" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) lemma cap_insert_valid_list [wp]: @@ -1555,7 +1541,7 @@ lemma cap_insert_valid_list [wp]: apply (wp set_cap_caps_of_state3) apply (simp only:) apply (simp del: fun_upd_apply split del: if_split) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply(intro allI impI conjI) apply (case_tac "src = dest") apply (simp add: cte_wp_at_caps_of_state fun_upd_idem del: fun_upd_apply) @@ -2214,7 +2200,7 @@ lemma cap_move_valid_list [wp]: update_cdt_list_def set_cdt_list_def del: fun_upd_apply split del: if_split) apply(wp) apply (simp del: fun_upd_apply cong: option.case_cong) - apply (wp set_cap_caps_of_state3) + apply (wp set_cap_caps_of_state3)+ apply (case_tac "cdt s dest") apply (fastforce simp: valid_list_2_def list_remove_removed intro: list_remove_distinct)+ apply (simp add: cap_move_def) @@ -2224,13 +2210,11 @@ lemma cap_move_valid_list [wp]: apply (simp del: fun_upd_apply split del: if_split) apply (unfold valid_list_2_def) apply (simp del: fun_upd_apply cong: option.case_cong split del: if_split) - apply (wp set_cap_caps_of_state3) + apply (wp set_cap_caps_of_state3)+ apply (fold valid_list_2_def) apply (rule mdb_move_abs_simple.valid_list_post) - apply (rule mdb_move_abs_simple.intro) - apply simp - apply (simp) - done + apply (rule mdb_move_abs_simple.intro; simp) + done declare if_cong[cong] @@ -2581,7 +2565,7 @@ lemma (in mdb_empty_abs') next_sib: apply(simp add: n_def) apply(simp) apply(intro conjI impI notI) - apply(simp add: no_mdb_loop) + apply simp apply(drule_tac list="t slot_p" and slot=slot in list_replace_after_None_notin_old) apply(simp add: valid_list_2_def) apply(simp add: valid_list_2_def) @@ -2604,7 +2588,7 @@ lemma (in mdb_empty_abs') next_sib: apply(rule next_sibI) apply(simp add: n_def) apply(simp) - apply(fastforce intro: list_replace_after_notin_old simp: valid_list_2_def no_mdb_loop) + apply(fastforce intro: list_replace_after_notin_old simp: valid_list_2_def) apply(simp) apply(rule next_sibI) apply(simp add: n_def) @@ -3144,9 +3128,7 @@ crunch all_but_exst[wp]: empty_slot_ext "all_but_exst P" crunch (empty_fail) empty_fail[wp]: empty_slot_ext interpretation empty_slot_extended: is_extended "empty_slot_ext a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) lemma empty_slot_valid_list[wp]: @@ -3177,12 +3159,12 @@ lemma set_cap_exst_update: apply (clarsimp simp add: set_cap_def in_monad get_object_def) apply (case_tac y) apply (auto simp add: in_monad set_object_def split: if_split_asm) - done + done lemma no_parent_not_next_slot: notes split_paired_All[simp del] split_paired_Ex[simp del] shows "\m slot = None; valid_list_2 t m; finite_depth m; no_mloop m\ - \ next_slot p t m \ Some slot" + \ next_slot p t m \ Some slot" apply(rule notI) apply(simp add: next_slot_def split: if_split_asm) apply(drule(1) next_childD) @@ -3310,8 +3292,7 @@ lemma findepth: lemma finite_depth: notes split_paired_All[simp del] split_paired_Ex[simp del] - shows - "finite_depth n" + shows "finite_depth n" apply (insert findepth) apply(simp add: finite_depth_def descendants split del: if_split) apply(simp add: n_def n'_def split del: if_split) @@ -3321,57 +3302,51 @@ lemma finite_depth: apply(elim exE conjE) apply(case_tac "p=src") apply(rule_tac x=dest in exI, simp add: s_d_swap_def) - apply(case_tac "p = dest") - apply(rule_tac x ="src" in exI, simp add: s_d_swap_def) - apply(rule_tac x=p in exI, simp add: s_d_swap_def) - apply (case_tac "slot=dest") - apply(erule_tac x=src in allE) - apply (elim exE conjE) - apply (case_tac "p=src") - apply (rule_tac x =dest in exI, simp add: s_d_swap_def) - apply (case_tac "p=dest") - apply (simp add: descendants_of_def) - apply (intro conjI impI) - apply (rule_tac x = "src" in exI, intro conjI, rule impI, simp+) - apply (rule_tac x = "src" in exI) - apply (intro conjI impI) - apply (simp,simp,simp,simp,simp,simp,simp,simp) - apply (rule_tac x = "p" in exI) - apply (simp add: descendants_of_def s_d_swap_def) - apply (erule_tac x = slot in allE) + apply(case_tac "p = dest") + apply(rule_tac x ="src" in exI, simp add: s_d_swap_def) + apply(rule_tac x=p in exI, simp add: s_d_swap_def) + apply (case_tac "slot=dest") + apply(erule_tac x=src in allE) apply (elim exE conjE) - apply (case_tac "p = dest") - apply (rule_tac x = "src" in exI, simp add: descendants_of_def s_d_swap_def) - apply (case_tac "p = src") - apply (rule_tac x = "dest" in exI, simp add: descendants_of_def s_d_swap_def) - apply (rule_tac x ="p" in exI, simp add: descendants_of_def s_d_swap_def) - done - - + apply (case_tac "p=src") + apply (rule_tac x =dest in exI, simp add: s_d_swap_def) + apply (case_tac "p=dest") + apply (simp add: descendants_of_def) + apply (intro conjI impI) + apply (rule_tac x = "src" in exI, intro conjI, rule impI, simp+) + apply (rule_tac x = "src" in exI) + apply (intro conjI impI; simp) + apply (rule_tac x = "p" in exI) + apply (simp add: descendants_of_def s_d_swap_def) + apply (erule_tac x = slot in allE) + apply (elim exE conjE) + apply (case_tac "p = dest") + apply (rule_tac x = "src" in exI, simp add: descendants_of_def s_d_swap_def) + apply (case_tac "p = src") + apply (rule_tac x = "dest" in exI, simp add: descendants_of_def s_d_swap_def) + apply (rule_tac x ="p" in exI, simp add: descendants_of_def s_d_swap_def) + done lemma parency_antisym: "\x y. m x = Some y \ m y \ Some x" - apply (frule parent_not_descendant[OF no_mloop]) - apply (rule notI) - apply (frule_tac src=y and src_p=x in child_descendant,simp) - done + apply (frule parent_not_descendant[OF no_mloop]) + apply (rule notI) + apply (frule_tac src=y and src_p=x in child_descendant,simp) + done lemma parent_not_next_child: "x \ set (t x)" apply (insert no_mloop valid_list) apply (simp add: valid_list_2_def no_mloop_def del: split_paired_All) done - lemma valid_list_post: notes split_paired_All[simp del] split_paired_Ex[simp del] notes parency_antisym[where x=src and y = dest,simp] notes parent_not_next_child[simp] - shows - "valid_list_2 t' n" - proof - - show ?thesis - apply (insert valid_list) + shows "valid_list_2 t' n" + proof - + from valid_list show ?thesis apply (simp add: t'_def t''_def n_def n'_def cong: option.case_cong) - apply (simp add: replace_distinct[OF parent_not_next_child] + by (simp add: replace_distinct[OF parent_not_next_child] replace_distinct list_replace_set list_swap_both insert_Collect remove_collect swap_distinct @@ -3381,7 +3356,6 @@ lemma valid_list_post: | simp split: option.splits | (rule ccontr,simp,elim impE,rule notI) | simp only: valid_list_2_def )+ (*slow*) - done qed lemma next_child_antisym: "next_child x t = Some y \ next_child y t \ Some x" @@ -3413,7 +3387,7 @@ lemma next_child: notes next_child_antisym[where x=src and y = dest,simp] notes next_childD' = next_childD[OF _ valid_list] notes rdefs = t'_def t''_def n_def n'_def - shows + shows "next_child p t' = (if p = src then (if next_child dest t = Some src then Some dest @@ -3426,9 +3400,9 @@ lemma next_child: else next_child p t)" apply (simp add: rdefs split: option.splits) apply (intro impI conjI,simp_all) - apply ((intro impI conjI allI | drule next_child_NoneD next_childD' next_childD'' | rule next_childI'' | simp add: list_replace_def list_swap_def | elim exE conjE disjE | simp add: next_child_def)+) (*slow*) - done - + by ((intro impI conjI allI | drule next_child_NoneD next_childD' next_childD'' | + rule next_childI'' | simp add: list_replace_def list_swap_def | elim exE conjE disjE | + simp add: next_child_def)+) (*slow*) lemma next_sib_antisym: @@ -3444,7 +3418,6 @@ lemma next_sib_antisym: done - lemma after_in_listD': "after_in_list (t p) x = Some y \ (\xs ys. xs @ (x # y # ys) = (t p) \ x \ set xs) \ (m y = Some p \ m x = Some p) \ x \ y" apply (rule conjI) apply (drule after_in_listD) @@ -3461,31 +3434,33 @@ lemma after_in_listD': "after_in_list (t p) x = Some y \ (\ Some y \ - x = None \ (\z. x = Some z \ z \ y)" - apply (case_tac "x",simp+) - done +lemma optionD: "x \ Some y \ x = None \ (\z. x = Some z \ z \ y)" + by (case_tac "x"; simp) -lemma t_distinct[simp]: "distinct (t x)" - apply (simp add: valid_list[simplified valid_list_2_def]) - done +lemma t_distinct: "distinct (t x)" + by (simp add: valid_list[simplified valid_list_2_def]) lemma t_some[simp]: "set (t x) = {c. m c = Some x}" - apply (simp add: valid_list[simplified valid_list_2_def]) - done + by (simp add: valid_list[simplified valid_list_2_def]) +declare t_distinct [simp] -lemmas list_swap_preservation_t = list_swap_preserve_after list_swap_preserve_after list_swap_preserve_after' list_swap_preserve_after'' list_swap_preserve_None list_swap_preserve_None' list_swap_preserve_Some_other' list_swap_preserve_Some_other_distinct[OF t_distinct] list_swap_preserve_Some_other_distinct[OF t_distinct, simplified list_swap_symmetric] list_swap_does_swap[OF t_distinct] list_swap_does_swap[OF t_distinct,simplified list_swap_symmetric] list_swap_preserve_after_None list_swap_preserve_separate list_swap_does_swap' +lemmas list_swap_preservation_t = + list_swap_preserve_after list_swap_preserve_after' + list_swap_preserve_after'' list_swap_preserve_None list_swap_preserve_None' + list_swap_preserve_Some_other' list_swap_preserve_Some_other_distinct[OF t_distinct] + list_swap_preserve_Some_other_distinct[OF t_distinct, simplified list_swap_symmetric] + list_swap_does_swap[OF t_distinct] + list_swap_does_swap[OF t_distinct,simplified list_swap_symmetric] + list_swap_preserve_after_None list_swap_preserve_separate list_swap_does_swap' lemma next_sibD': - notes split_paired_All[simp del] split_paired_Ex[simp del] - shows - "next_sib slot t m = Some child \ -\p. m slot = Some p \ m child = Some p \ after_in_list (t p) slot = Some child" + notes split_paired_All[simp del] split_paired_Ex[simp del] + shows "next_sib slot t m = Some child \ + \p. m slot = Some p \ m child = Some p \ after_in_list (t p) slot = Some child" apply (frule next_sib_same_parent[OF valid_list]) apply (drule next_sibD) - apply (elim exE conjE) - apply simp + apply clarsimp done lemma next_sib: @@ -3508,14 +3483,14 @@ lemma next_sib: else next_sib p t m)" apply simp apply (intro impI conjI allI,simp_all) - apply ((intro impI conjI allI + by ((intro impI conjI allI | drule next_sib_NoneD next_sibD' | simp add: next_sib_def rdefs split: option.splits - | simp add: after_in_list_append_notin_hd replace_list_preserve_after replace_list_preserve_after' list_swap_preservation_t replace_distinct swap_distinct + | simp add: after_in_list_append_notin_hd replace_list_preserve_after replace_list_preserve_after' + list_swap_preservation_t replace_distinct swap_distinct | rule after_in_list_list_replace | drule optionD after_in_listD' | elim exE conjE disjE | force )+) (*slow*) - done lemma next_not_child: notes split_paired_All[simp del] split_paired_Ex[simp del] @@ -3775,13 +3750,11 @@ lemma t'_empty: "(t' src = []) = (t dest = [])" "(t' dest = []) = (t src = [])" "p\src \ p\dest \ (t' p = []) = (t p = [])" - apply(fastforce simp: n_def n'_def t''_def t'_def list_swap_def - split: option.splits split: if_split_asm)+ - done + by(fastforce simp: n_def n'_def t''_def t'_def list_swap_def + split: option.splits split: if_split_asm)+ lemma next_slot: - notes split_paired_All[simp del] split_paired_Ex[simp del] - shows "next_slot p t' n + "next_slot p t' n = (if p = src then (if next_slot dest t m = Some src then Some dest else next_slot dest t m) @@ -3809,15 +3782,12 @@ lemma next_slot: end - crunch all_but_exst[wp]: cap_swap_ext "all_but_exst P" crunch (empty_fail) empty_fail[wp]: cap_swap_ext interpretation cap_swap_ext_extended: is_extended "cap_swap_ext a b c d" - apply (unfold_locales) - apply (wp cap_swap_ext_all_but_exst) - done + by (unfold_locales; wp cap_swap_ext_all_but_exst) lemma cap_swap_valid_list [wp]: @@ -3828,9 +3798,9 @@ lemma cap_swap_valid_list [wp]: apply (simp only: cap_swap_ext_def update_cdt_list_def set_cdt_list_def set_cdt_def bind_assoc) apply wp apply (simp del: fun_upd_apply split del: if_split cong: option.case_cong) - apply (wp set_cap_caps_of_state3) + apply (wp set_cap_caps_of_state3)+ apply (case_tac "a = b") - apply (simp split: option.splits) + apply (simp split: option.splits) apply(subgoal_tac "mdb_swap_abs_simple (cdt s) (cdt_list s)") prefer 2 apply(rule mdb_swap_abs_simple.intro) @@ -3840,7 +3810,6 @@ lemma cap_swap_valid_list [wp]: done - lemma exst_set_cap: "(x,s') \ fst (set_cap p c s) \ exst s' = exst s" by (erule use_valid[OF _ set_cap_exst],simp) @@ -3850,9 +3819,7 @@ crunch all_but_exst[wp]: create_cap_ext "all_but_exst P" crunch (empty_fail) empty_fail[wp]: create_cap_ext interpretation create_cap_extended: is_extended "create_cap_ext a b c" - apply (unfold_locales) - apply (wp) - done + by (unfold_locales; wp) lemma create_cap_valid_list[wp]: notes split_paired_All[simp del] split_paired_Ex[simp del] @@ -3861,7 +3828,7 @@ lemma create_cap_valid_list[wp]: create_cap tp sz p dev x \\rv. valid_list\" apply (case_tac x) apply (simp add: create_cap_def) - apply(simp add: set_cdt_def update_cdt_list_def set_cdt_list_def bind_assoc create_cap_ext_def bind_assoc) + apply(simp add: set_cdt_def update_cdt_list_def set_cdt_list_def create_cap_ext_def bind_assoc) apply (rule hoare_pre) apply (simp add: valid_list_2_def) apply (wp | simp cong: option.case_cong if_cong del: fun_upd_apply split del: if_split)+ @@ -3874,56 +3841,44 @@ lemma create_cap_valid_list[wp]: crunch valid_list[wp]: set_extra_badge valid_list +lemmas transfer_caps_loop_ext_valid[wp] = + transfer_caps_loop_pres[OF cap_insert_valid_list set_extra_badge_valid_list] -lemmas transfer_caps_loop_ext_valid[wp] = transfer_caps_loop_pres[OF cap_insert_valid_list set_extra_badge_valid_list] - - -crunch valid_list[wp]: tcb_sched_action,reschedule_required,set_thread_state_ext "valid_list" (simp: unless_def) +crunch valid_list[wp]: tcb_sched_action,reschedule_required,set_thread_state_ext "valid_list" + (simp: unless_def) crunch all_but_exst[wp]: set_thread_state_ext "all_but_exst P" crunch (empty_fail) empty_fail[wp]: set_thread_state_ext interpretation set_thread_state_ext_extended: is_extended "set_thread_state_ext a" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch all_but_exst[wp]: reschedule_required "all_but_exst P" interpretation reschedule_required_ext_extended: is_extended "reschedule_required" - apply (unfold_locales) - apply wp - done - + by (unfold_locales; wp) crunch valid_list[wp]: fast_finalise valid_list (wp: crunch_wps) lemma cap_delete_one_valid_list[wp]: "\valid_list\ cap_delete_one a \\_.valid_list\" - unfolding cap_delete_one_def - apply (wp | simp add: unless_def)+ - done + unfolding cap_delete_one_def by (wpsimp simp: unless_def) crunch valid_list[wp]: thread_set valid_list lemma reply_cancel_ipc_valid_list[wp]: "\valid_list\ reply_cancel_ipc a \\_. valid_list\" unfolding reply_cancel_ipc_def - apply (wp select_wp hoare_drop_imps thread_set_mdb | simp)+ - done + by (wp select_wp hoare_drop_imps thread_set_mdb | simp)+ crunch all_but_exst[wp]: update_work_units "all_but_exst P" crunch all_but_exst[wp]: reset_work_units "all_but_exst P" global_interpretation update_work_units_ext_extended: is_extended "update_work_units" - apply (unfold_locales) - apply wp - done - + by (unfold_locales; wp) + global_interpretation reset_work_units_ext_extended: is_extended "reset_work_units" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) lemma preemption_point_inv': "\irq_state_independent_A P; \f s. P (work_units_completed_update f s) = P s\ \ \P\ preemption_point \\_. P\" @@ -3956,8 +3911,7 @@ crunch valid_list[wp]: cap_delete valid_list end lemma irq_state_independent_A_valid_list[simp]: "irq_state_independent_A valid_list" - apply (simp add: irq_state_independent_A_def) - done + by (simp add: irq_state_independent_A_def) context Deterministic_AI_1 begin @@ -3975,9 +3929,7 @@ crunch all_but_exst[wp]: ethread_set "all_but_exst P" crunch (empty_fail) empty_fail[wp]: ethread_set global_interpretation ethread_set_extended: is_extended "ethread_set a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch valid_list[wp]: cancel_badged_sends valid_list (wp: crunch_wps preemption_point_inv' simp: crunch_simps filterM_mapM unless_def @@ -3985,9 +3937,8 @@ crunch valid_list[wp]: cancel_badged_sends valid_list context Deterministic_AI_1 begin -lemma invoke_cnode_valid_list[wp]: "\valid_list\ - invoke_cnode ci - \\_.valid_list\" +lemma invoke_cnode_valid_list[wp]: + "\valid_list\ invoke_cnode ci \\_.valid_list\" apply (rule hoare_pre) apply (wp crunch_wps cap_move_src_slot_Null hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: invoke_cnode_def crunch_simps split del: if_split)+ done @@ -4007,44 +3958,32 @@ lemma empty_fail_possible_switch_to[wp]: "empty_fail (possible_switch_to a b)" crunch (empty_fail)empty_fail[wp]: switch_if_required_to global_interpretation possible_switch_to_extended: is_extended "possible_switch_to a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) global_interpretation switch_if_required_to_extended: is_extended "switch_if_required_to a" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch all_but_exst[wp]: set_priority "all_but_exst P" (simp: ethread_get_def) crunch (empty_fail)empty_fail[wp]: set_priority,set_mcpriority global_interpretation set_priority_extended: is_extended "set_priority a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch all_but_exst[wp]: set_domain "all_but_exst P" (simp: ethread_get_def) global_interpretation set_domain_extended: is_extended "set_domain a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) global_interpretation thread_set_domain_extended: is_extended "thread_set_domain a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch all_but_exst[wp]: dec_domain_time "all_but_exst P" (simp: ethread_get_def) crunch (empty_fail) empty_fail[wp]: dec_domain_time global_interpretation dec_domain_time_extended: is_extended "dec_domain_time" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) context Deterministic_AI_1 begin crunch valid_list[wp]: invoke_tcb valid_list @@ -4059,18 +3998,14 @@ lemma delete_objects_valid_list[wp]: "\valid_list\ delete_object lemmas mapM_x_def_bak = mapM_x_def[symmetric] lemma retype_region_ext_valid_list_ext[wp]: "\valid_list\ retype_region_ext a b \\_.valid_list\" - apply (rule hoare_pre) - apply (simp add: retype_region_ext_def|wp|wpc)+ - done + by (wpsimp simp: retype_region_ext_def) crunch all_but_exst[wp]: retype_region_ext "all_but_exst P" (simp: ethread_get_def) crunch (empty_fail)empty_fail[wp]: retype_region_ext global_interpretation retype_region_ext_extended: is_extended "retype_region_ext a b" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) crunch valid_list[wp]: invoke_irq_handler valid_list @@ -4089,10 +4024,7 @@ crunch (empty_fail)empty_fail[wp]: timer_tick (simp: thread_state.splits) global_interpretation timer_tick_extended: is_extended "timer_tick" - apply (unfold_locales) - apply wp - done - + by (unfold_locales; wp) locale Deterministic_AI_2 = Deterministic_AI_1 + assumes handle_interrupt_valid_list[wp]: @@ -4116,15 +4048,8 @@ locale Deterministic_AI_2 = Deterministic_AI_1 + context Deterministic_AI_2 begin lemma handle_event_valid_list[wp]: - "\valid_list\ - handle_event e - \\_.valid_list\" - apply (case_tac e, simp_all) - apply (rename_tac syscall) - apply (case_tac syscall, simp_all) - apply ((rule hoare_pre, wp) | - wpc | wp hoare_drop_imps hoare_vcg_all_lift | simp)+ - done + "\valid_list\ handle_event e \\_.valid_list\" + by (case_tac e; wpsimp wp: hoare_drop_imps) end @@ -4268,10 +4193,8 @@ definition next_sib_set :: "cslot_ptr \ cdt_list \ cdt \ lemma next_sib_set_same_parent: "\next \ next_sib_set slot t m; valid_list_2 t m\ \ \p. m slot = Some p \ m next = Some p" - apply(simp add: next_sib_set_def) - apply(induct_tac "next" slot rule: trancl.induct) - apply(fastforce dest: next_sib_same_parent)+ - done + apply (simp add: next_sib_set_def) + by (induct "next" slot rule: trancl.induct; fastforce dest: next_sib_same_parent) lemma next_slot_setD: notes split_paired_All[simp del] split_paired_Ex[simp del] @@ -4352,9 +4275,9 @@ lemma list_eq_after_in_list: apply (erule conjE) apply (drule_tac x = p in spec)+ apply (subgoal_tac "x \ set (t p)") - apply (drule_tac in_set_conv_nth[THEN iffD1], erule exE) - apply (auto simp: in_set_conv_nth list_eq_after_in_list') -done + apply (drule_tac in_set_conv_nth[THEN iffD1], erule exE) + apply (auto simp: in_set_conv_nth list_eq_after_in_list') + done lemma next_sib_set_eq_after_in_list_set_Some: notes split_paired_All[simp del] split_paired_Ex[simp del] @@ -4364,8 +4287,7 @@ lemma next_sib_set_eq_after_in_list_set_Some: apply(simp add: next_sib_set_def) apply(drule trancl_Collect_rev) apply(rule trancl_Collect_rev) - apply(induct_tac xa rule: trancl_induct) - apply(assumption) + apply(erule trancl_induct) apply(fastforce simp: next_sib_def split: option.splits) apply(rule trancl_into_trancl) apply(simp) @@ -4375,8 +4297,7 @@ lemma next_sib_set_eq_after_in_list_set_Some: apply(fastforce simp: next_sib_def split: option.splits dest: next_sib_set_same_parent) apply(simp) apply(drule trancl_Collect_rev) - apply(induct_tac xa rule: trancl_induct) - apply(assumption) + apply(erule trancl_induct) apply(fastforce simp: next_sib_set_def next_sib_def split: option.splits) apply(simp add: next_sib_set_def) apply(subgoal_tac "y \ next_sib_set x t m") @@ -4506,8 +4427,7 @@ lemma next_sib_2_termination: "\valid_mdb s; valid_list s\ \ next_sib_2_dom (slot, p, s)" apply(induct_tac slot rule: next_slot_induct[where s=s]) apply(fastforce intro: next_sib_2_domintros)+ - done - + done lemma next_sib_2_pinduct': "\next_sib_2_dom (slot, p, s); @@ -4689,9 +4609,8 @@ function (domintros) last_last_child where by auto - lemma last_childD: - notes split_paired_All[simp del] split_paired_Ex[simp del] + notes split_paired_All[simp del] shows "\last_child slot t = Some child; valid_list_2 t m\ \ m child = Some slot \ next_sib child t m = None" apply(rule context_conjI) @@ -4709,8 +4628,7 @@ lemma last_childD: lemma last_child_set_in_desc: "\valid_list_2 t m; c \ last_child_set p t\ \ c \ descendants_of p m" apply(simp add: last_child_set_def) - apply(induct_tac p rule: trancl_induct) - apply(assumption) + apply(erule trancl_induct) apply(fastforce simp: child_descendant dest: last_childD) apply(simp) apply(drule(1) last_childD) @@ -4718,7 +4636,7 @@ lemma last_child_set_in_desc: apply(drule child_descendant) apply(rule descendants_trans) apply(simp)+ - done + done lemma last_child_no_loop: notes split_paired_All[simp del] split_paired_Ex[simp del] @@ -4731,10 +4649,7 @@ lemma last_child_no_loop: lemma wf_last_child: - notes split_paired_All[simp del] split_paired_Ex[simp del] - shows - "\valid_mdb s; valid_list s\ - \ wf {(next, p). last_child p (cdt_list s) = Some next}" + "\valid_mdb s; valid_list s\ \ wf {(next, p). last_child p (cdt_list s) = Some next}" apply(rule finite_acyclic_wf) apply(insert cte_wp_at_set_finite)[1] apply(rule_tac B="{p. cte_wp_at \ p s} \ {p. cte_wp_at \ p s}" in finite_subset) @@ -4748,8 +4663,6 @@ lemma wf_last_child: done lemma last_child_induct: - notes split_paired_All[simp del] split_paired_Ex[simp del] - shows "\\x. last_child x (cdt_list s) = None \ P x; \x y. \last_child x (cdt_list s) = Some y; P y\ \ P x; valid_mdb s; valid_list s\ \ P slot" @@ -4758,22 +4671,20 @@ lemma last_child_induct: apply(fastforce split: if_split_asm) done - lemma last_last_child_termination: "\valid_mdb s; valid_list s\ \ last_last_child_dom (slot, (cdt_list s))" apply(induct_tac slot rule: last_child_induct[where s=s]) apply(fastforce intro: last_last_child.domintros)+ - done + done declare last_last_child.psimps[simp] lemma last_child_NoneD: "\last_child x t = None; valid_list_2 t m\ \ descendants_of x m = {}" - apply(simp add: last_child_def empty_list_empty_desc split: if_split_asm) - done + by(simp add: last_child_def empty_list_empty_desc split: if_split_asm) lemma last_last_child_NoneD: - notes split_paired_All[simp del] split_paired_Ex[simp del] + notes split_paired_Ex[simp del] assumes "last_last_child slot (cdt_list s) = None" "valid_list s" "valid_mdb s" shows "descendants_of slot (cdt s) = {}" apply(insert assms) @@ -4793,7 +4704,7 @@ lemma last_last_child_NoneD: apply(fastforce dest: child_descendant) using assms apply(simp+) - done + done lemma last_child_None_empty_desc: "\last_child slot t = None; valid_list_2 t m\ \ descendants_of slot m = {}" @@ -5087,8 +4998,7 @@ lemma next_sib_in_next_slot_set: apply(rule subsetI) apply(simp add: next_slot_set_def) apply(drule trancl_Collect_rev) - apply(induct_tac x rule: trancl_induct) - apply(assumption) + apply(erule trancl_induct) apply(simp add: empty_list_empty_desc next_slot_def) apply(drule(1) next_childD, simp add: child_descendant) apply(simp) diff --git a/proof/invariant-abstract/EmptyFail_AI.thy b/proof/invariant-abstract/EmptyFail_AI.thy index b5a463614..98ef97140 100644 --- a/proof/invariant-abstract/EmptyFail_AI.thy +++ b/proof/invariant-abstract/EmptyFail_AI.thy @@ -392,7 +392,7 @@ proof (induct rule: cap_revoke.induct) apply (rule spec_empty_fail_bindE', ((wp drop_spec_empty_fail select_ext_empty_fail | simp)+)[1])+ apply (rule "1.hyps", simp+) - apply (wp drop_spec_empty_fail) + apply (wp drop_spec_empty_fail)+ done qed diff --git a/proof/invariant-abstract/Finalise_AI.thy b/proof/invariant-abstract/Finalise_AI.thy index 6fc7e45b4..f3a0096f6 100644 --- a/proof/invariant-abstract/Finalise_AI.thy +++ b/proof/invariant-abstract/Finalise_AI.thy @@ -391,7 +391,6 @@ lemma empty_slot_deletes[wp]: done - crunch caps_of_state[wp]: deleted_irq_handler "\s. P (caps_of_state s)" @@ -399,11 +398,15 @@ lemma empty_slot_final_cap_at: "\(\s. cte_wp_at (\c. obj_refs c \ {} \ is_final_cap' c s) p s) and K (p \ p')\ empty_slot p' opt \\rv s. cte_wp_at (\c. is_final_cap' c s) p s\" apply (rule hoare_gen_asm) + apply (simp add: empty_slot_def final_cap_at_eq cte_wp_at_conj cte_wp_at_caps_of_state) + apply (wpsimp wp: opt_return_pres_lift get_cap_wp) + (* FIXME: wp_cleanup apply (simp add: empty_slot_def final_cap_at_eq cte_wp_at_conj) apply (simp add: cte_wp_at_caps_of_state) apply (wp opt_return_pres_lift | simp split del: if_split)+ apply (rule hoare_strengthen_post [OF get_cap_sp]) apply (clarsimp simp: cte_wp_at_caps_of_state) + *) done @@ -492,17 +495,17 @@ lemma cancel_ipc_caps_of_state: \\rv s. P (caps_of_state s)\" apply (simp add: cancel_ipc_def reply_cancel_ipc_def cong: Structures_A.thread_state.case_cong) - apply (wp cap_delete_one_caps_of_state select_wp - | wpc)+ + apply (wpsimp wp: cap_delete_one_caps_of_state select_wp) apply (rule_tac Q="\_ s. (\p. cte_wp_at can_fast_finalise p s \ P ((caps_of_state s) (p \ cap.NullCap))) \ P (caps_of_state s)" in hoare_post_imp) apply (clarsimp simp: fun_upd_def[symmetric] split_paired_Ball) apply (simp add: cte_wp_at_caps_of_state) - apply (wp hoare_vcg_all_lift hoare_convert_imp - thread_set_caps_of_state_trivial - | clarsimp simp: tcb_cap_cases_def)+ + apply (wpsimp wp: hoare_vcg_all_lift hoare_convert_imp thread_set_caps_of_state_trivial + simp: tcb_cap_cases_def)+ + prefer 2 + apply assumption apply (rule hoare_strengthen_post [OF gts_sp]) apply (clarsimp simp: fun_upd_def[symmetric] cte_wp_at_caps_of_state) done @@ -514,10 +517,8 @@ lemma suspend_caps_of_state: \ P (caps_of_state s)\ suspend t \\rv s. P (caps_of_state s)\" - apply (simp add: suspend_def) - apply (wp, simp, wp cancel_ipc_caps_of_state) - apply (simp add: fun_upd_def[symmetric]) - done + unfolding suspend_def + by (wpsimp wp: cancel_ipc_caps_of_state simp: fun_upd_def[symmetric]) lemma suspend_final_cap: @@ -701,7 +702,6 @@ lemma pred_tcb_at_def2: (* sseefried: 'st_tcb_at_def2' only exists to make existing proofs go through. Can use 'pred_tcb_at_def2' instead *) lemmas st_tcb_at_def2 = pred_tcb_at_def2[where proj=itcb_state,simplified] -(* FIXME: move *) lemma imp_and_strg: "Q \ C \ (A \ Q \ C) \ C" by blast (* FIXME: move *) lemma cases_conj_strg: "A \ B \ (P \ A) \ (\ P \ B)" @@ -770,9 +770,10 @@ lemma unbind_notification_not_bound: lemma unbind_notification_bound_tcb_at[wp]: "\\\ unbind_notification tcbptr \\_. bound_tcb_at (op = None) tcbptr\" apply (simp add: unbind_notification_def) - apply (wp sbn_bound_tcb_at' | wpc | clarsimp)+ - apply (rule gbn_bound_tcb[THEN hoare_strengthen_post]) - apply clarsimp + apply (wpsimp wp: sbn_bound_tcb_at') + apply (rule gbn_bound_tcb[THEN hoare_strengthen_post]) + apply clarsimp + apply assumption done crunch valid_mdb[wp]: unbind_notification "valid_mdb" @@ -786,6 +787,7 @@ lemma unbind_notification_no_cap_to_obj_ref[wp]: apply (wp unbind_notification_caps_of_state) done + lemma empty_slot_cte_wp_elsewhere: "\(\s. cte_wp_at P p s) and K (p \ p')\ empty_slot p' opt \\rv s. cte_wp_at P p s\" apply (rule hoare_gen_asm) @@ -931,7 +933,7 @@ lemma cap_delete_one_deletes[wp]: context Finalise_AI_2 begin sublocale delete_one_abs a' for a' :: "('a :: state_ext) itself" - by (unfold_locales, wp cap_delete_one_deletes cap_delete_one_caps_of_state) + by (unfold_locales; wp cap_delete_one_deletes cap_delete_one_caps_of_state) end lemma cap_delete_one_deletes_reply: @@ -949,7 +951,7 @@ lemma cap_delete_one_deletes_reply: split: if_split_asm elim!: allEI) apply (rule hoare_vcg_all_lift) apply simp - apply (wp static_imp_wp empty_slot_deletes empty_slot_caps_of_state get_cap_wp) + apply (wp static_imp_wp empty_slot_deletes empty_slot_caps_of_state get_cap_wp)+ apply (fastforce simp: cte_wp_at_caps_of_state valid_reply_caps_def is_cap_simps unique_reply_caps_def simp del: split_paired_All) @@ -964,8 +966,7 @@ lemma cap_delete_one_reply_st_tcb_at: apply (rule hoare_seq_ext [OF _ get_cap_sp]) apply (rule hoare_assume_pre) apply (clarsimp simp: cte_wp_at_caps_of_state when_def) - apply wp - apply simp + apply wpsimp done lemma get_irq_slot_emptyable[wp]: @@ -1088,10 +1089,7 @@ lemma fast_finalise_st_tcb_at: fast_finalise cap fin \\rv. st_tcb_at P t\" apply (rule hoare_gen_asm) - apply (cases cap, simp_all) - apply (wp cancel_all_ipc_st_tcb_at - cancel_all_signals_st_tcb_at - | simp)+ + apply (cases cap; wpsimp wp: cancel_all_ipc_st_tcb_at cancel_all_signals_st_tcb_at) done @@ -1099,10 +1097,8 @@ lemma cap_delete_one_st_tcb_at: "\st_tcb_at P t and K (\st. active st \ P st)\ cap_delete_one ptr \\rv. st_tcb_at P t\" - apply (simp add: cap_delete_one_def unless_def - is_final_cap_def) - apply (wp fast_finalise_st_tcb_at get_cap_wp) - apply simp + apply (simp add: cap_delete_one_def unless_def is_final_cap_def) + apply (wpsimp wp: fast_finalise_st_tcb_at get_cap_wp) done lemma can_fast_finalise_Null: @@ -1148,6 +1144,7 @@ lemma cte_wp_at_disj: lemmas thread_set_final_cap = final_cap_lift [OF thread_set_caps_of_state_trivial] + schematic_goal no_cap_to_obj_with_diff_ref_lift: "\\s. ?P (caps_of_state s)\ f \\rv s. ?P (caps_of_state s)\ \ \no_cap_to_obj_with_diff_ref cap S\ @@ -1172,6 +1169,7 @@ lemma cap_not_in_valid_global_refs: apply blast done +(* FIXME: move *) lemma gts_wp: "\\s. \st. st_tcb_at (op = st) t s \ P st s\ get_thread_state t \P\" unfolding get_thread_state_def diff --git a/proof/invariant-abstract/Interrupt_AI.thy b/proof/invariant-abstract/Interrupt_AI.thy index 939e9e63b..4d6c602f3 100644 --- a/proof/invariant-abstract/Interrupt_AI.thy +++ b/proof/invariant-abstract/Interrupt_AI.thy @@ -189,13 +189,14 @@ lemma cap_delete_one_still_derived: apply auto done + lemma cap_delete_one_cte_cap_to[wp]: "\ex_cte_cap_wp_to P ptr\ cap_delete_one ptr' \\rv. ex_cte_cap_wp_to P ptr\" apply (simp add: ex_cte_cap_wp_to_def) apply (wp hoare_vcg_ex_lift hoare_use_eq_irq_node [OF cap_delete_one_irq_node cap_delete_one_cte_wp_at_preserved]) - apply (clarsimp simp: can_fast_finalise_def split: cap.split_asm) + apply (clarsimp simp: can_fast_finalise_def split: cap.split_asm)+ done @@ -243,16 +244,16 @@ lemmas (in Interrupt_AI) , OF TrueI TrueI TrueI , simplified ] + crunch interrupt_states[wp]: update_waiting_ntfn, cancel_signal, blocked_cancel_ipc "\s. P (interrupt_states s)" (wp: mapM_x_wp_inv) lemma cancel_ipc_noreply_interrupt_states: "\\s. st_tcb_at (\st. st \ BlockedOnReply) t s \ P (interrupt_states s) \ cancel_ipc t \ \_ s. P (interrupt_states s) \" apply (simp add: cancel_ipc_def) - apply (wp | wpc | simp)+ + apply wpsimp apply (rule hoare_pre_cont) apply (wp) - apply (rule hoare_pre) - apply (wp gts_wp) + apply (wp gts_wp)+ apply (auto simp: pred_tcb_at_def obj_at_def) done diff --git a/proof/invariant-abstract/Invariants_AI.thy b/proof/invariant-abstract/Invariants_AI.thy index f89292553..f09c9dcff 100644 --- a/proof/invariant-abstract/Invariants_AI.thy +++ b/proof/invariant-abstract/Invariants_AI.thy @@ -3253,10 +3253,8 @@ locale invs_locale = lemma invs_locale_trivial: "invs_locale \" - apply unfold_locales - apply wp -done - + by (unfold_locales; wp) + lemma in_dxo_pspaceD: "((), s') \ fst (do_extended_op f s) \ kheap s' = kheap s" by (clarsimp simp: do_extended_op_def select_f_def in_monad) diff --git a/proof/invariant-abstract/IpcCancel_AI.thy b/proof/invariant-abstract/IpcCancel_AI.thy index e8c662c48..ba4ee4ae4 100644 --- a/proof/invariant-abstract/IpcCancel_AI.thy +++ b/proof/invariant-abstract/IpcCancel_AI.thy @@ -198,11 +198,9 @@ lemma cancel_ipc_simple [wp]: lemma blocked_cancel_ipc_typ_at[wp]: "\\s. P (typ_at T p s)\ blocked_cancel_ipc st t \\rv s. P (typ_at T p s)\" - apply (simp add: blocked_cancel_ipc_def get_blocking_object_def get_ep_queue_def) - apply wp - apply (case_tac ep, simp_all)[1] - apply wp - apply (cases st, simp_all) + apply (simp add: blocked_cancel_ipc_def get_blocking_object_def get_ep_queue_def get_endpoint_def) + apply (wp get_object_wp|wpc)+ + apply simp done @@ -324,7 +322,7 @@ lemma set_ep_cap_refs_in_kernel_window [wp]: "\cap_refs_in_kernel_window\ set_endpoint ep p \\_. cap_refs_in_kernel_window\" unfolding set_endpoint_def apply (wp set_object_cap_refs_in_kernel_window get_object_wp) - apply (clarsimp simp: obj_at_def same_caps_more_simps is_ep_def + apply (clarsimp simp: obj_at_def is_ep_def split: Structures_A.kernel_object.splits) done @@ -335,7 +333,7 @@ crunch cap_refs_respects_device_region[wp]: set_endpoint cap_refs_respects_devic lemma set_endpoint_valid_ioc[wp]: "\valid_ioc\ set_endpoint ptr ep \\rv. valid_ioc\" apply (simp add: set_endpoint_def) - apply (wp set_object_valid_ioc_no_caps) + apply (wp set_object_valid_ioc_no_caps get_object_wp) apply (clarsimp simp add: valid_def get_object_def simpler_gets_def split_def bind_def assert_def return_def fail_def obj_at_def is_tcb is_cap_table a_type_simps @@ -594,7 +592,8 @@ lemma reply_cap_descends_from_master: lemma (in delete_one_abs) reply_cancel_ipc_no_reply_cap[wp]: - "\invs and tcb_at t\ (reply_cancel_ipc t :: (unit,'a) s_monad) \\rv s. \ has_reply_cap t s\" + notes hoare_pre [wp_pre del] + shows "\invs and tcb_at t\ (reply_cancel_ipc t :: (unit,'a) s_monad) \\rv s. \ has_reply_cap t s\" apply (simp add: reply_cancel_ipc_def) apply wp apply (rule_tac Q="\rvp s. cte_wp_at (\c. c = cap.NullCap) x s \ @@ -615,19 +614,17 @@ lemma (in delete_one_abs) reply_cancel_ipc_no_reply_cap[wp]: lemma (in delete_one_abs) cancel_ipc_no_reply_cap[wp]: - "\invs and tcb_at t\ (cancel_ipc t :: (unit,'a) s_monad) \\rv s. \ has_reply_cap t s\" + shows "\invs and tcb_at t\ (cancel_ipc t :: (unit,'a) s_monad) \\rv s. \ has_reply_cap t s\" apply (simp add: cancel_ipc_def) - apply (wp | wpc)+ - apply (strengthen reply_cap_doesnt_exist_strg - | wp hoare_post_imp [OF invs_valid_reply_caps] + apply (wpsimp wp: hoare_post_imp [OF invs_valid_reply_caps] reply_cancel_ipc_no_reply_cap cancel_signal_invs cancel_signal_st_tcb_at_general blocked_cancel_ipc_invs blocked_ipc_st_tcb_at_general - | simp add: o_def)+ - apply (rule_tac Q="\rv. st_tcb_at (op = rv) t and invs" in hoare_strengthen_post) - apply (wp gts_st_tcb | simp)+ - apply (fastforce simp: invs_def valid_state_def st_tcb_at_tcb_at - elim!: pred_tcb_weakenE)+ + | strengthen reply_cap_doesnt_exist_strg)+ + apply (rule_tac Q="\rv. st_tcb_at (op = rv) t and invs" in hoare_strengthen_post) + apply (wpsimp wp: gts_st_tcb) + apply (fastforce simp: invs_def valid_state_def st_tcb_at_tcb_at + elim!: pred_tcb_weakenE)+ done @@ -674,10 +671,11 @@ locale delete_one_pre = lemma (in delete_one_pre) reply_cancel_ipc_cte_wp_at_preserved: "(\cap. P cap \ \ can_fast_finalise cap) \ \cte_wp_at P p\ (reply_cancel_ipc t :: (unit,'a) s_monad) \\rv. cte_wp_at P p\" - apply (simp add: reply_cancel_ipc_def) - apply (wp select_wp delete_one_cte_wp_at_preserved | simp)+ - apply (rule_tac Q="\_. cte_wp_at P p" in hoare_post_imp, clarsimp) - apply (wp thread_set_cte_wp_at_trivial, clarsimp simp: tcb_cap_cases_def) + unfolding reply_cancel_ipc_def + apply (wpsimp wp: select_wp delete_one_cte_wp_at_preserved) + apply (rule_tac Q="\_. cte_wp_at P p" in hoare_post_imp, clarsimp) + apply (wpsimp wp: thread_set_cte_wp_at_trivial simp: tcb_cap_cases_def) + apply assumption done @@ -693,25 +691,19 @@ lemma (in delete_one_pre) cancel_ipc_cte_wp_at_preserved: lemma (in delete_one_pre) suspend_cte_wp_at_preserved: "(\cap. P cap \ \ can_fast_finalise cap) \ \cte_wp_at P p\ (suspend tcb :: (unit,'a) s_monad) \\_. cte_wp_at P p\" - by (simp add: suspend_def, wp, simp, wp cancel_ipc_cte_wp_at_preserved) + by (simp add: suspend_def) (wpsimp wp: cancel_ipc_cte_wp_at_preserved) -(* FIXME - move *) +(* FIXME - eliminate *) lemma obj_at_exst_update: "obj_at P p (trans_state f s) = obj_at P p s" - by (simp add: obj_at_def) + by (rule more_update.obj_at_update) lemma set_thread_state_bound_tcb_at[wp]: - "\bound_tcb_at P t\ - set_thread_state p ts - \\_. bound_tcb_at P t\" - apply (simp add: set_thread_state_def set_object_def) - apply (wp | simp)+ - apply (clarsimp simp: pred_tcb_at_def obj_at_def) - apply (drule get_tcb_SomeD) - apply clarsimp - done + "\bound_tcb_at P t\ set_thread_state p ts \\_. bound_tcb_at P t\" + unfolding set_thread_state_def set_object_def + by (wpsimp simp: pred_tcb_at_def obj_at_def get_tcb_def) crunch bound_tcb_at[wp]: cancel_all_ipc, empty_slot, is_final_cap, get_cap "bound_tcb_at P t" @@ -775,31 +767,30 @@ lemma reply_cancel_ipc_bound_tcb_at[wp]: reply_cancel_ipc p \\_. bound_tcb_at P t\" unfolding reply_cancel_ipc_def - apply (wp cap_delete_one_bound_tcb_at select_inv select_wp | simp)+ - apply (rule_tac Q="\_. bound_tcb_at P t and valid_mdb and valid_objs and tcb_at p" in hoare_strengthen_post) - apply (wp thread_set_no_change_tcb_pred thread_set_mdb | clarsimp)+ - apply (fastforce simp:tcb_cap_cases_def) - apply (wp thread_set_valid_objs_triv) - apply ((fastforce simp:tcb_cap_cases_def)+)[9] - apply (wp thread_set_tcb | simp)+ - apply clarsimp - apply (frule valid_mdb_impl_reply_masters) - apply (clarsimp simp: reply_masters_mdb_def) - apply (erule_tac x=p in allE) - apply (erule_tac x="tcb_cnode_index 2" in allE) - apply (erule_tac x=p in allE) - apply (clarsimp simp:tcb_at_def) - apply (frule(1) valid_tcb_objs) - apply (clarsimp simp: valid_tcb_def) - apply (erule impE) - apply (simp add: caps_of_state_tcb_index_trans tcb_cnode_map_def) - apply (clarsimp simp: tcb_cap_cases_def is_master_reply_cap_def split:cap.splits ) - apply (subgoal_tac "descendants_of (p, tcb_cnode_index 2) (cdt s) \ {}") - prefer 2 - apply simp - apply (drule descendants_of_nullcap, simp) - apply (simp add: caps_of_state_tcb_index_trans tcb_cnode_map_def) - apply fastforce + apply (wpsimp wp: cap_delete_one_bound_tcb_at select_inv select_wp) + apply (rule_tac Q="\_. bound_tcb_at P t and valid_mdb and valid_objs and tcb_at p" in hoare_strengthen_post) + apply (wpsimp wp: thread_set_no_change_tcb_pred thread_set_mdb) + apply (fastforce simp:tcb_cap_cases_def) + apply (wpsimp wp: thread_set_valid_objs_triv simp: tcb_cap_cases_def) + apply clarsimp + apply (frule valid_mdb_impl_reply_masters) + apply (clarsimp simp: reply_masters_mdb_def) + apply (spec p) + apply (spec "tcb_cnode_index 2") + apply (spec p) + apply (clarsimp simp:tcb_at_def) + apply (frule(1) valid_tcb_objs) + apply (clarsimp simp: valid_tcb_def) + apply (erule impE) + apply (simp add: caps_of_state_tcb_index_trans tcb_cnode_map_def) + apply (clarsimp simp: tcb_cap_cases_def is_master_reply_cap_def split:cap.splits ) + apply (subgoal_tac "descendants_of (p, tcb_cnode_index 2) (cdt s) \ {}") + prefer 2 + apply simp + apply (drule descendants_of_nullcap, simp) + apply (simp add: caps_of_state_tcb_index_trans tcb_cnode_map_def) + apply fastforce + apply simp done @@ -1002,7 +993,8 @@ lemma bound_tcb_bound_notification_at: done lemma unbind_notification_invs: - "\invs\ unbind_notification t \\rv. invs\" + notes hoare_pre [wp_pre del] + shows "\invs\ unbind_notification t \\rv. invs\" apply (simp add: unbind_notification_def invs_def valid_state_def valid_pspace_def) apply (rule hoare_seq_ext [OF _ gbn_sp]) apply (case_tac ntfnptr, clarsimp, wp, simp) @@ -1222,12 +1214,10 @@ lemma cancel_badged_sends_invs[wp]: "\invs\ cancel_badged_sends epptr badge \\rv. invs\" apply (simp add: cancel_badged_sends_def) apply (rule hoare_seq_ext [OF _ get_endpoint_sp]) - apply (case_tac ep, simp_all) - apply (wp, simp) + apply (case_tac ep; simp) + apply wpsimp apply (simp add: invs_def valid_state_def valid_pspace_def) - apply (rule hoare_pre) - apply (wp, simp, wp valid_irq_node_typ) - + apply (wpsimp wp: valid_irq_node_typ) apply (simp add: fun_upd_def[symmetric] ep_redux_simps cong: list.case_cong) apply (rule hoare_strengthen_post, @@ -1246,7 +1236,7 @@ lemma cancel_badged_sends_invs[wp]: apply (drule st_tcb_at_state_refs_ofD) apply (clarsimp simp only: cancel_badged_sends_invs_helper Un_iff, clarsimp) apply (simp add: set_eq_subset) - apply (wp | simp)+ + apply wpsimp done diff --git a/proof/invariant-abstract/Ipc_AI.thy b/proof/invariant-abstract/Ipc_AI.thy index 03abd48e8..4b9444154 100644 --- a/proof/invariant-abstract/Ipc_AI.thy +++ b/proof/invariant-abstract/Ipc_AI.thy @@ -252,16 +252,7 @@ lemma get_extra_cptrs_inv[wp]: lemma mapM_length[wp]: "\\s. P (length xs)\ mapM f xs \\rv s. P (length rv)\" - apply (induct xs arbitrary: P) - apply (simp add: mapM_def sequence_def) - apply wp - apply simp - apply (simp add: mapM_Cons) - apply wp - apply simp - apply assumption - apply wp - done + by (induct xs arbitrary: P) (wpsimp simp: mapM_Cons mapM_def sequence_def|assumption)+ lemma cap_badge_rights_update[simp]: "cap_badge (cap_rights_update rights cap) = cap_badge cap" @@ -363,12 +354,12 @@ lemma cap_insert_cte_wp_at: apply (clarsimp simp:cap_insert_def) apply (wp set_cap_cte_wp_at | simp split del: if_split)+ apply (clarsimp simp:set_untyped_cap_as_full_def split del:if_splits) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (clarsimp simp:cap_insert_def) apply (wp set_cap_cte_wp_at | simp split del: if_split)+ apply (clarsimp simp:set_untyped_cap_as_full_def split del:if_splits) - apply (wp set_cap_cte_wp_at get_cap_wp) + apply (wp set_cap_cte_wp_at get_cap_wp)+ apply (clarsimp simp:cte_wp_at_caps_of_state) apply (frule(1) caps_of_state_valid) apply (intro conjI impI) @@ -490,7 +481,7 @@ lemma transfer_caps_loop_presM: apply (wp eb hoare_vcg_const_imp_lift hoare_vcg_const_Ball_lift static_imp_wp | assumption | simp split del: if_split)+ apply (rule cap_insert_assume_null) - apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at static_imp_wp) + apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at static_imp_wp)+ apply (rule hoare_vcg_conj_liftE_R) apply (rule derive_cap_is_derived_foo) apply (rule_tac Q' ="\cap' s. (vo \ cap'\ cap.NullCap \ @@ -503,7 +494,7 @@ lemma transfer_caps_loop_presM: apply (rule hoare_vcg_conj_liftE_R) apply (rule hoare_vcg_const_imp_lift_R) apply (rule derive_cap_is_derived) - apply (wp derive_cap_is_derived_foo) + apply (wp derive_cap_is_derived_foo)+ apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_to_cnode_always_appropriate_strg real_cte_tcb_valid caps_of_state_valid @@ -511,15 +502,15 @@ lemma transfer_caps_loop_presM: apply (clarsimp simp: remove_rights_def caps_of_state_valid neq_Nil_conv cte_wp_at_caps_of_state imp_conjR[symmetric] conj_comms - split del: if_splits) + split del: if_split) apply (intro conjI) apply clarsimp apply (case_tac "cap = a",clarsimp) apply (clarsimp simp:masked_as_full_def is_cap_simps) apply (clarsimp simp: cap_master_cap_simps split:if_splits) - apply (clarsimp split del:if_splits) + apply (clarsimp split del: if_split) apply (intro conjI) - apply (clarsimp split:if_splits) + apply (clarsimp split: if_split) apply (clarsimp) apply (rule ballI) apply (drule(1) bspec) @@ -675,6 +666,7 @@ lemma (in Ipc_AI) derive_cap_objrefs_iszombie: \\s::'state_ext state. \ is_zombie cap \ P (obj_refs cap) False s\ derive_cap slot cap \\rv s. rv \ cap.NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" + including no_pre apply (case_tac cap, simp_all add: derive_cap_def is_zombie_def) apply (rule hoare_pre, (wp | simp add: o_def arch_derive_cap_objrefs_iszombie)+)+ @@ -762,15 +754,14 @@ lemma transfer_caps_loop_arch[wp]: \\s::'state_ext state. P (arch_state s)\ transfer_caps_loop ep buffer n caps slots mi \\rv s. P (arch_state s)\" - by (rule transfer_caps_loop_pres) wp - + by (rule transfer_caps_loop_pres) wp+ lemma transfer_caps_loop_valid_arch[wp]: "\ep buffer n caps slots mi. \valid_arch_state::'state_ext state \ bool\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ lemma tcl_reply': "\slots caps ep buffer n mi. @@ -782,8 +773,6 @@ lemma tcl_reply': apply (rule hoare_pre) apply (rule transfer_caps_loop_presM[where vo=True and em=False and ex=False]) apply wp - apply (clarsimp simp: real_cte_at_cte) - apply (clarsimp simp: cte_wp_at_caps_of_state is_derived_def) apply (clarsimp simp: real_cte_at_cte) apply (clarsimp simp: cte_wp_at_caps_of_state is_derived_def is_cap_simps) apply (frule(1) valid_reply_mastersD[OF caps_of_state_cteD]) @@ -791,8 +780,8 @@ lemma tcl_reply': apply (frule(1) caps_of_state_valid) apply (clarsimp simp: tcb_cap_valid_def valid_cap_def is_cap_simps) apply (clarsimp simp: obj_at_def is_tcb is_cap_table cap_master_cap_def) - apply (wp valid_reply_caps_st_cte_lift valid_reply_masters_cte_lift|simp)+ - apply (clarsimp simp:cte_wp_at_caps_of_state | intro conjI ballI)+ + apply (wpsimp wp: valid_reply_caps_st_cte_lift valid_reply_masters_cte_lift) + apply (clarsimp simp:cte_wp_at_caps_of_state | intro conjI)+ apply (drule(1) bspec,clarsimp) apply (frule(1) caps_of_state_valid) apply (fastforce simp:valid_cap_def) @@ -813,7 +802,7 @@ lemma transfer_caps_loop_irq_node[wp]: \\s::'state_ext state. P (interrupt_irq_node s)\ transfer_caps_loop ep buffer n caps slots mi \\rv s. P (interrupt_irq_node s)\" - by (rule transfer_caps_loop_pres) wp + by (rule transfer_caps_loop_pres; wp) lemma cap_master_cap_irqs: "\cap. cap_irqs cap = (case cap_master_cap cap @@ -853,7 +842,7 @@ lemma transfer_caps_loop_arch_objs[wp]: "\valid_arch_objs :: 'state_ext state \ bool\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_arch_objs\" - by (rule transfer_caps_loop_pres) wp + by (rule transfer_caps_loop_pres; wp) crunch valid_arch_caps [wp]: set_extra_badge valid_arch_caps @@ -1013,8 +1002,8 @@ lemma transfer_caps_loop_valid_irq_states[wp]: \\s::'state_ext state. valid_irq_states s\ transfer_caps_loop ep buffer n caps slots mi \\_. valid_irq_states\" - apply(wp transfer_caps_loop_pres) - done + by (wp transfer_caps_loop_pres) + lemma transfer_caps_respects_device_region[wp]: "\\s::'state_ext state. pspace_respects_device_region s\ @@ -1049,14 +1038,11 @@ lemma transfer_caps_loop_invs[wp]: \ transfer_caps_srcs caps s\ transfer_caps_loop ep buffer n caps slots mi \\rv. invs\" - apply (simp add: invs_def valid_state_def valid_pspace_def) - apply (rule hoare_pre) - apply (wp valid_irq_node_typ | simp)+ - done + unfolding invs_def valid_state_def valid_pspace_def by (wpsimp wp: valid_irq_node_typ) end - +(* FIXME: move *) lemma zipWith_append2: "length ys + 1 < n \ zipWith f [0 ..< n] (ys @ [y]) = zipWith f [0 ..< n] ys @ [f (length ys) y]" @@ -1066,7 +1052,7 @@ lemma zipWith_append2: apply (subst zip_take_triv[OF order_refl, symmetric], fastforce) done - +(* FIXME: move *) lemma list_all2_zip_same: assumes rl: "\a a' x y. P (x, a) (y, a) \ P (x, a') (y, a')" shows "list_all2 (\x y. P (x, a) (y, a)) xs ys \ list_all2 P (zip xs as) (zip ys as)" @@ -1084,19 +1070,14 @@ lemma list_all2_zip_same: lemma grs_distinct[wp]: "\\\ get_receive_slots t buf \\rv s. distinct rv\" - apply (cases buf, simp_all add: split_def unlessE_def) - apply (wp | simp)+ - done + by (cases buf; wpsimp) lemma transfer_caps_mi_label[wp]: "\\s. P (mi_label mi)\ transfer_caps mi caps ep receiver recv_buf \\mi' s. P (mi_label mi')\" - apply (simp add: transfer_caps_def) - apply (wp | wpc)+ - apply simp - done + by (wpsimp simp: transfer_caps_def) context Ipc_AI begin @@ -1105,9 +1086,12 @@ lemma transfer_cap_typ_at[wp]: \\s::'state_ext state. P (typ_at T p s)\ transfer_caps mi caps ep receiver recv_buf \\rv s. P (typ_at T p s)\" + (* FIXME: wp_cleanup apply (simp add: transfer_caps_def split_def split del: if_split | wp cap_insert_typ_at hoare_drop_imps|wpc)+ done + *) + by (wpsimp wp: cap_insert_typ_at hoare_drop_imps simp: transfer_caps_def) lemma transfer_cap_tcb[wp]: "\mi caps ep receiver recv_buf. @@ -1137,10 +1121,7 @@ lemma lookup_cap_cte_caps_to[wp]: "\\s. \rs cp. P (mask_cap rs cp) = P cp\ lookup_cap t cref \\rv s. P rv \ (\p\cte_refs rv (interrupt_irq_node s). ex_cte_cap_wp_to P p s)\,-" - apply (simp add: lookup_cap_def split_def) - apply (rule hoare_pre, wp) - apply simp - done + by (simp add: lookup_cap_def split_def) wpsimp lemma is_cnode_cap_mask[simp]: @@ -1159,16 +1140,12 @@ lemma get_rs_cap_to[wp]: lemma derive_cap_notzombie[wp]: "\\\ derive_cap slot cap \\rv s. \ is_zombie rv\,-" - apply (cases cap, simp_all add: derive_cap_def is_zombie_def) - apply (rule hoare_pre, (wp | simp add: o_def)+)+ - done + by (cases cap; wpsimp simp: derive_cap_def is_zombie_def o_def) lemma derive_cap_notIRQ[wp]: "\\\ derive_cap slot cap \\rv s. rv \ cap.IRQControlCap\,-" - apply (cases cap, simp_all add: derive_cap_def) - apply (rule hoare_pre, (wp | simp add: o_def)+)+ - done + by (cases cap; wpsimp simp: derive_cap_def o_def) lemma get_cap_zombies_helper: @@ -1223,16 +1200,14 @@ lemma no_irq_case_option: "\ no_irq f; \x. no_irq (g x) \ \ no_irq (case_option f g x)" apply (subst no_irq_def) apply clarsimp - apply (rule hoare_pre) - apply (wpc|wp no_irq|simp)+ + apply (rule hoare_pre, wpsimp wp: no_irq) + apply assumption done lemma get_mrs_inv[wp]: "\P\ get_mrs t buf info \\rv. P\" - by (simp add: get_mrs_def load_word_offs_def - | wp dmo_inv loadWord_inv mapM_wp' | wpc)+ - + by (wpsimp simp: get_mrs_def load_word_offs_def wp: dmo_inv loadWord_inv mapM_wp') lemma copy_mrs_typ_at[wp]: @@ -1242,7 +1217,7 @@ lemma copy_mrs_typ_at[wp]: cong: option.case_cong split del: if_split) apply (wp hoare_vcg_split_case_option mapM_wp') - apply (wp hoare_drop_imps mapM_wp') + apply (wp hoare_drop_imps mapM_wp')+ apply simp_all done @@ -1269,6 +1244,8 @@ lemma store_word_offs_invs[wp]: lemma copy_mrs_invs[wp]: "\ invs and tcb_at r and tcb_at s \ copy_mrs s sb r rb n \\rv. invs \" + unfolding copy_mrs_redux by (wpsimp wp: mapM_wp') + (* FIXME: wp_cleanup apply (simp add: copy_mrs_redux) apply wp apply (rule_tac P="invs" in hoare_triv) @@ -1282,6 +1259,7 @@ lemma copy_mrs_invs[wp]: apply wp apply simp+ done + *) lemma set_mrs_valid_objs [wp]: "\valid_objs\ set_mrs t a msgs \\rv. valid_objs\" @@ -1370,7 +1348,7 @@ lemma set_mrs_caps_of_state[wp]: lemma set_mrs_mdb [wp]: "\valid_mdb\ set_mrs t b m \\_. valid_mdb\" - by (rule valid_mdb_lift, wp) + by (rule valid_mdb_lift; wp) crunch mdb_P [wp]: copy_mrs "\s. P (cdt s)" @@ -1580,7 +1558,7 @@ lemma do_ipc_transfer_valid_arch[wp]: \valid_arch_state::'state_ext state \ bool\ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift; wp) end @@ -1597,9 +1575,10 @@ lemma copy_mrs_irq_handlers[wp]: apply (rule copy_mrs_thread_set_dmo) apply ((wp valid_irq_handlers_lift thread_set_caps_of_state_trivial ball_tcb_cap_casesI | simp)+)[1] - apply wp + apply wp+ done + context Ipc_AI begin crunch irq_handlers[wp]: do_ipc_transfer "valid_irq_handlers :: 'state_ext state \ bool" @@ -1710,10 +1689,10 @@ lemma set_mrs_valid_ioc[wp]: \\_. valid_ioc\" apply (simp add: set_mrs_def) apply (wp | wpc)+ - apply (simp only: zipWithM_x_mapM_x split_def) - apply (wp mapM_x_wp[where S="UNIV", simplified] set_object_valid_ioc_caps static_imp_wp) - apply (rule hoare_strengthen_post, wp set_object_valid_ioc_caps, simp) - apply wp + apply (simp only: zipWithM_x_mapM_x split_def) + apply (wp mapM_x_wp[where S="UNIV", simplified] set_object_valid_ioc_caps static_imp_wp)+ + apply (rule hoare_strengthen_post, wp set_object_valid_ioc_caps, simp) + apply wp apply (clarsimp simp: obj_at_def get_tcb_def valid_ioc_def split: option.splits Structures_A.kernel_object.splits) apply (intro conjI impI allI) @@ -1758,16 +1737,14 @@ lemma set_mrs_def2: context Ipc_AI begin lemma set_mrs_vms[wp]: - "\thread buf msgs. + notes if_split [split del] + shows "\thread buf msgs. \valid_machine_state::'state_ext state \ bool\ set_mrs thread buf msgs \\_. valid_machine_state\" - apply (simp add: set_mrs_def2) - apply (wp | wpc)+ - apply (simp only: zipWithM_x_mapM_x split_def) - apply (wp mapM_x_wp_inv hoare_vcg_all_lift hoare_drop_imps) - apply simp_all - done + unfolding set_mrs_def2 + by (wpsimp simp: zipWithM_x_mapM_x split_def + wp: mapM_x_wp_inv hoare_vcg_all_lift hoare_drop_imps) crunch vms[wp]: do_ipc_transfer "valid_machine_state :: 'state_ext state \ bool" (wp: mapM_UNIV_wp) @@ -1776,18 +1753,10 @@ lemma do_ipc_transfer_invs[wp]: "\invs and tcb_at r and tcb_at s :: 'state_ext state \ bool\ do_ipc_transfer s ep bg grt r \\rv. invs\" - apply (simp add: do_ipc_transfer_def) - apply (wp|wpc)+ - apply (simp add: do_normal_transfer_def transfer_caps_def bind_assoc) - apply (wp|wpc)+ - apply (rule hoare_vcg_all_lift) - apply (rule hoare_drop_imps) - apply wp - apply (subst ball_conj_distrib) - apply (wp get_rs_cte_at2 thread_get_wp static_imp_wp - hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift) - apply (rule hoare_strengthen_post[of P _ "\_. P" for P]) - apply (wp lookup_ipc_buffer_inv) + unfolding do_ipc_transfer_def + apply (wpsimp simp: do_normal_transfer_def transfer_caps_def bind_assoc ball_conj_distrib + wp: hoare_drop_imps get_rs_cte_at2 thread_get_wp + hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift) apply (clarsimp simp: obj_at_def is_tcb invs_valid_objs) done @@ -1809,7 +1778,7 @@ end lemma (in Ipc_AI) handle_fault_reply_typ_at[wp]: "\\s :: 'state_ext state. P (typ_at T p s)\ handle_fault_reply ft t label msg \\rv s. P (typ_at T p s)\" - by(cases ft, simp_all, wp) + by(cases ft, simp_all, wp+) lemma (in Ipc_AI) handle_fault_reply_tcb[wp]: "\tcb_at t' :: 'state_ext state \ bool\ @@ -2048,7 +2017,7 @@ lemma sai_invs[wp]: apply (rule hoare_vcg_conj_lift[OF hoare_strengthen_post[OF cancel_ipc_simple]]) apply (fastforce elim: st_tcb_weakenE) apply (wp cancel_ipc_ex_nonz_cap_to_tcb cancel_ipc_simple2 set_ntfn_minor_invs - hoare_disjI2 cancel_ipc_cte_wp_at_not_reply_state) + hoare_disjI2 cancel_ipc_cte_wp_at_not_reply_state)+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def st_tcb_at_tcb_at receive_blocked_def st_tcb_at_reply_cap_valid) @@ -2105,9 +2074,7 @@ lemma recv_ep_distinct: done lemma rfk_invs: "\invs and tcb_at t\ reply_from_kernel t r \\rv. invs\" - apply (cases r, simp_all add: reply_from_kernel_def) - apply (wp | simp | clarsimp)+ - done + unfolding reply_from_kernel_def by (cases r; wpsimp) lemma st_tcb_at_valid_st: "\ invs s ; tcb_at t s ; st_tcb_at (op= st) t s \ \ valid_tcb_state st s" @@ -2273,20 +2240,19 @@ lemma setup_caller_cap_globals[wp]: setup_caller_cap sender rcvr \\rv. valid_global_refs\" apply (simp add: setup_caller_cap_def) - apply (rule hoare_pre, wp) - apply clarsimp + apply wpsimp apply (frule st_tcb_at_reply_cap_valid, clarsimp+) apply (clarsimp simp: cte_wp_at_caps_of_state cap_range_def) done lemma setup_caller_cap_ifunsafe[wp]: - "\if_unsafe_then_cap and valid_objs and tcb_at rcvr and ex_nonz_cap_to rcvr\ setup_caller_cap sender rcvr \\rv. if_unsafe_then_cap\" - apply (simp add: setup_caller_cap_def) - apply (wp cap_insert_ifunsafe ex_cte_cap_to_pres) - apply (clarsimp simp: ex_nonz_tcb_cte_caps dom_tcb_cap_cases) - apply clarsimp - done + "\if_unsafe_then_cap and valid_objs and tcb_at rcvr and ex_nonz_cap_to rcvr\ + setup_caller_cap sender rcvr + \\rv. if_unsafe_then_cap\" + unfolding setup_caller_cap_def + by (wpsimp wp: cap_insert_ifunsafe ex_cte_cap_to_pres + simp: ex_nonz_tcb_cte_caps dom_tcb_cap_cases) lemmas (in Ipc_AI) transfer_caps_loop_cap_to[wp] = transfer_caps_loop_pres [OF cap_insert_ex_cap] @@ -2328,7 +2294,7 @@ crunch Pmdb[wp]: set_thread_state "\s. P (cdt s)" lemma setup_caller_cap_valid_arch [wp]: "\valid_arch_state\ setup_caller_cap x y \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift; wp) lemma setup_caller_cap_reply[wp]: @@ -2338,20 +2304,18 @@ lemma setup_caller_cap_reply[wp]: \\rv. valid_reply_caps\" apply (simp add: setup_caller_cap_def) apply wp - apply (rule_tac Q="\rv s. pspace_aligned s \ tcb_at st s \ + apply (rule_tac Q="\rv s. pspace_aligned s \ tcb_at st s \ st_tcb_at (\ts. ts = Structures_A.thread_state.BlockedOnReply) st s \ \ has_reply_cap st s" in hoare_post_imp) - apply (fastforce simp: valid_cap_def cap_aligned_def + apply (fastforce simp: valid_cap_def cap_aligned_def tcb_at_def pspace_aligned_def word_bits_def dest!: get_tcb_SomeD elim!: my_BallE [where y=st] pred_tcb_weakenE) - apply (wp sts_st_tcb_at has_reply_cap_cte_lift) - apply (strengthen reply_cap_doesnt_exist_strg) - apply (clarsimp simp: st_tcb_at_tcb_at)+ - apply (clarsimp intro!: tcb_at_cte_at) + apply (wp sts_st_tcb_at has_reply_cap_cte_lift) apply (strengthen reply_cap_doesnt_exist_strg) - apply (clarsimp split: option.split) + apply (clarsimp simp: st_tcb_at_tcb_at)+ + apply (clarsimp intro!: tcb_at_cte_at) done @@ -2360,7 +2324,7 @@ lemma setup_caller_cap_reply_masters[wp]: setup_caller_cap st rt \\rv. valid_reply_masters\" unfolding setup_caller_cap_def - by (wp | simp add: is_cap_simps tcb_at_cte_at dom_tcb_cap_cases)+ + by (wpsimp simp: is_cap_simps tcb_at_cte_at dom_tcb_cap_cases) lemma setup_caller_cap_irq_handlers[wp]: @@ -2368,7 +2332,7 @@ lemma setup_caller_cap_irq_handlers[wp]: setup_caller_cap st rt \\rv. valid_irq_handlers\" unfolding setup_caller_cap_def - by (wp | simp add: is_cap_simps tcb_at_cte_at dom_tcb_cap_cases)+ + by (wpsimp simp: is_cap_simps tcb_at_cte_at dom_tcb_cap_cases) context Ipc_AI begin @@ -2377,9 +2341,8 @@ lemma setup_caller_cap_valid_arch_caps[wp]: \valid_arch_caps and valid_objs and st_tcb_at (Not o halted) sender\ setup_caller_cap sender recvr \\rv. valid_arch_caps :: 'state_ext state \ bool\" - apply (simp add: setup_caller_cap_def) - apply (rule hoare_pre) - apply (wp cap_insert_valid_arch_caps | simp)+ + unfolding setup_caller_cap_def + apply (wpsimp wp: cap_insert_valid_arch_caps) apply (auto elim: st_tcb_at_reply_cap_valid) done @@ -2672,7 +2635,7 @@ crunch arch[wp]: set_message_info "\s. P (arch_state s)" lemma set_message_info_valid_arch [wp]: "\valid_arch_state\ set_message_info a b \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift; wp) crunch caps[wp]: set_message_info "\s. P (caps_of_state s)" @@ -2681,7 +2644,7 @@ crunch irq_node[wp]: set_message_info "\s. P (interrupt_irq_node s)" lemma set_message_info_global_refs [wp]: "\valid_global_refs\ set_message_info a b \\_. valid_global_refs\" - by (rule valid_global_refs_cte_lift) wp + by (rule valid_global_refs_cte_lift; wp) crunch irq_node[wp]: set_mrs "\s. P (interrupt_irq_node s)" (wp: crunch_wps simp: crunch_simps) @@ -2703,13 +2666,12 @@ lemma valid_bound_tcb_exst[iff]: "valid_bound_tcb t (trans_state f s) = valid_bound_tcb t s" by (auto simp: valid_bound_tcb_def split:option.splits) -(* joel move *) +(* FIXME: move *) lemma valid_bound_tcb_typ_at: "\p. \\s. typ_at ATCB p s\ f \\_ s. typ_at ATCB p s\ \ \\s. valid_bound_tcb tcb s\ f \\_ s. valid_bound_tcb tcb s\" apply (clarsimp simp: valid_bound_tcb_def split: option.splits) - apply (wp hoare_vcg_all_lift tcb_at_typ_at static_imp_wp) - apply (fastforce) + apply (wpsimp wp: hoare_vcg_all_lift tcb_at_typ_at static_imp_wp) done crunch bound_tcb[wp]: set_thread_state, set_message_info, set_mrs "valid_bound_tcb t" @@ -2889,7 +2851,7 @@ lemma si_invs': apply (simp add: invs_def valid_state_def valid_pspace_def) apply (wp valid_irq_node_typ) apply (simp add: valid_ep_def) - apply (rule hoare_pre, wp valid_irq_node_typ sts_only_idle) + apply (wp valid_irq_node_typ sts_only_idle) apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at) apply (rule conjI, clarsimp elim!: obj_at_weakenE simp: is_ep_def) apply (rule conjI, clarsimp simp: st_tcb_at_reply_cap_valid) @@ -2904,14 +2866,13 @@ lemma si_invs': apply (simp add: obj_at_def is_ep) apply (fastforce dest: idle_no_ex_cap valid_reply_capsD simp: st_tcb_def2) - apply (wp, simp) + apply wpsimp apply (rename_tac list) apply (cases bl, simp_all)[1] apply (simp add: invs_def valid_state_def valid_pspace_def) apply (wp valid_irq_node_typ) apply (simp add: valid_ep_def) - apply (rule hoare_pre, wp hoare_vcg_const_Ball_lift - valid_irq_node_typ sts_only_idle) + apply ( wp hoare_vcg_const_Ball_lift valid_irq_node_typ sts_only_idle) apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at) apply (frule ko_at_state_refs_ofD) apply (frule active_st_tcb_at_state_refs_ofD) @@ -2931,11 +2892,10 @@ lemma si_invs': apply (rule conjI, clarsimp simp: pred_tcb_at_def obj_at_def) apply (drule(1) sym_refs_ko_atD, clarsimp simp: st_tcb_at_refs_of_rev) apply (drule(1) bspec, clarsimp simp: pred_tcb_at_def obj_at_def) - apply (wp, simp) + apply wpsimp apply (rename_tac list) apply (case_tac list, simp_all add: invs_def valid_state_def valid_pspace_def split del:if_split) - apply (rule hoare_pre) - apply (wp valid_irq_node_typ) + apply (wp valid_irq_node_typ) apply (simp add: if_apply_def2 ) apply (wp sts_only_idle sts_st_tcb_at_cases valid_irq_node_typ) apply (wp hoare_drop_imps sts_st_tcb_at_cases valid_irq_node_typ do_ipc_transfer_tcb_caps @@ -3147,12 +3107,8 @@ lemma hf_makes_simple: "\st_tcb_at simple t' and K (t \ t') :: 'state_ext state \ bool\ handle_fault t ft \\rv. st_tcb_at simple t'\" - apply (simp add: handle_fault_def) - apply wp - apply (simp add: handle_double_fault_def) - apply (wp sfi_makes_simple sts_st_tcb_at_cases hoare_drop_imps) - apply clarsimp - done + unfolding handle_fault_def + by (wpsimp wp: sfi_makes_simple sts_st_tcb_at_cases hoare_drop_imps simp: handle_double_fault_def) end @@ -3198,17 +3154,13 @@ lemma rai_makes_simple: "\st_tcb_at simple t' and K (t \ t')\ receive_signal t cap is_blocking \\rv. st_tcb_at simple t'\" - apply (rule hoare_gen_asm) - apply (simp add: receive_signal_def) - apply (rule hoare_pre) - by (wp get_ntfn_wp sts_st_tcb_at_cases | wpc | simp add: do_nbrecv_failed_transfer_def)+ + unfolding receive_signal_def + apply (rule hoare_gen_asm) + by (wpsimp wp: get_ntfn_wp sts_st_tcb_at_cases simp: do_nbrecv_failed_transfer_def) lemma thread_set_Pmdb: "\\s. P (cdt s)\ thread_set f t \\rv s. P (cdt s)\" - apply (simp add: thread_set_def) - apply (wp set_object_Pmdb) - apply simp - done + unfolding thread_set_def by (wpsimp wp: set_object_Pmdb) end diff --git a/proof/invariant-abstract/KHeap_AI.thy b/proof/invariant-abstract/KHeap_AI.thy index 6cabcdf74..2a55b1aac 100644 --- a/proof/invariant-abstract/KHeap_AI.thy +++ b/proof/invariant-abstract/KHeap_AI.thy @@ -55,15 +55,19 @@ lemma get_object_wp: apply (clarsimp simp: obj_at_def) done +context + notes get_object_wp [wp] +begin + lemma get_ntfn_wp: "\\s. \ntfn. ko_at (Notification ntfn) ntfnptr s \ P ntfn s\ get_notification ntfnptr \P\" apply (simp add: get_notification_def) - apply (wp get_object_wp | wpc)+ + apply (wp | wpc)+ apply clarsimp done lemma get_object_inv [wp]: "\P\ get_object t \\rv. P\" - by (wp get_object_wp) simp + by wpsimp lemma get_tcb_rev: @@ -72,8 +76,9 @@ lemma get_tcb_rev: lemma get_tcb_SomeD: "get_tcb t s = Some v \ kheap s t = Some (TCB v)" - apply (case_tac "kheap s t", simp_all add: get_tcb_def) - apply (case_tac a, simp_all) + apply (cases "kheap s t"; simp add: get_tcb_def) + apply (rename_tac obj) + apply (case_tac obj; simp) done @@ -232,7 +237,6 @@ shows apply (simp add: xopv[simplified trans_state_update']) done - crunch ct[wp]: set_thread_state "\s. P (cur_thread s)" lemma sts_ep_at_inv[wp]: @@ -318,14 +322,8 @@ lemma obj_at_ko_atD: lemma get_endpoint_sp: "\P\ get_endpoint p \\ep. ko_at (Endpoint ep) p and P\" - apply (simp add: get_endpoint_def) - apply wp - prefer 2 - apply (rule get_object_sp) - apply (case_tac kobj) - apply (simp|wp)+ - done - + unfolding get_endpoint_def + by (wp|wpc)+ clarsimp lemma set_object_ko: "\ko_at obj ptr and K (x \ ptr)\ set_object x ko \\rv. ko_at obj ptr\" @@ -350,21 +348,13 @@ lemma set_object_ko_at: done lemma get_ep_inv[wp]: "\P\ get_endpoint ep \\rv. P\" - apply (simp add: get_endpoint_def) - apply wp - defer - apply (rule get_object_inv) - apply (case_tac kobj, simp_all) - done + unfolding get_endpoint_def + by (wp|wpc)+ clarsimp lemma get_ntfn_inv[wp]: "\P\ get_notification ep \\rv. P\" - apply (simp add: get_notification_def) - apply wp - defer - apply (rule get_object_inv) - apply (case_tac kobj, simp_all) - done + unfolding get_notification_def + by (wp|wpc)+ clarsimp lemma get_ep_actual_ep[wp]: "\ invs and ep_at ep \ @@ -374,7 +364,7 @@ lemma get_ep_actual_ep[wp]: valid_def gets_def get_def return_def fail_def assert_def obj_at_def is_ep_def) apply (case_tac y, simp_all add: return_def) -done + done lemma get_object_valid [wp]: "\valid_objs\ get_object oref \ valid_obj oref \" @@ -422,31 +412,25 @@ done lemma set_ep_valid_objs[wp]: "\valid_ep v and valid_objs\ set_endpoint ep v \\rv s. valid_objs s\" - apply (simp add: set_endpoint_def) + unfolding set_endpoint_def apply (wp set_object_valid_objs) - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (clarsimp simp add: valid_obj_def obj_at_def) - apply (case_tac r, simp_all add: a_type_def) + apply (clarsimp simp: valid_obj_def obj_at_def a_type_def split: kernel_object.splits) done lemma set_ep_aligned[wp]: "\pspace_aligned\ set_endpoint ep v \\rv. pspace_aligned\" - apply (simp add: set_endpoint_def) + unfolding set_endpoint_def apply (wp set_object_aligned) - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (clarsimp simp add: obj_at_def a_type_def) - apply (case_tac r, simp_all) + apply (clarsimp simp: valid_obj_def obj_at_def a_type_def split: kernel_object.splits) done - lemma set_endpoint_typ_at [wp]: "\\s. P (typ_at T p s)\ set_endpoint p' ep \\rv s. P (typ_at T p s)\" apply (simp add: set_endpoint_def set_object_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (case_tac r, simp_all) apply (clarsimp simp: obj_at_def a_type_def) + apply (case_tac ko; simp) done @@ -464,9 +448,8 @@ lemma set_ntfn_valid_objs: \\rv. valid_objs\" apply (simp add: set_notification_def) apply (wp set_object_valid_objs) - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp simp: valid_obj_def obj_at_def is_ntfn) - apply (case_tac r, simp_all add: a_type_def) + apply (case_tac ko; simp add: a_type_def) done @@ -474,9 +457,8 @@ lemma set_ntfn_aligned[wp]: "\pspace_aligned\ set_notification p ntfn \\rv. pspace_aligned\" apply (simp add: set_notification_def) apply (wp set_object_aligned) - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp simp add: obj_at_def is_ntfn) - apply (case_tac r, simp_all add: a_type_def) + apply (case_tac ko, simp_all add: a_type_def) done @@ -484,9 +466,8 @@ lemma set_notification_typ_at [wp]: "\\s. P (typ_at T p s)\ set_notification p' ntfn \\rv s. P (typ_at T p s)\" apply (simp add: set_notification_def set_object_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) - apply (case_tac r, simp_all) - apply (clarsimp simp: obj_at_def a_type_def) + apply clarsimp + apply (case_tac ko; clarsimp simp: obj_at_def a_type_def) done @@ -501,11 +482,8 @@ lemma set_notification_cte_wp_at[wp]: lemma get_ntfn_ko: "\\\ get_notification ep \\rv. ko_at (Notification rv) ep\" apply (simp add: get_notification_def) - apply wp - prefer 2 - apply (rule get_object_sp) - apply (case_tac kobj) - apply (wp|simp)+ + apply (wp|wpc)+ + apply clarsimp done @@ -520,7 +498,6 @@ lemma obj_set_prop_at: lemma get_ntfn_sp: "\P\ get_notification p \\ntfn. ko_at (Notification ntfn) p and P\" apply wp - apply (rule hoare_weaken_pre) apply (rule hoare_vcg_conj_lift) apply (rule get_ntfn_ko) apply (rule get_ntfn_inv) @@ -562,16 +539,15 @@ lemma set_ep_distinct[wp]: "\pspace_distinct\ set_endpoint ep v \\_. pspace_distinct\" apply (simp add: set_endpoint_def) apply (wp set_object_distinct) - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE) - apply (case_tac ko, simp_all add: a_type_def) + apply (rename_tac ko) + apply (case_tac ko; simp add: a_type_def) done lemma set_ep_cur_tcb[wp]: "\cur_tcb\ set_endpoint ep v \\rv. cur_tcb\" apply (simp add: set_endpoint_def set_object_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (auto simp: cur_tcb_def obj_at_def is_tcb is_ep) done @@ -605,7 +581,7 @@ lemma set_object_pspace_respect_device_region: lemma set_ntfn_kernel_window[wp]: "\pspace_in_kernel_window\ set_notification ptr val \\rv. pspace_in_kernel_window\" apply (simp add: set_notification_def) - apply (wp set_object_pspace_in_kernel_window get_object_wp) + apply (wp set_object_pspace_in_kernel_window) apply (clarsimp simp: obj_at_def a_type_def split: Structures_A.kernel_object.split_asm) done @@ -621,7 +597,7 @@ lemma set_ntfn_respect_device_region[wp]: lemma set_ep_kernel_window[wp]: "\pspace_in_kernel_window\ set_endpoint ptr val \\rv. pspace_in_kernel_window\" apply (simp add: set_endpoint_def) - apply (wp set_object_pspace_in_kernel_window get_object_wp) + apply (wp set_object_pspace_in_kernel_window) apply (clarsimp simp: obj_at_def a_type_def split: Structures_A.kernel_object.split_asm) done @@ -752,7 +728,6 @@ lemma set_ep_iflive[wp]: set_endpoint p ep \\rv. if_live_then_nonz_cap\" apply (simp add: set_endpoint_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE split: Structures_A.kernel_object.splits simp: is_ep_def) @@ -763,7 +738,6 @@ lemma set_ep_ifunsafe[wp]: "\if_unsafe_then_cap\ set_endpoint p val \\rv. if_unsafe_then_cap\" apply (simp add: set_endpoint_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE simp: is_ep_def) done @@ -772,7 +746,6 @@ lemma set_ep_zombies[wp]: "\zombies_final\ set_endpoint p val \\rv. zombies_final\" apply (simp add: set_endpoint_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE simp: is_ep_def) done @@ -783,9 +756,9 @@ lemma set_ntfn_distinct[wp]: \\rv. pspace_distinct\" apply (simp add: set_notification_def) apply (wp set_object_distinct) - apply (rule hoare_strengthen_post [OF get_object_sp]) apply clarsimp apply (erule obj_at_weakenE) + apply (rename_tac ko) apply (case_tac ko, simp_all add: a_type_def) done @@ -805,7 +778,6 @@ lemma set_ntfn_cur_tcb[wp]: "\cur_tcb\ set_notification ntfn v \\rv. cur_tcb\" apply (simp add: set_notification_def set_object_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (auto simp: cur_tcb_def obj_at_def is_tcb is_ntfn) done @@ -864,7 +836,6 @@ lemma set_ntfn_iflive[wp]: set_notification p ntfn \\rv. if_live_then_nonz_cap\" apply (simp add: set_notification_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE simp: is_ntfn_def split: Structures_A.kernel_object.splits) done @@ -874,7 +845,6 @@ lemma set_ntfn_ifunsafe[wp]: "\if_unsafe_then_cap\ set_notification p val \\rv. if_unsafe_then_cap\" apply (simp add: set_notification_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE simp: is_ntfn_def) done @@ -883,7 +853,6 @@ lemma set_ntfn_zombies[wp]: "\zombies_final\ set_notification p val \\rv. zombies_final\" apply (simp add: set_notification_def) apply wp - apply (rule hoare_strengthen_post [OF get_object_sp]) apply (clarsimp elim!: obj_at_weakenE simp: is_ntfn_def) done @@ -1082,14 +1051,8 @@ lemma set_ep_pred_tcb_at [wp]: set_endpoint ep v \ \rv. pred_tcb_at proj f t \" apply (simp add: set_endpoint_def pred_tcb_at_def) - apply wp - defer - apply (rule assert_sp) - apply (rule get_object_sp) - apply simp - apply (case_tac obj, simp_all) - apply (rule set_object_at_obj2 [unfolded pred_conj_def]) - apply clarsimp + apply (wp set_object_at_obj2|simp)+ + apply (clarsimp simp: obj_at_def) done lemma set_endpoint_ep_at[wp]: @@ -1099,19 +1062,11 @@ lemma set_endpoint_ep_at[wp]: lemma set_endpoint_obj_at: "\\s. P (Endpoint ep)\ set_endpoint ptr ep \\rv. obj_at P ptr\" - apply (simp add: set_endpoint_def) - apply (wp obj_set_prop_at) - apply (rule hoare_drop_imps, wp) - done - + unfolding set_endpoint_def by (wpsimp wp: obj_set_prop_at) lemma set_notification_obj_at: "\\s. P (Notification ep)\ set_notification ptr ep \\rv. obj_at P ptr\" - apply (simp add: set_notification_def) - apply (wp obj_set_prop_at) - apply (rule hoare_drop_imps, wp) - done - + unfolding set_notification_def by (wpsimp wp: obj_set_prop_at) lemma cte_wp_at_neg2: "(\ cte_wp_at P p s) = (cte_at p s \ cte_wp_at (\cap. \ P cap) p s)" @@ -1206,7 +1161,7 @@ crunch arch[wp]: set_notification "\s. P (arch_state s)" lemma set_notification_valid_arch [wp]: "\valid_arch_state\ set_notification ntfn p \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ crunch irq_node_inv[wp]: set_notification "\s. P (interrupt_irq_node s)" @@ -1215,7 +1170,7 @@ crunch irq_node_inv[wp]: set_notification "\s. P (interrupt_irq_node s)" lemma set_notification_global_refs [wp]: "\valid_global_refs\ set_notification ntfn p \\_. valid_global_refs\" - by (rule valid_global_refs_cte_lift) wp + by (rule valid_global_refs_cte_lift) wp+ lemma set_notification_idle[wp]: @@ -1251,7 +1206,7 @@ crunch arch[wp]: set_endpoint "\s. P (arch_state s)" lemma set_endpoint_valid_arch [wp]: "\valid_arch_state\ set_endpoint ep p \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ crunch irq_node_inv[wp]: set_endpoint "\s. P (interrupt_irq_node s)" @@ -1264,7 +1219,7 @@ crunch it[wp]: set_endpoint "\s. P (idle_thread s)" lemma set_ep_global_refs [wp]: "\valid_global_refs\ set_endpoint ep p \\_. valid_global_refs\" - by (rule valid_global_refs_cte_lift) wp + by (rule valid_global_refs_cte_lift) wp+ lemma set_endpoint_reply[wp]: @@ -1313,6 +1268,7 @@ lemma set_object_memory[wp]: apply wp by simp +end locale non_arch_op = fixes f assumes aobj_at: "\P P' p. arch_obj_pred P' \ @@ -1321,47 +1277,48 @@ locale non_arch_op = fixes f begin lemma valid_arch_obj[wp]:"\valid_arch_objs\ f \\_. valid_arch_objs\" -by (rule valid_arch_objs_lift_weak; wp aobj_at; simp) + by (rule valid_arch_objs_lift_weak; wp aobj_at; simp) lemma vs_lookup[wp]: "\\s. P (vs_lookup s)\ f \\_ s. P (vs_lookup s)\" -by (rule vs_lookup_arch_obj_at_lift; wp aobj_at; simp) + by (rule vs_lookup_arch_obj_at_lift; wp aobj_at; simp) lemma vs_lookup_pages[wp]: "\\s. P (vs_lookup_pages s)\ f \\_ s. P (vs_lookup_pages s)\" -by (rule vs_lookup_pages_arch_obj_at_lift; wp aobj_at; simp) + by (rule vs_lookup_pages_arch_obj_at_lift; wp aobj_at; simp) lemma valid_global_objs[wp]: "\valid_global_objs\ f \\rv. valid_global_objs\" -by (rule valid_global_objs_lift_weak, wp aobj_at) + by (rule valid_global_objs_lift_weak; wp aobj_at) lemma valid_asid_map[wp]: "\valid_asid_map\ f \\_. valid_asid_map\" -by (rule valid_asid_map_lift, wp aobj_at) + by (rule valid_asid_map_lift; wp aobj_at) lemma valid_kernel_mappings[wp]: "\valid_kernel_mappings\ f \\_. valid_kernel_mappings\" -by (rule valid_kernel_mappings_lift, wp aobj_at) + by (rule valid_kernel_mappings_lift; wp aobj_at) lemma equal_kernel_mappings[wp]: "\equal_kernel_mappings\ f \\_. equal_kernel_mappings\" -by (rule equal_kernel_mappings_lift, wp aobj_at) + by (rule equal_kernel_mappings_lift; wp aobj_at) lemma valid_global_vspace_mappings[wp]: "\valid_global_vspace_mappings\ f \\rv. valid_global_vspace_mappings\" -by (rule valid_global_vspace_mappings_lift, wp aobj_at) + by (rule valid_global_vspace_mappings_lift; wp aobj_at) lemma valid_ao_at[wp]:"\valid_ao_at p\ f \\_. valid_ao_at p\" -by (rule valid_ao_at_lift_aobj_at; wp aobj_at; simp) + by (rule valid_ao_at_lift_aobj_at; wp aobj_at; simp) lemma valid_arch_state[wp]:"\valid_arch_state\ f \\_. valid_arch_state\" -by (rule valid_arch_state_lift; wp aobj_at; simp) + by (rule valid_arch_state_lift; wp aobj_at; simp) lemma in_user_frame[wp]:"\in_user_frame p\ f \\_. in_user_frame p\" -by (rule in_user_frame_lift; wp aobj_at; simp) + by (rule in_user_frame_lift; wp aobj_at; simp) end locale non_arch_non_mem_op = non_arch_op f for f + - assumes memory[wp]: "\P. \\s. P (underlying_memory (machine_state s))\ f \\_ s. P (underlying_memory (machine_state s))\" + assumes memory[wp]: + "\P. \\s. P (underlying_memory (machine_state s))\ f \\_ s. P (underlying_memory (machine_state s))\" begin lemma valid_machine_state[wp]: "\valid_machine_state\ f \\rv. valid_machine_state\" -by (rule valid_machine_state_lift[OF memory aobj_at]) + by (rule valid_machine_state_lift[OF memory aobj_at]) end @@ -1477,7 +1434,7 @@ crunch interrupt_states[wp]: set_notification "\s. P (interrupt_states s lemmas set_notification_irq_handlers[wp] = - valid_irq_handlers_lift [OF set_ntfn_caps_of_state set_notification_interrupt_states] + valid_irq_handlers_lift [OF set_ntfn_caps_of_state set_notification_interrupt_states] lemma set_notification_only_idle [wp]: @@ -1719,7 +1676,7 @@ lemma do_machine_op_arch [wp]: lemma do_machine_op_valid_arch [wp]: "\valid_arch_state\ do_machine_op f \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ lemma do_machine_op_vs_lookup [wp]: @@ -1779,8 +1736,6 @@ lemma tcb_cap_valid_caps_of_stateD: done - - lemma add_mask_eq: "\is_aligned (w::'a::len word) n; x \ 2 ^ n - 1; n < len_of TYPE('a)\ \ (w + x) && mask n = x" diff --git a/proof/invariant-abstract/LevityCatch_AI.thy b/proof/invariant-abstract/LevityCatch_AI.thy index 1a8d96091..41e899dcb 100644 --- a/proof/invariant-abstract/LevityCatch_AI.thy +++ b/proof/invariant-abstract/LevityCatch_AI.thy @@ -38,7 +38,6 @@ lemma const_on_failure_wp : "\P\ m \Q\, \\rv. Q n\ \ \P\ const_on_failure n m \Q\" apply (simp add: const_on_failure_def) apply wp - apply simp done lemma get_cap_id: diff --git a/proof/invariant-abstract/Retype_AI.thy b/proof/invariant-abstract/Retype_AI.thy index 3704a7326..76b223589 100644 --- a/proof/invariant-abstract/Retype_AI.thy +++ b/proof/invariant-abstract/Retype_AI.thy @@ -1368,6 +1368,9 @@ lemma set_object_no_overlap: lemma set_cap_no_overlap: "\pspace_no_overlap S\ set_cap cap cte \\r. pspace_no_overlap S\" unfolding set_cap_def + by (wpsimp wp: set_object_no_overlap get_object_wp + simp: split_beta obj_at_def a_type_def wf_cs_upd [unfolded fun_upd_def]) +(* FIXME: wp_cleanup apply (simp add: split_beta) apply (wp set_object_no_overlap) defer @@ -1379,7 +1382,7 @@ lemma set_cap_no_overlap: elim!: obj_at_weakenE) apply (clarsimp simp add: a_type_def wf_cs_upd) done - +*) definition if_unsafe_then_cap2 :: "(cslot_ptr \ cap) \ (irq \ obj_ref) \ bool" @@ -1562,23 +1565,14 @@ lemma retype_region_obj_at_other: shows "\obj_at P ptr\ retype_region ptr' n us ty dev \\r. obj_at P ptr\" using ptrv unfolding retype_region_def retype_addrs_def apply (simp only: foldr_upd_app_if fun_app_def K_bind_def) - apply wp - apply (simp only: obj_at_kheap_trans_state) - apply wp - apply (clarsimp simp: power_sub) - apply (unfold obj_at_def) - apply (erule exEI) - apply (clarsimp) + apply (wpsimp simp: obj_at_def) done lemma retype_region_obj_at_other2: "\\s. ptr \ set (retype_addrs ptr' ty n us) \ obj_at P ptr s\ retype_region ptr' n us ty dev \\rv. obj_at P ptr\" - apply (rule hoare_assume_pre) - apply (wp retype_region_obj_at_other) - apply simp_all - done + by (rule hoare_assume_pre) (wpsimp wp: retype_region_obj_at_other) lemma retype_region_obj_at_other3: @@ -1586,14 +1580,14 @@ lemma retype_region_obj_at_other3: \ valid_objs s \ pspace_aligned s\ retype_region ptr n us ty dev \\rv. obj_at P p\" - apply (rule hoare_pre) - apply (rule retype_region_obj_at_other2) - apply clarsimp - apply (drule subsetD [rotated, OF _ retype_addrs_subset_ptr_bits]) - apply simp - apply (drule(3) pspace_no_overlap_obj_not_in_range) - apply (simp add: field_simps) -done + apply (rule hoare_pre) + apply (rule retype_region_obj_at_other2) + apply clarsimp + apply (drule subsetD [rotated, OF _ retype_addrs_subset_ptr_bits]) + apply simp + apply (drule(3) pspace_no_overlap_obj_not_in_range) + apply (simp add: field_simps) + done lemma retype_region_st_tcb_at: "\\(s::'state_ext::state_ext state). pspace_no_overlap_range_cover ptr' sz s \ pred_tcb_at proj P t s \ range_cover ptr' sz (obj_bits_api ty us) n @@ -1610,23 +1604,23 @@ lemma retype_region_cur_tcb[wp]: \\rv. cur_tcb\" apply (rule hoare_post_imp [where Q="\rv s. \tp. tcb_at tp s \ cur_thread s = tp"]) apply (simp add: cur_tcb_def) + apply (wpsimp wp: hoare_vcg_ex_lift retype_region_obj_at_other3 simp: retype_region_def) + apply (auto simp: cur_tcb_def cong: if_cong) + done + (* FIXME: wp_cleanup apply (rule hoare_pre, wp hoare_vcg_ex_lift retype_region_obj_at_other3) apply (simp add: retype_region_def split del: if_split cong: if_cong) apply (wp|simp)+ apply (clarsimp simp: cur_tcb_def cong: if_cong) apply auto - done + *) lemma retype_addrs_mem_sz_0_is_ptr: - assumes xv: "x \ set (retype_addrs ptr ty n us)" - and sz: "n = 0" + assumes "x \ set (retype_addrs ptr ty n us)" + and "n = 0" shows "x = ptr" - using sz xv unfolding retype_addrs_def - apply (clarsimp simp add: ptr_add_def - simp del: power_0 - dest!: less_two_pow_divD) - done + using assms unfolding retype_addrs_def by (clarsimp simp: ptr_add_def) locale Retype_AI_obj_bits_api_neq_0 = @@ -2495,8 +2489,7 @@ lemma subset_not_le_trans: "\\ A \ B; C \ B\st_tcb_at runnable t\ switch_to_thread t \\rv . (ct_in_state activatable :: 'a state \ bool) \" apply (simp add: switch_to_thread_def) apply (wp | simp add: ct_in_state_def)+ - apply (rule hoare_post_imp [OF _ arch_stt_runnable]) - apply (clarsimp elim!: pred_tcb_weakenE) - apply (rule assert_inv) - apply wp + apply (rule hoare_post_imp [OF _ arch_stt_runnable]) + apply (clarsimp elim!: pred_tcb_weakenE) + apply (rule assert_inv) + apply wp + apply assumption done diff --git a/proof/invariant-abstract/Syscall_AI.thy b/proof/invariant-abstract/Syscall_AI.thy index d1e468204..885aedc47 100644 --- a/proof/invariant-abstract/Syscall_AI.thy +++ b/proof/invariant-abstract/Syscall_AI.thy @@ -230,8 +230,7 @@ lemma thread_set_cap_to: "(\tcb. \(getF, v)\ran tcb_cap_cases. getF (f tcb) = getF tcb) \ \ex_nonz_cap_to p\ thread_set f tptr \\_. ex_nonz_cap_to p\" apply (clarsimp simp add: ex_nonz_cap_to_def) - apply (wp hoare_ex_wp thread_set_cte_wp_at_trivial) - apply (clarsimp) + apply (wpsimp wp: hoare_ex_wp thread_set_cte_wp_at_trivial) done @@ -239,16 +238,13 @@ lemma thread_set_has_no_reply_cap: "(\tcb. \(getF, v)\ran tcb_cap_cases. getF (f tcb) = getF tcb) \ \\s. \has_reply_cap tt s\ thread_set f t \\_ s. \has_reply_cap tt s\" apply (clarsimp simp add: has_reply_cap_def) - apply (wp hoare_vcg_all_lift thread_set_cte_wp_at_trivial) - apply (clarsimp) + apply (wpsimp wp: hoare_vcg_all_lift thread_set_cte_wp_at_trivial) done lemma set_object_cte_wp_at2: "\\s. P (cte_wp_at P' p (s\kheap := kheap s(ptr \ ko)\))\ set_object ptr ko \\_ s. P (cte_wp_at P' p s)\" - unfolding set_object_def - apply (wp) - done + unfolding set_object_def by wp lemma (in Systemcall_AI_Pre) handle_fault_reply_cte_wp_at: @@ -292,8 +288,7 @@ lemma (in Systemcall_AI_Pre) handle_fault_reply_cte_wp_at: lemma (in Systemcall_AI_Pre) handle_fault_reply_has_no_reply_cap: "\\s :: 'state_ext state. \has_reply_cap t s\ handle_fault_reply f t d dl \\_ s. \has_reply_cap t s\" apply (clarsimp simp add: has_reply_cap_def) - apply (wp hoare_allI handle_fault_reply_cte_wp_at) - apply (clarsimp) + apply (wpsimp wp: hoare_vcg_all_lift handle_fault_reply_cte_wp_at) done locale Systemcall_AI_Pre2 = Systemcall_AI_Pre itcb_state state_ext_t @@ -365,7 +360,7 @@ lemma (in Systemcall_AI_Pre2) do_reply_invs[wp]: apply (clarsimp) apply (erule pred_tcb_weakenE) apply (clarsimp) - apply (wp cap_delete_one_deletes_reply cap_delete_one_reply_st_tcb_at) + apply (wp cap_delete_one_deletes_reply cap_delete_one_reply_st_tcb_at)+ apply (clarsimp) apply (wp hoare_drop_imp hoare_allI)[1] apply (wp assert_wp) @@ -484,17 +479,17 @@ lemma sts_cte_wp_cdt [wp]: "\\s. cte_wp_at (P (cdt s)) p s\ set_thread_state t st \\rv s. cte_wp_at (P (cdt s)) p s\" - apply (rule cte_wp_cdt_lift) - apply wp - done + by (rule cte_wp_cdt_lift; wp) lemma sts_nasty_bit: + notes hoare_pre [wp_pre del] + shows "\\s. \r\obj_refs cap. \a b. ptr' \ (a, b) \ cte_wp_at (\cap'. r \ obj_refs cap') (a, b) s \ cte_wp_at (Not \ is_zombie) (a, b) s \ \ is_zombie cap\ set_thread_state t st \\rv s. \r\obj_refs cap. \a b. ptr' \ (a, b) \ cte_wp_at (\cap'. r \ obj_refs cap') (a, b) s \ cte_wp_at (Not \ is_zombie) (a, b) s \ \ is_zombie cap\" - apply (wp hoare_vcg_const_Ball_lift hoare_vcg_all_lift + apply (wpsimp wp: hoare_vcg_const_Ball_lift hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_disj_lift valid_cte_at_neg_typ | simp add: cte_wp_at_neg2[where P="\c. x \ obj_refs c" for x])+ apply (clarsimp simp: o_def cte_wp_at_def) @@ -545,11 +540,10 @@ lemma sts_valid_inv[wp]: (wp set_thread_state_valid_cap sts_nasty_bit hoare_vcg_const_imp_lift | simp)+) apply (rename_tac irq_control_invocation) - apply (case_tac irq_control_invocation, - (wp | simp)+) + apply (case_tac irq_control_invocation; wpsimp) apply (rename_tac irq_handler_invocation) - apply (case_tac irq_handler_invocation, simp_all) - apply (wp ex_cte_cap_to_pres hoare_vcg_ex_lift set_thread_state_valid_cap) + apply (case_tac irq_handler_invocation; + wpsimp wp: ex_cte_cap_to_pres hoare_vcg_ex_lift set_thread_state_valid_cap) done @@ -564,6 +558,8 @@ lemma sts_Restart_stay_simple: lemma decode_inv_inv[wp]: + notes hoare_pre [wp_pre del] + shows "\P\ decode_invocation label args cap_index slot cap excaps \\rv. P\" apply (case_tac cap, simp_all add: decode_invocation_def) apply (wp decode_tcb_inv_inv decode_domain_inv_inv | rule conjI | clarsimp @@ -672,31 +668,20 @@ lemma lcs_valid [wp]: lemma lec_valid_cap [wp]: "\invs\ lookup_extra_caps t xa mi \\rv s. (\x\set rv. s \ fst x)\, -" unfolding lookup_extra_caps_def - apply simp - apply (wp mapME_set) - apply clarsimp - apply wp - done + by (wpsimp wp: mapME_set) lemma lcs_ex_cap_to [wp]: "\invs\ lookup_cap_and_slot t xs \\x s. \r\cte_refs (fst x) (interrupt_irq_node s). ex_cte_cap_to r s\, -" - unfolding lookup_cap_and_slot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done + unfolding lookup_cap_and_slot_def by wpsimp lemma lcs_ex_nonz_cap_to [wp]: "\invs\ lookup_cap_and_slot t xs \\x s. \r\zobj_refs (fst x). ex_nonz_cap_to r s\, -" - unfolding lookup_cap_and_slot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done + unfolding lookup_cap_and_slot_def by wpsimp lemma lcs_cte_at[wp]: "\valid_objs\ lookup_cap_and_slot t xs \\rv. cte_at (snd rv)\,-" - apply (simp add: lookup_cap_and_slot_def split_def) - apply (rule hoare_pre) - apply (wp | simp)+ + apply (simp add: lookup_cap_and_slot_def split_def) + apply (wp | simp)+ done lemma lec_ex_cap_to [wp]: @@ -754,9 +739,7 @@ lemma mapME_wp: apply (simp add: mapME_def sequenceE_def) apply wp apply (simp add: mapME_Cons) - apply wp - apply simp - apply (simp add: x) + apply (wpsimp wp: x|assumption)+ done lemmas mapME_wp' = mapME_wp [OF _ subset_refl] @@ -896,10 +879,9 @@ lemma lookup_cap_and_slot_dimished [wp]: \\x. cte_wp_at (diminished (fst x)) (snd x)\, -" apply (simp add: lookup_cap_and_slot_def split_def) apply (wp get_cap_wp) - apply (rule hoare_post_impErr - [where Q="\_. valid_objs" and E="\_. valid_objs"]) + apply (rule hoare_post_imp_R [where Q'="\_. valid_objs"]) apply wp - apply simp + apply simp apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def) apply (rule exI, rule cap_mask_UNIV[symmetric]) apply (drule (1) caps_of_state_valid_cap, simp add: valid_cap_def2) @@ -1128,7 +1110,7 @@ lemma hw_invs[wp]: "\invs and ct_active\ handle_recv is_blocking apply (simp add: lookup_cap_def lookup_slot_for_thread_def) apply wp apply (simp add: split_def) - apply (wp resolve_address_bits_valid_fault2) + apply (wp resolve_address_bits_valid_fault2)+ apply (simp add: valid_fault_def) apply ((wp hoare_vcg_all_lift_R lookup_cap_ex_cap | simp add: obj_at_def @@ -1268,7 +1250,7 @@ lemma do_reply_transfer_nonz_cap: | strengthen ex_nonz_cap_to_tcb_strg)+ apply (clarsimp simp add: tcb_cap_cases_def is_cap_simps can_fast_finalise_def) apply (strengthen ex_tcb_cap_to_tcb_at_strg) - apply (wp hoare_drop_imp hoare_allI) + apply (wp hoare_drop_imp hoare_allI)+ apply (clarsimp) done @@ -1278,7 +1260,7 @@ lemma handle_reply_nonz_cap: \\rv. ex_nonz_cap_to p\" apply (simp add: handle_reply_def) apply (wp delete_caller_cap_nonz_cap do_reply_transfer_nonz_cap | wpc)+ - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply clarsimp apply (drule(1) cte_wp_valid_cap) apply (clarsimp simp: valid_cap_def) @@ -1306,7 +1288,7 @@ lemma do_reply_transfer_st_tcb_at_active: hoare_drop_imps thread_set_no_change_tcb_state do_ipc_transfer_non_null_cte_wp_at2 | wpc | clarsimp)+ - apply (wp hoare_allI hoare_drop_imp) + apply (wp hoare_allI hoare_drop_imp)+ apply (fastforce simp add: st_tcb_def2) done diff --git a/proof/invariant-abstract/TcbAcc_AI.thy b/proof/invariant-abstract/TcbAcc_AI.thy index f91ea8b5c..0f686f1d4 100644 --- a/proof/invariant-abstract/TcbAcc_AI.thy +++ b/proof/invariant-abstract/TcbAcc_AI.thy @@ -333,7 +333,7 @@ crunch arch [wp]: thread_set "\s. P (arch_state s)" lemma thread_set_arch_state [wp]: "\valid_arch_state\ thread_set f t \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift; wp) lemma thread_set_caps_of_state_trivial: @@ -360,7 +360,7 @@ lemma thread_set_global_refs_triv: getF (f tcb) = getF tcb" shows "\valid_global_refs\ thread_set f t \\_. valid_global_refs\" apply (rule valid_global_refs_cte_lift) - apply (wp thread_set_caps_of_state_trivial x) + apply (wp thread_set_caps_of_state_trivial x)+ done lemma thread_set_valid_reply_caps_trivial: @@ -673,7 +673,7 @@ lemma as_user_irq_handlers[wp]: lemma as_user_valid_arch [wp]: "\valid_arch_state\ as_user t f \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ lemma as_user_iflive[wp]: @@ -725,16 +725,9 @@ crunch irq_node[wp]: as_user "\s. P (interrupt_irq_node s)" lemma as_user_global_refs [wp]: "\valid_global_refs\ as_user t f \\_. valid_global_refs\" - by (rule valid_global_refs_cte_lift) wp - - -lemma ts_cur [wp]: - "\cur_tcb\ thread_set f t \\_. cur_tcb\" - apply (simp add: thread_set_def set_object_def) - apply wp - apply (clarsimp simp: cur_tcb_def obj_at_def is_tcb) - done + by (rule valid_global_refs_cte_lift) wp+ +declare thread_set_cur_tcb [wp] lemma as_user_ct: "\\s. P (cur_thread s)\ as_user t m \\rv s. P (cur_thread s)\" apply (simp add: as_user_def split_def set_object_def) @@ -776,7 +769,7 @@ lemma ct_in_state_thread_state_lift: lemma as_user_ct_in_state: "\ct_in_state x\ as_user t f \\_. ct_in_state x\" - by (rule ct_in_state_thread_state_lift) (wp as_user_ct) + by (rule ct_in_state_thread_state_lift) (wp as_user_ct)+ lemma set_object_ntfn_at: @@ -813,19 +806,18 @@ lemma set_thread_state_valid_objs[wp]: set_thread_state thread st \\r. valid_objs\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_valid_objs) + apply (wp, simp, (wp set_object_valid_objs)+) apply (clarsimp simp: obj_at_def get_tcb_def is_tcb split: Structures_A.kernel_object.splits option.splits) apply (simp add: valid_objs_def dom_def) apply (erule allE, erule impE, blast) apply (clarsimp simp: valid_obj_def valid_tcb_def a_type_def tcb_cap_cases_def) - apply (erule cte_wp_atE disjE + by (erule cte_wp_atE disjE | clarsimp simp: st_tcb_def2 tcb_cap_cases_def dest!: get_tcb_SomeD split: Structures_A.thread_state.splits)+ - done - + lemma set_bound_notification_valid_objs[wp]: "\valid_objs and valid_bound_ntfn ntfn\ set_bound_notification t ntfn \\_. valid_objs\" apply (simp add: set_bound_notification_def) @@ -841,8 +833,7 @@ lemma set_thread_state_aligned[wp]: set_thread_state thread st \\r. pspace_aligned\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_aligned) - apply clarsimp + apply (wp set_object_aligned|clarsimp)+ done lemma set_bound_notification_aligned[wp]: @@ -857,10 +848,8 @@ lemma set_bound_notification_aligned[wp]: lemma set_thread_state_typ_at [wp]: "\\s. P (typ_at T p s)\ set_thread_state st p' \\rv s. P (typ_at T p s)\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) - apply clarsimp - apply (drule get_tcb_SomeD) - apply (clarsimp simp: obj_at_def a_type_def) + apply (wp|clarsimp)+ + apply (clarsimp simp: obj_at_def a_type_def dest!: get_tcb_SomeD) done crunch typ_at[wp]: set_bound_notification "\s. P (typ_at T p s)" @@ -877,7 +866,7 @@ lemma set_bound_notification_tcb[wp]: lemma set_thread_state_cte_wp_at [wp]: "\cte_wp_at P c\ set_thread_state st p' \\rv. cte_wp_at P c\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp cong: if_cong) apply (drule get_tcb_SomeD) apply (auto simp: cte_wp_at_cases tcb_cap_cases_def) @@ -1072,7 +1061,7 @@ lemma sts_valid_idle [wp]: set_thread_state t ts \\_. valid_idle\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp cong: if_cong) apply (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def get_tcb_def) done @@ -1091,8 +1080,7 @@ lemma sbn_valid_idle [wp]: lemma sts_distinct [wp]: "\pspace_distinct\ set_thread_state t st \\_. pspace_distinct\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_distinct) - apply clarsimp + apply (wp set_object_distinct|clarsimp)+ done lemma sbn_distinct [wp]: @@ -1127,11 +1115,10 @@ lemma sts_iflive[wp]: set_thread_state t st \\rv. if_live_then_nonz_cap\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp) - apply (fastforce dest: get_tcb_SomeD if_live_then_nonz_capD2 - simp: tcb_cap_cases_def - split: Structures_A.thread_state.splits) - done + apply (wp|simp)+ + by (fastforce dest: get_tcb_SomeD if_live_then_nonz_capD2 + simp: tcb_cap_cases_def + split: Structures_A.thread_state.splits) lemma sbn_iflive[wp]: "\\s. (bound ntfn \ ex_nonz_cap_to t s) @@ -1148,7 +1135,7 @@ lemma sbn_iflive[wp]: lemma sts_ifunsafe[wp]: "\if_unsafe_then_cap\ set_thread_state t st \\rv. if_unsafe_then_cap\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (fastforce simp: tcb_cap_cases_def) done @@ -1162,7 +1149,7 @@ lemma sbn_ifunsafe[wp]: lemma sts_zombies[wp]: "\zombies_final\ set_thread_state t st \\rv. zombies_final\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (fastforce simp: tcb_cap_cases_def) done @@ -1187,7 +1174,7 @@ lemma sts_refs_of[wp]: set_thread_state t st \\rv s. P (state_refs_of s)\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp elim!: rsubst[where P=P] dest!: get_tcb_SomeD simp: state_refs_of_def intro!: ext) @@ -1241,7 +1228,7 @@ lemma set_bound_notification_caps_of_state[wp]: lemma sts_st_tcb_at_neq: "\pred_tcb_at proj P t and K (t\t')\ set_thread_state t' st \\_. pred_tcb_at proj P t\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp cong: if_cong) apply (drule get_tcb_SomeD) apply (simp add: pred_tcb_at_def obj_at_def) @@ -1313,44 +1300,46 @@ lemma sbn_reply [wp]: lemma sts_reply_masters [wp]: "\valid_reply_masters\ set_thread_state p st \\_. valid_reply_masters\" apply (simp add: set_thread_state_thread_set) - apply (wp, simp, wp thread_set_valid_reply_masters_trivial) - apply (fastforce simp: tcb_cap_cases_def) + apply (wp thread_set_valid_reply_masters_trivial|simp)+ + apply (fastforce simp: tcb_cap_cases_def) + apply assumption done lemma sbn_reply_masters [wp]: "\valid_reply_masters\ set_bound_notification p ntfn \\_. valid_reply_masters\" apply (simp add: set_bound_notification_thread_set) apply (wp thread_set_valid_reply_masters_trivial, simp) - apply (fastforce simp: tcb_cap_cases_def) + apply (fastforce simp: tcb_cap_cases_def) + apply assumption done lemma set_thread_state_mdb [wp]: "\valid_mdb\ set_thread_state p st \\_. valid_mdb\" apply (simp add: set_thread_state_thread_set) - apply (wp, simp, wp thread_set_mdb) - apply (fastforce simp: tcb_cap_cases_def) + apply (wp thread_set_mdb|simp)+ + apply (fastforce simp: tcb_cap_cases_def) + apply assumption done lemma set_bound_notification_mdb [wp]: "\valid_mdb\ set_bound_notification p ntfn \\_. valid_mdb\" apply (simp add: set_bound_notification_thread_set) apply (wp thread_set_mdb) - apply (fastforce simp: tcb_cap_cases_def) + apply (fastforce simp: tcb_cap_cases_def) + apply assumption done lemma set_thread_state_global_refs [wp]: "\valid_global_refs\ set_thread_state p st \\_. valid_global_refs\" apply (simp add: set_thread_state_thread_set) - apply (wp, simp, wp thread_set_global_refs_triv) - apply (clarsimp simp: tcb_cap_cases_def) + apply (wp thread_set_global_refs_triv|clarsimp simp: tcb_cap_cases_def)+ done lemma set_bound_notification_global_refs [wp]: "\valid_global_refs\ set_bound_notification p ntfn \\_. valid_global_refs\" apply (simp add: set_bound_notification_thread_set) - apply (wp thread_set_global_refs_triv, simp) - apply (clarsimp simp: tcb_cap_cases_def) + apply (wp thread_set_global_refs_triv|clarsimp simp: tcb_cap_cases_def)+ done crunch arch [wp]: set_thread_state, set_bound_notification "\s. P (arch_state s)" @@ -1358,12 +1347,12 @@ crunch arch [wp]: set_thread_state, set_bound_notification "\s. P (arch_ lemma set_thread_state_valid_arch [wp]: "\valid_arch_state\ set_thread_state p st \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ lemma set_bound_notification_valid_arch [wp]: "\valid_arch_state\ set_bound_notification p ntfn \\_. valid_arch_state\" - by (rule valid_arch_state_lift) wp + by (rule valid_arch_state_lift) wp+ lemma st_tcb_ex_cap: "\ st_tcb_at P t s; if_live_then_nonz_cap s; @@ -1459,7 +1448,7 @@ lemma sts_only_idle: "\only_idle and (\s. idle st \ t = idle_thread s)\ set_thread_state t st \\_. only_idle\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp simp: only_idle_def pred_tcb_at_def obj_at_def) done @@ -1529,7 +1518,7 @@ lemma set_bound_notification_cap_refs_respects_device_region[wp]: lemma set_thread_state_valid_ioc[wp]: "\valid_ioc\ set_thread_state t st \\_. valid_ioc\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_valid_ioc_caps) + apply (wp, simp, (wp set_object_valid_ioc_caps)+) apply (intro impI conjI, clarsimp+) apply (clarsimp simp: valid_ioc_def) apply (drule spec, drule spec, erule impE, assumption) @@ -1581,10 +1570,10 @@ lemma sts_invs_minor: apply (cases st) apply simp_all - apply (fastforce simp: tcb_ntfn_is_bound_def tcb_bound_refs_def + by (fastforce simp: tcb_ntfn_is_bound_def tcb_bound_refs_def elim: obj_at_valid_objsE split: option.splits)+ - done (* FIXME tidy *) + (* FIXME tidy *) lemma sts_invs_minor2: "\st_tcb_at (\st'. tcb_st_refs_of st' = tcb_st_refs_of st \ \ awaiting_reply st') t @@ -1655,8 +1644,7 @@ lemma thread_set_cte_at: lemma set_thread_state_ko: "\ko_at obj ptr and K (\is_tcb obj)\ set_thread_state x st \\rv. ko_at obj ptr\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_ko) - apply clarsimp + apply (wp set_object_ko|clarsimp)+ apply (drule get_tcb_SomeD) apply (clarsimp simp: obj_at_def is_tcb) done @@ -1672,18 +1660,14 @@ lemma set_bound_notification_ko: lemma set_thread_state_valid_cap: "\valid_cap c\ set_thread_state x st \\rv. valid_cap c\" apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_valid_cap) - apply clarsimp + apply (wp set_object_valid_cap|clarsimp)+ done crunch valid_cap: set_bound_notification "valid_cap c" lemma set_thread_state_cte_at: "\cte_at p\ set_thread_state x st \\rv. cte_at p\" - apply (simp add: set_thread_state_def) - apply (wp, simp, wp set_object_cte_at) - apply clarsimp - done + by (rule set_thread_state_cte_wp_at) crunch cte_at: set_bound_notification "cte_at p" @@ -1727,16 +1711,13 @@ crunch ex_nonz_cap_to[wp]: set_bound_notification "ex_nonz_cap_to p" lemma ct_in_state_set: "P st \ \\s. cur_thread s = t\ set_thread_state t st \\rv. ct_in_state P \" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp add: ct_in_state_def pred_tcb_at_def obj_at_def, wp) - apply (simp add: ct_in_state_def pred_tcb_at_def obj_at_def) - done + by (wp|simp add: ct_in_state_def pred_tcb_at_def obj_at_def)+ lemma sts_ctis_neq: "\\s. cur_thread s \ t \ ct_in_state P s\ set_thread_state t st \\_. ct_in_state P\" apply (simp add: ct_in_state_def set_thread_state_def set_object_def) - apply (wp, simp add: pred_tcb_at_def obj_at_def, wp) - apply (clarsimp simp: pred_tcb_at_def obj_at_def) + apply (wp|simp add: pred_tcb_at_def obj_at_def)+ done @@ -1778,8 +1759,7 @@ lemma thread_set_ct_running: \ct_running\ thread_set f t \\rv. ct_running\" apply (simp add: ct_in_state_def) apply (rule hoare_lift_Pf [where f=cur_thread]) - apply (wp thread_set_no_change_tcb_state) - apply simp + apply (wp thread_set_no_change_tcb_state; simp) apply (simp add: thread_set_def) apply wp apply simp @@ -1798,7 +1778,7 @@ lemma sts_tcb_ko_at: set_thread_state t ts \\rv s. ko_at (TCB v) t' s \ P v\" apply (simp add: set_thread_state_def set_object_def) - apply (wp, simp, wp) + apply (wp|simp)+ apply (clarsimp simp: obj_at_def dest!: get_tcb_SomeD) apply (simp add: get_tcb_def) done @@ -1875,14 +1855,14 @@ lemma set_mrs_thread_set_dmo: apply (simp add: set_mrs_redux) apply (case_tac t) apply simp - apply wp - apply (rule ts) + apply (wp ts) apply (simp add: zipWithM_x_mapM store_word_offs_def split_def split del: if_split) apply (wp mapM_wp dmo) - apply simp - apply blast - apply (rule ts) + apply simp + apply blast + apply (rule ts) + apply assumption done lemma set_mrs_st_tcb [wp]: diff --git a/proof/invariant-abstract/Tcb_AI.thy b/proof/invariant-abstract/Tcb_AI.thy index fcf9e96a3..1339b993d 100644 --- a/proof/invariant-abstract/Tcb_AI.thy +++ b/proof/invariant-abstract/Tcb_AI.thy @@ -81,19 +81,16 @@ lemma setup_reply_master_reply_master[wp]: "\valid_objs and tcb_at t\ setup_reply_master t \\rv. cte_wp_at (\c. is_master_reply_cap c \ obj_ref_of c = t) (t, tcb_cnode_index 2)\" apply (simp add: setup_reply_master_def) - apply (wp set_cap_cte_wp_at') - apply (rule hoare_strengthen_post, rule get_cap_sp) - apply clarsimp - apply (frule(1) cte_wp_tcb_cap_valid[simplified cte_wp_at_eq_simp]) - apply (clarsimp simp: tcb_cap_valid_def st_tcb_def2) - apply (auto simp: cte_wp_at_caps_of_state is_cap_simps) + apply (wp set_cap_cte_wp_at' get_cap_wp) + apply (auto simp: tcb_cap_valid_def st_tcb_def2 cte_wp_at_caps_of_state is_cap_simps + dest: tcb_cap_valid_caps_of_stateD) done lemma setup_reply_master_has_reply[wp]: "\\s. P (has_reply_cap t s)\ setup_reply_master t' \\rv s. P (has_reply_cap t s)\" apply (simp add: has_reply_cap_def cte_wp_at_caps_of_state setup_reply_master_def) - apply (rule hoare_pre, wp get_cap_wp) + apply (wp get_cap_wp) apply (clarsimp simp: cte_wp_at_caps_of_state elim!: rsubst[where P=P]) apply (intro arg_cong[where f=Ex] ext) apply auto @@ -112,7 +109,6 @@ lemma restart_invs[wp]: "\invs and tcb_at t and ex_nonz_cap_to t\ restart t \\rv. invs\" apply (simp add: restart_def) apply (rule hoare_seq_ext [OF _ gts_sp]) - apply (rule hoare_pre) apply (wp sts_invs_minor cancel_ipc_ex_nonz_cap_to_tcb hoare_vcg_disj_lift cancel_ipc_simple2 | simp add: if_apply_def2 @@ -136,10 +132,7 @@ lemma restart_tcb[wp]: lemma copyAreaToRegs_typ_at: "\\s. P (typ_at T p s)\ copyAreaToRegs regs a b \\rv s. P (typ_at T p s)\" apply (simp add: copyAreaToRegs_def) - apply (wp thread_set_typ_at) - apply (rule mapM_wp [where S=UNIV, simplified]) - apply (simp add: load_word_offs_def) - apply wp + apply (wp thread_set_typ_at mapM_wp') done lemma copyAreaToRegs_tcb'[wp]: @@ -149,9 +142,7 @@ lemma copyAreaToRegs_tcb'[wp]: lemma copyRegsToArea_typ_at: "\\s. P (typ_at T p s)\ copyRegsToArea regs a b \\rv s. P (typ_at T p s)\" apply (simp add: copyRegsToArea_def) - apply (wp zipWithM_x_inv) - apply simp - apply wp + apply (wpsimp wp: zipWithM_x_inv) done lemma copyRegsToArea_tcb'[wp]: @@ -162,20 +153,14 @@ lemma copyRegsToArea_tcb'[wp]: lemma copyRegsToArea_invs[wp]: "\invs\ copyRegsToArea regs a b \\rv. invs\" apply (simp add: copyRegsToArea_def) - apply (wp zipWithM_x_inv) - apply simp - apply wp + apply (wpsimp wp: zipWithM_x_inv) done lemma copyAreaToRegs_invs[wp]: "\invs and tcb_at b\ copyAreaToRegs regs a b \\rv. invs\" apply (simp add: copyAreaToRegs_def) - apply wp - apply (rule thread_set_invs_trivial, (simp add: tcb_cap_cases_def)+) - apply (rule mapM_wp [where S=UNIV, simplified]) - apply wp - apply simp + apply (wpsimp wp: mapM_wp' thread_set_invs_trivial simp: tcb_cap_cases_def) done @@ -201,7 +186,7 @@ lemma writereg_invs: "\invs and tcb_at dest and ex_nonz_cap_to dest\ invoke_tcb (tcb_invocation.WriteRegisters dest resume values arch) \\rv. invs\" - by (clarsimp | rule conjI | wp)+ + by (wpsimp|rule conjI)+ lemma copyreg_invs: "\invs and tcb_at src and tcb_at dest and ex_nonz_cap_to dest and @@ -328,26 +313,11 @@ lemma hf_cte_at[wp]: by (wp valid_cte_at_typ) -lemma do_ipc_transfer_cte_at[wp]: - "\cte_at p\ do_ipc_transfer s ep b g r \\_. cte_at p\" - by (wp valid_cte_at_typ) - - lemma cancel_all_ipc_tcb: "\tcb_at t\ cancel_all_ipc ptr \\_. tcb_at t\" by (simp add: tcb_at_typ, wp cancel_all_ipc_typ_at) - -lemma get_notification_sp: - "\P\ get_notification p \\ntfn. ko_at (Notification ntfn) p and P\" - apply (simp add: get_notification_def) - apply wp - prefer 2 - apply (rule get_object_sp) - apply (case_tac kobj) - apply (simp|wp)+ - done - +lemmas get_notification_sp = get_ntfn_sp lemma thread_set_valid_objs': "\valid_objs and (\s. \p t. valid_tcb p t s \ valid_tcb p (f t) s)\ @@ -496,33 +466,32 @@ next case (2 slot exposed s') note hyps = "2.hyps"[simplified slot_rdcall.simps rec_del_call.simps simp_thms] show ?case - apply (simp add: split_def cong: if_cong) - apply (rule hoare_pre_spec_validE) - apply (wp hyps, simp+) - apply ((wp irq_state_independent_AI preemption_point_inv | simp)+)[1] - apply (simp only: simp_thms) - apply (wp hyps, simp+) - apply wp - apply (rule hoare_strengthen_post) - apply (rule hoare_vcg_conj_lift) - apply (rule finalise_cap_cases[where slot=slot]) - apply (rule hoare_vcg_conj_lift) - apply (rule finalise_cap_equal_cap[where sl=slot]) - apply (rule finalise_cap_not_cte_wp_at[where P=P, OF x]) - apply (clarsimp simp: cte_wp_at_caps_of_state) - apply (erule disjE) - apply clarsimp - apply (clarsimp simp: is_cap_simps ball_ran_eq) - apply (subgoal_tac "P rv") - apply (case_tac rv, simp_all add: fst_cte_ptrs_def)[1] - apply (simp add: z) - apply (simp add: y) - apply (simp split: option.split_asm, simp_all add: w)[1] - apply (cases slot, fastforce) - apply (simp add: is_final_cap_def) - apply (wp get_cap_wp) - apply clarsimp - done + apply (simp add: split_def cong: if_cong) + apply (wp hyps, simp+) + apply ((wp irq_state_independent_AI preemption_point_inv | simp)+)[1] + apply (simp only: simp_thms) + apply (wp hyps, simp+) + apply wp+ + apply (rule hoare_strengthen_post) + apply (rule hoare_vcg_conj_lift) + apply (rule finalise_cap_cases[where slot=slot]) + apply (rule hoare_vcg_conj_lift) + apply (rule finalise_cap_equal_cap[where sl=slot]) + apply (rule finalise_cap_not_cte_wp_at[where P=P, OF x]) + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (erule disjE) + apply clarsimp + apply (clarsimp simp: is_cap_simps ball_ran_eq) + apply (subgoal_tac "P rv") + apply (case_tac rv, simp_all add: fst_cte_ptrs_def)[1] + apply (simp add: z) + apply (simp add: y) + apply (simp split: option.split_asm, simp_all add: w)[1] + apply (cases slot, fastforce) + apply (simp add: is_final_cap_def) + apply (wp get_cap_wp)+ + apply clarsimp + done next case (3 ptr bits n slot s') show ?case @@ -618,20 +587,11 @@ lemma out_no_cap_to_trivial: option_update_thread a f t \\rv. no_cap_to_obj_with_diff_ref cap S\" apply (simp add: no_cap_to_obj_with_diff_ref_def) - apply (wp hoare_vcg_const_Ball_lift out_cte_wp_at_trivialT) - apply assumption + apply (wpsimp wp: hoare_vcg_const_Ball_lift out_cte_wp_at_trivialT) done -lemma thread_set_no_cap_to_trivial: - "(\tcb. \(getF, v)\ran tcb_cap_cases. getF (f tcb) = getF tcb) \ - \no_cap_to_obj_with_diff_ref cap S\ - thread_set f t - \\rv. no_cap_to_obj_with_diff_ref cap S\" - apply (simp add: no_cap_to_obj_with_diff_ref_def - cte_wp_at_caps_of_state) - apply (wp hoare_vcg_all_lift thread_set_caps_of_state_trivial - | simp)+ - done +(* FIXME: eliminate *) +lemmas thread_set_no_cap_to_trivial = thread_set_no_cap_obj_ref_trivial lemma (in Tcb_AI_1) checked_insert_no_cap_to: @@ -744,8 +704,7 @@ lemma update_mcpriority_valid_tcb[simp]: lemma set_mcpriority_valid_objs[wp]: "\invs\ set_mcpriority t x \\rv. valid_objs\" unfolding set_mcpriority_def - apply (rule hoare_pre) - apply (wp thread_set_cte_at ts_cur thread_set_valid_objs') + apply (wp thread_set_cte_at thread_set_valid_objs') apply (simp add: Invariants_AI.invs_valid_objs) done @@ -854,6 +813,8 @@ lemma unbind_notification_has_reply[wp]: lemma bind_notification_invs: + notes hoare_pre [wp_pre del] + shows "\bound_tcb_at (op = None) tcbptr and obj_at (\ko. \ntfn. ko = Notification ntfn \ (ntfn_bound_tcb ntfn = None) \ (\q. ntfn_obj ntfn \ WaitingNtfn q)) ntfnptr @@ -1116,7 +1077,7 @@ lemma (in Tcb_AI) decode_set_ipc_wf[wp]: apply (rule hoare_pre, wp check_valid_ipc_buffer_wp) apply simp apply (wp derive_cap_valid_cap hoare_drop_imps)[1] - apply wp + apply wp+ apply (clarsimp simp: neq_Nil_conv) done @@ -1327,7 +1288,7 @@ lemma decode_tcb_inv_wf: apply wpc apply (wp_trace decode_tcb_conf_wf decode_readreg_wf decode_writereg_wf decode_copyreg_wf - decode_bind_notification_wf decode_unbind_notification_wf decode_set_priority_wf) + decode_bind_notification_wf decode_unbind_notification_wf decode_set_priority_wf)+ apply (clarsimp simp: real_cte_at_cte) apply (fastforce simp: real_cte_at_not_tcb_at) done diff --git a/proof/invariant-abstract/Untyped_AI.thy b/proof/invariant-abstract/Untyped_AI.thy index de963cea9..c5a9fab55 100644 --- a/proof/invariant-abstract/Untyped_AI.thy +++ b/proof/invariant-abstract/Untyped_AI.thy @@ -105,16 +105,12 @@ lemma lookup_cap_ex: cte_wp_at (\c. c = c') (p1, p2) s)\,-" apply (simp add: lookup_cap_def split_def) apply wp - apply (rule_tac P1=wellformed_cap - in hoare_strengthen_post[OF get_cap_cte_wp_at_P]) - apply clarsimp - apply (rule exI)+ - apply (subst cap_mask_UNIV, simp) - apply fastforce - apply (rule hoare_pre, wp) - apply (strengthen cte_wp_at_wellformed_strengthen) - apply wp - apply simp + apply (rule_tac P1=wellformed_cap in hoare_strengthen_post[OF get_cap_cte_wp_at_P]) + apply clarsimp + apply (rule exI)+ + apply (subst cap_mask_UNIV, simp) + apply fastforce + apply (wpsimp|strengthen cte_wp_at_wellformed_strengthen)+ done @@ -149,7 +145,7 @@ lemma mask_CNodeD: lemma unat_2p_sub_1: "k < len_of TYPE('a) \ unat (2 ^ k - 1 :: 'a :: len word) = unat (2 ^ k :: 'a word) - 1" - by (simp add: unat_minus_one p2_eq_0) + by (simp add: unat_minus_one) lemma compute_free_index_wp: @@ -180,14 +176,7 @@ lemma dui_inv[wp]: lemma map_ensure_empty_cte_wp_at: "\cte_wp_at P p\ mapME_x ensure_empty xs \\rv. cte_wp_at P p\,-" - apply (simp add: mapME_x_def sequenceE_x_def) - apply (induct xs, simp_all) - apply wp - apply assumption - apply (simp add: ensure_empty_def whenE_def) - apply (wp get_cap_wp) - apply clarsimp - done + unfolding mapME_x_def sequenceE_x_def by (induct xs; wpsimp) lemma map_ensure_empty: @@ -219,10 +208,7 @@ lemma ensure_no_children_sp: lemma data_to_obj_type_inv: "\P\ data_to_obj_type v \\rv. P\" apply (simp add: data_to_obj_type_def) - apply (intro conjI impI) - apply wp - apply (rule hoare_pre, wpcw, wp) - apply simp + apply (intro conjI impI; wpsimp) done @@ -262,18 +248,17 @@ lemma dui_sp_helper: odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at (diminished rv) slot s)) \ P s\, -" apply (simp add: split_def lookup_target_slot_def) apply (intro impI conjI) - apply (rule hoare_pre, wp) - apply simp + apply wpsimp apply (wp get_cap_wp) - apply (fold validE_R_def) - apply (rule hoare_post_imp_R [where Q'="\rv. valid_objs and P"]) - apply wp + apply (rule hoare_post_imp_R [where Q'="\rv. valid_objs and P"]) + apply wp + apply simp + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (simp add: diminished_def) + apply (elim allE, drule(1) mp) + apply (elim allE, subst(asm) cap_mask_UNIV) + apply (frule caps_of_state_valid_cap, simp, simp add: valid_cap_def2) apply simp - apply (clarsimp simp: cte_wp_at_caps_of_state) - apply (simp add: diminished_def) - apply (elim allE, drule(1) mp) - apply (elim allE, subst(asm) cap_mask_UNIV) - apply (frule caps_of_state_valid_cap, simp, simp add: valid_cap_def2) apply simp done @@ -452,7 +437,7 @@ lemma range_cover_stuff: apply (simp add: le_diff_conv2 word_of_nat_le unat_le_helper word_less_nat_alt) apply (rule le_less_trans[OF unat_plus_gt]) apply (rule less_le_trans[where y = "2^bits + unat (of_nat rv)"]) - apply (simp add: unat_power_lower32) + apply simp apply (rule le_less_trans[OF _ measure_unat]) apply (rule word_le_nat_alt[THEN iffD1]) apply (rule word_and_le2) @@ -460,7 +445,7 @@ lemma range_cover_stuff: apply (subst word_bits_def[symmetric]) apply (erule le_less_trans) apply simp - apply (simp add: unat_power_lower32) + apply simp done show "n + unat (alignUp (w + ((of_nat rv)::word32)) bits && mask sz >> bits) \ 2 ^ (sz - bits)" @@ -651,6 +636,7 @@ lemma check_children_wp: (doE y \ ensure_no_children slot; returnOk True odE) \Q\" + including no_pre apply (clarsimp simp: const_on_failure_def ensure_no_children_descendants bindE_assoc) apply wp apply (clarsimp simp: valid_def validE_def if_splits) @@ -723,9 +709,8 @@ lemma pspace_no_overlap_detype': "\ s \ cap.UntypedCap dev ptr bits idx; pspace_aligned s; valid_objs s \ \ pspace_no_overlap {ptr .. ptr + 2 ^ bits - 1} (detype {ptr .. ptr + 2 ^ bits - 1} s)" apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff - Int_atLeastAtMost atLeastatMost_empty_iff is_aligned_neg_mask_eq - simp: obj_range_def add_diff_eq[symmetric] pspace_no_overlap_def - ) + Int_atLeastAtMost atLeastatMost_empty_iff + simp: obj_range_def add_diff_eq[symmetric] pspace_no_overlap_def) apply (frule(2) valid_untypedD) apply (rule ccontr) apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff @@ -799,16 +784,6 @@ lemma not_waiting_reply_slot_no_descendants: apply simp done -lemma more_revokables[simp]: - "pspace_distinct (is_original_cap_update f s) = pspace_distinct s" - "pspace_aligned (is_original_cap_update f s) = pspace_aligned s" - by (simp add: pspace_distinct_def pspace_aligned_def)+ - - -lemma more_mdbs[wp]: - "\pspace_aligned\ set_cdt m \\rv. pspace_aligned\" - "\pspace_distinct\ set_cdt m \\rv. pspace_distinct\" - by (simp add: set_cdt_def pspace_aligned_def pspace_distinct_def | wp)+ crunch irq_node[wp]: set_thread_state "\s. P (interrupt_irq_node s)" crunch irq_states[wp]: update_cdt "\s. P (interrupt_states s)" @@ -816,23 +791,19 @@ crunch ups[wp]: set_cdt "\s. P (ups_of_heap (kheap s))" crunch cns[wp]: set_cdt "\s. P (cns_of_heap (kheap s))" +(* FIXME: move *) lemma list_all2_zip_split: "\ list_all2 P as cs; list_all2 Q bs ds \ \ list_all2 (\x y. P (fst x) (fst y) \ Q (snd x) (snd y)) (zip as bs) (zip cs ds)" apply (induct as arbitrary: bs cs ds) apply simp - apply (case_tac cs, simp+) - apply (case_tac bs, simp+) - apply (case_tac ds, simp+) + apply (case_tac cs; simp) + apply (case_tac bs; simp) + apply (case_tac ds; simp) done -lemma valid_cap_rvk[simp]: - "(is_original_cap_update f s) \ cap = s \ cap" - by (fastforce elim: valid_cap_pspaceI) - - crunch irq_states[wp]: update_cdt "\s. P (interrupt_states s)" crunch ups[wp]: set_cdt "\s. P (ups_of_heap (kheap s))" @@ -2077,6 +2048,7 @@ lemma descendants_range_in_subseteq: by (auto simp: descendants_range_in_def cte_wp_at_caps_of_state dest!: bspec) +(* FIXME: move *) lemma is_aligned_neg_mask_eq': "is_aligned ptr sz = (ptr && ~~ mask sz = ptr)" apply (rule iffI) @@ -2088,6 +2060,7 @@ lemma is_aligned_neg_mask_eq': done +(* FIXME: move *) lemma neg_mask_mask_unat: "sz < word_bits \ unat ((ptr::word32) && ~~ mask sz) + unat (ptr && mask sz) = unat ptr" @@ -2597,12 +2570,11 @@ lemma do_machine_op_pspace_no_overlap[wp]: "\pspace_no_overlap S\ do_machine_op f \\r. pspace_no_overlap S\" apply (clarsimp simp: pspace_no_overlap_def do_machine_op_def) apply (wp hoare_vcg_all_lift) - apply (simp add: split_def) - apply wp + apply (simp add: split_def) + apply wp+ apply clarsimp done - lemma mapME_append: "mapME f (xs @ ys) = doE xs_r \ mapME f xs; @@ -2777,7 +2749,7 @@ lemma delete_objects_ct_in_state[wp]: st_tcb_at_def | simp add: detype_def)+ apply (rule hoare_lift_Pf2[where f=cur_thread]) - apply wp + apply wp+ apply (clarsimp simp: ct_in_state_def st_tcb_at_def) done @@ -2905,7 +2877,7 @@ lemma reset_untyped_cap_invs_etc: apply (strengthen empty_descendants_range_in) apply (rule hoare_lift_Pf2 [where f="interrupt_irq_node"]) apply (wp hoare_vcg_const_Ball_lift hoare_vcg_const_imp_lift - hoare_vcg_ex_lift ct_in_state_thread_state_lift) + hoare_vcg_ex_lift ct_in_state_thread_state_lift)+ apply (clarsimp simp add: bits_of_def field_simps cte_wp_at_caps_of_state empty_descendants_range_in) apply (cut_tac a=sz and b=reset_chunk_bits and n=idx in upt_mult_lt_prop) @@ -3001,32 +2973,24 @@ lemma create_cap_state_refs_of[wp]: "\\s. P (state_refs_of s)\ create_cap tp sz p dev (cref, oref) \\rv s. P (state_refs_of s)\" - apply (simp add: create_cap_def) - apply (wp | simp)+ - done + unfolding create_cap_def by wpsimp lemma create_cap_zombies[wp]: "\zombies_final and cte_wp_at (op = cap.NullCap) cref and (\s. \r\obj_refs (default_cap tp oref sz dev). \p'. \ cte_wp_at (\cap. r \ obj_refs cap) p' s)\ create_cap tp sz p dev (cref, oref) \\rv. zombies_final\" - apply (simp add: create_cap_def set_cdt_def) - apply (wp new_cap_zombies | simp)+ - done + unfolding create_cap_def set_cdt_def by (wpsimp wp: new_cap_zombies) lemma create_cap_cur_tcb[wp]: "\cur_tcb\ create_cap tp sz p dev tup \\rv. cur_tcb\" - apply (simp add: create_cap_def split_def set_cdt_def) - apply (wp | simp)+ - done + unfolding create_cap_def split_def set_cdt_def by wpsimp lemma create_cap_valid_idle[wp]: "\valid_idle\ create_cap tp sz p dev tup \\rv. valid_idle\" - apply (simp add: create_cap_def split_def set_cdt_def) - apply (wp set_cap_idle | simp)+ - done + unfolding create_cap_def split_def set_cdt_def by (wpsimp wp: set_cap_idle) crunch it[wp]: create_cap "\s. P (idle_thread s)" @@ -3035,7 +2999,7 @@ crunch it[wp]: create_cap "\s. P (idle_thread s)" lemma default_cap_reply: "default_cap tp ptr sz dev \ cap.ReplyCap ptr' bool" - by (cases tp, simp_all) + by (cases tp; simp) lemma create_cap_valid_reply_caps[wp]: "\valid_reply_caps\ @@ -3071,10 +3035,13 @@ lemma create_cap_valid_global_refs[wp]: apply (simp add: valid_global_refs_def valid_refs_def cte_wp_at_caps_of_state create_cap_def pred_conj_def) apply (simp only: imp_conv_disj) + (* FIXME: wp_cleanup apply (rule hoare_pre) apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift | simp split del: if_split)+ apply clarsimp + *) + apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift) apply (subgoal_tac "global_refs s \ cap_range (default_cap tp oref sz dev) = {}") apply auto[1] apply (erule disjoint_subset2) @@ -3106,10 +3073,8 @@ lemma create_cap_irq_handlers[wp]: apply (simp add: valid_irq_handlers_def irq_issued_def) apply (simp add: create_cap_def Ball_def) apply (simp only: imp_conv_disj) - apply (rule hoare_pre) - apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift | simp)+ - apply (erule allEI) - apply (auto simp: ran_def) + apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_disj_lift) + apply (auto simp: ran_def split: if_split_asm) done @@ -3154,13 +3119,9 @@ crunch v_ker_map[wp]: create_cap "valid_kernel_mappings" crunch eq_ker_map[wp]: create_cap "equal_kernel_mappings" (simp: crunch_simps) - lemma create_cap_asid_map[wp]: - "\valid_asid_map\ - create_cap tp sz p dev (cref, oref) \\rv. valid_asid_map\" - apply (simp add: create_cap_def set_cdt_def) - apply (wp|simp)+ - done + "\valid_asid_map\ create_cap tp sz p dev (cref, oref) \\rv. valid_asid_map\" + unfolding create_cap_def set_cdt_def by wpsimp crunch only_idle[wp]: create_cap only_idle (simp: crunch_simps) @@ -3174,10 +3135,9 @@ crunch pspace_in_kernel_window[wp]: create_cap "pspace_in_kernel_window" lemma set_original_valid_ioc[wp]: "\valid_ioc\ create_cap tp sz p dev slot \\_. valid_ioc\" apply (cases slot) - apply (simp add: create_cap_def set_original_set_cap_comm, wp) - apply (simp add: cte_wp_at_caps_of_state) - apply (wp set_cdt_cos_ioc set_cap_caps_of_state | simp)+ - apply (case_tac tp, simp_all) + apply (wpsimp wp: set_cdt_cos_ioc set_cap_caps_of_state + simp: create_cap_def set_original_set_cap_comm cte_wp_at_caps_of_state) + apply (cases tp; simp) done interpretation create_cap: non_arch_non_mem_op "create_cap tp sz p slot dev" @@ -3187,7 +3147,6 @@ interpretation create_cap: non_arch_non_mem_op "create_cap tp sz p slot dev" apply (rule hoare_pre, (wp set_cap.aobj_at | wpc |simp add: create_cap_def set_cdt_def bind_assoc)+)+ done - crunch valid_irq_states[wp]: create_cap "valid_irq_states" crunch pspace_respects_device_region[wp]: create_cap pspace_respects_device_region @@ -3251,9 +3210,7 @@ lemma create_cap_no_cap[wp]: "\\s. (\p'. \ cte_wp_at P p' s) \ \ P (default_cap tp oref sz dev)\ create_cap tp sz p dev (cref, oref) \\rv s. \oref' cref'. \ cte_wp_at P (oref', cref') s\" - apply (simp add: create_cap_def cte_wp_at_caps_of_state) - apply (wp | simp)+ - done + unfolding create_cap_def cte_wp_at_caps_of_state by wpsimp lemma (in Untyped_AI_nonempty_table) create_cap_nonempty_tables[wp]: "\\s. P (obj_at (nonempty_table (set (arch_state.arm_global_pts (arch_state s)))) p s)\ @@ -3397,8 +3354,7 @@ lemma (in Untyped_AI_nonempty_table) create_caps_invs: apply (auto dest!: set_zip_helper)[1] apply (induct ("zip crefs orefs")) apply (simp add: mapM_x_def sequence_x_def) - apply wp - apply simp + apply wpsimp apply (clarsimp simp add: mapM_x_def sequence_x_def) apply (rule hoare_seq_ext) apply assumption @@ -3416,9 +3372,7 @@ lemma retype_region_cte_at_other': retype_region ptr n us ty dev \\rv. cte_wp_at P p\" apply (rule hoare_gen_asm) - apply (wp retype_region_cte_at_other) - apply assumption - apply clarsimp + apply (wpsimp wp: retype_region_cte_at_other) done lemma retype_region_ex_cte_cap_to: @@ -3462,8 +3416,7 @@ lemma retype_region_not_cte_wp_at: \\rv s. \ cte_wp_at P p s\" apply (rule hoare_gen_asm) apply (clarsimp simp: P_null_filter_caps_of_cte_wp_at[symmetric]) - apply (wp retype_region_caps_of) - apply simp+ + apply (wpsimp wp: retype_region_caps_of) apply auto done @@ -3908,7 +3861,7 @@ lemma invoke_untyp_invs': set_cap_cte_cap_wp_to hoare_vcg_ex_lift | wp_once hoare_drop_imps)+ - apply (wp set_cap_cte_wp_at_neg hoare_vcg_all_lift get_cap_wp) + apply (wp set_cap_cte_wp_at_neg hoare_vcg_all_lift get_cap_wp)+ apply (clarsimp simp: slot_not_in field_simps ui free_index_of_def split del: if_split) @@ -4030,7 +3983,6 @@ lemmas sts_real_cte_at[wp] = lemma sts_valid_untyped_inv: "\valid_untyped_inv ui\ set_thread_state t st \\rv. valid_untyped_inv ui\" apply (cases ui, simp add: descendants_range_in_def) - apply (rule hoare_pre) apply (wp hoare_vcg_const_Ball_lift hoare_vcg_ex_lift hoare_vcg_imp_lift | wps)+ apply clarsimp done diff --git a/proof/invariant-abstract/VSpaceEntries_AI.thy b/proof/invariant-abstract/VSpaceEntries_AI.thy index b34b6eca8..0d2ff35a6 100644 --- a/proof/invariant-abstract/VSpaceEntries_AI.thy +++ b/proof/invariant-abstract/VSpaceEntries_AI.thy @@ -183,18 +183,6 @@ lemma mapME_x_mapME: apply (induct l, simp_all add: Let_def bindE_assoc) done -lemma mapME_wp: - assumes x: "\x. x \ S \ \P\ f x \\rv. P\, \E\" - shows "set xs \ S \ \P\ mapME f xs \\rv. P\, \E\" - apply (induct xs) - apply (simp add: mapME_def sequenceE_def) - apply wp - apply (simp add: mapME_Cons) - apply wp - apply simp - apply (simp add: x) - done - lemma mapME_x_wp: assumes x: "\x. x \ S \ \P\ f x \\rv. P\, \E\" shows "set xs \ S \ \P\ mapME_x f xs \\rv. P\, \E\" diff --git a/proof/invariant-abstract/VSpacePre_AI.thy b/proof/invariant-abstract/VSpacePre_AI.thy index 5cc818eff..cc0f07536 100644 --- a/proof/invariant-abstract/VSpacePre_AI.thy +++ b/proof/invariant-abstract/VSpacePre_AI.thy @@ -28,6 +28,7 @@ lemma throw_on_false_wp[wp]: \ \P\ throw_on_false x f \Q\,\E\" apply (simp add: throw_on_false_def unlessE_def) apply wp + apply simp apply simp done @@ -51,9 +52,7 @@ lemma dmo_asid_map [wp]: crunch caps_of_state[wp]: do_machine_op "\s. P (caps_of_state s)" interpretation dmo: non_arch_non_cap_op "do_machine_op f" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) declare not_Some_eq_tuple[simp] diff --git a/proof/refine/ArchAcc_R.thy b/proof/refine/ArchAcc_R.thy index 62c25c84d..1f2d7f28c 100644 --- a/proof/refine/ArchAcc_R.thy +++ b/proof/refine/ArchAcc_R.thy @@ -132,9 +132,7 @@ lemma storePDE_state_refs_of[wp]: storePDE ptr val \\rv s. P (state_refs_of' s)\" unfolding storePDE_def - apply (wp setObject_state_refs_of_eq) - apply (clarsimp simp: updateObject_default_def in_monad projectKOs) - done + by (wp setObject_state_refs_of_eq; clarsimp simp: updateObject_default_def in_monad projectKOs) lemma storePTE_cte_wp_at'[wp]: "\\s. P (cte_wp_at' P' p s)\ @@ -155,8 +153,8 @@ lemma storePTE_state_refs_of[wp]: storePTE ptr val \\rv s. P (state_refs_of' s)\" unfolding storePTE_def - apply (wp setObject_state_refs_of_eq) - apply (clarsimp simp: updateObject_default_def in_monad + apply (wp setObject_state_refs_of_eq; + clarsimp simp: updateObject_default_def in_monad projectKOs) done @@ -1098,11 +1096,7 @@ lemma lookup_pt_slot_corres: apply simp apply clarsimp apply (rule page_table_at_state_relation) - apply simp+ - apply (wp | simp)+ - apply (rule hoare_pre) - apply (wp getPDE_wp) - apply simp + apply (wp getPDE_wp | simp)+ done declare in_set_zip_refl[simp] @@ -1186,7 +1180,7 @@ lemma copy_global_mappings_corres: apply (wp getPDE_wp) apply clarsimp apply clarsimp - apply wp + apply wp+ apply (clarsimp simp: valid_arch_state_def obj_at_def dest!:pspace_alignedD) apply (intro conjI) apply (erule is_aligned_weaken,simp)+ @@ -1234,11 +1228,7 @@ lemma arch_derive_corres: (Arch.deriveCap slot c')" unfolding arch_derive_cap_def ARM_H.deriveCap_def Let_def apply (cases c, simp_all add: isCap_simps split: option.splits split del: if_split) - apply (rule corres_noopE, wp, simp, rule no_fail_pre, wp)+ - apply clarsimp - apply (rule corres_noopE, wp, simp, rule no_fail_pre, wp) - apply clarsimp - apply (rule corres_noopE, wp, simp, rule no_fail_pre, wp) + apply (clarify?, rule corres_noopE; wpsimp)+ done definition @@ -1268,7 +1258,7 @@ lemma create_mapping_entries_corres: apply (clarsimp simp: vmattributes_map_def) apply (rule corres_lookup_error) apply (rule lookup_pt_slot_corres) - apply wp + apply wp+ apply clarsimp apply (drule(1) less_kernel_base_mapping_slots,simp) apply simp+ @@ -1278,7 +1268,7 @@ lemma create_mapping_entries_corres: apply (clarsimp simp: vmattributes_map_def) apply (rule corres_lookup_error) apply (rule lookup_pt_slot_corres) - apply wp + apply wp+ apply clarsimp apply (drule(1) less_kernel_base_mapping_slots,simp) apply simp+ @@ -1514,15 +1504,15 @@ lemma setObject_PTE_arch [wp]: lemma setObject_ASID_valid_arch [wp]: "\valid_arch_state'\ setObject p (v::asidpool) \\_. valid_arch_state'\" - by (rule valid_arch_state_lift') wp + by (rule valid_arch_state_lift'; wp) lemma setObject_PDE_valid_arch [wp]: "\valid_arch_state'\ setObject p (v::pde) \\_. valid_arch_state'\" - by (rule valid_arch_state_lift') (wp setObject_typ_at') + by (rule valid_arch_state_lift') (wp setObject_typ_at')+ lemma setObject_PTE_valid_arch [wp]: "\valid_arch_state'\ setObject p (v::pte) \\_. valid_arch_state'\" - by (rule valid_arch_state_lift') (wp setObject_typ_at') + by (rule valid_arch_state_lift') (wp setObject_typ_at')+ lemma setObject_ASID_ct [wp]: "\\s. P (ksCurThread s)\ setObject p (e::asidpool) \\_ s. P (ksCurThread s)\" @@ -1546,21 +1536,21 @@ lemma setObject_ASID_cur_tcb' [wp]: "\\s. cur_tcb' s\ setObject p (e::asidpool) \\_ s. cur_tcb' s\" apply (simp add: cur_tcb'_def) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply wp + apply wp+ done lemma setObject_PDE_cur_tcb' [wp]: "\\s. cur_tcb' s\ setObject p (e::pde) \\_ s. cur_tcb' s\" apply (simp add: cur_tcb'_def) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply wp + apply wp+ done lemma setObject_pte_cur_tcb' [wp]: "\\s. cur_tcb' s\ setObject p (e::pte) \\_ s. cur_tcb' s\" apply (simp add: cur_tcb'_def) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply wp + apply wp+ done lemma getASID_wp: diff --git a/proof/refine/Arch_R.thy b/proof/refine/Arch_R.thy index d6d8edcd3..09b4eab4e 100644 --- a/proof/refine/Arch_R.thy +++ b/proof/refine/Arch_R.thy @@ -55,7 +55,7 @@ lemma safe_parent_strg': apply (drule ctes_of_valid_cap', fastforce) apply (clarsimp simp: valid_cap'_def capAligned_def) apply (drule is_aligned_no_overflow) - apply (clarsimp simp: capRange_def asid_low_bits_def pageBits_def interval_empty) + apply (clarsimp simp: capRange_def asid_low_bits_def pageBits_def) apply (clarsimp simp: sameRegionAs_def2 isCap_simps capRange_def asid_low_bits_def pageBits_def) done @@ -76,7 +76,7 @@ lemma createObject_typ_at': \\rv s. typ_at' otype ptr s\" apply (clarsimp simp:createObjects'_def alignError_def split_def | wp hoare_unless_wp | wpc )+ apply (simp add:obj_at'_def)+ - apply (wp hoare_unless_wp) + apply (wp hoare_unless_wp)+ apply (clarsimp simp:ko_wp_at'_def typ_at'_def pspace_distinct'_def)+ apply (subgoal_tac "ps_clear ptr (objBitsKO ty) (s\ksPSpace := \a. if a = ptr then Some ty else ksPSpace s a\)") @@ -192,13 +192,13 @@ lemma pac_corres: apply (drule_tac x1="ucast x" in bang_eq [THEN iffD1]) apply (erule_tac x=n in allE) apply (simp add: word_size nth_ucast) - apply wp + apply wp+ apply (strengthen safe_parent_strg[where idx = "2^pageBits"]) apply (strengthen invs_valid_objs invs_distinct invs_psp_aligned invs_mdb | simp cong:conj_cong)+ apply (wp retype_region_plain_invs[where sz = pageBits] - retype_cte_wp_at[where sz = pageBits]) + retype_cte_wp_at[where sz = pageBits])+ apply (strengthen vp_strgs' safe_parent_strg'[where idx = "2^pageBits"]) apply (simp cong: conj_cong) @@ -214,6 +214,7 @@ lemma pac_corres: [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"]) apply (clarsimp simp:is_cap_simps) apply (simp add: free_index_of_def) + apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def objBits_simps archObjSize_def default_arch_object_def pred_conj_def) @@ -225,7 +226,7 @@ lemma pac_corres: set_cap_caps_no_overlap[where sz = pageBits] set_cap_no_overlap set_cap_device_and_range_aligned[where dev = False,simplified] - set_untyped_cap_caps_overlap_reserved[where sz = pageBits] | assumption)+ + set_untyped_cap_caps_overlap_reserved[where sz = pageBits])+ apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def objBits_simps archObjSize_def default_arch_object_def makeObjectKO_def range_cover_full @@ -240,12 +241,12 @@ lemma pac_corres: updateFreeIndex_cte_wp_at updateFreeIndex_caps_overlap_reserved | simp add: descendants_of_null_filter' split del: if_split)+ - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (subgoal_tac "word1 && ~~ mask pageBits = word1 \ pageBits \ word_bits \ 2 \ pageBits") prefer 2 apply (clarsimp simp:pageBits_def word_bits_def is_aligned_neg_mask_eq) apply (simp only:delete_objects_rewrite) - apply wp + apply wp+ apply (clarsimp simp: conj_comms) apply (clarsimp simp: conj_comms ex_disj_distrib | strengthen invs_valid_pspace' invs_pspace_aligned' @@ -488,33 +489,6 @@ lemma vmsz_aligned_less_kernel_base_eq: declare check_vp_alignment_inv[wp del] -(* -lemma guard_abstract_actual_iff: "(guard_abstract_op abstract actual = {}) = (actual = {})" - apply (auto simp: guard_abstract_op_def) - done - - -lemma free_asid_pool_select_guarded: - "(- dom pool \ {x. ucast x + word2 \ 0}) \ {} \ - guard_abstract_op {fst (hd [(x, y)\assocs pool . ucast x + word2 \ 0 \ y = None])} - (- dom pool \ {x. ucast x + word2 \ 0}) = - {fst (hd [(x, y)\assocs pool . ucast x + word2 \ 0 \ y = None])}" - apply (rule guard_abstract_op_abstract) - apply (drule dom_hd_assocsD | clarsimp)+ - done - -lemma free_asid_select_guarded: - "(- dom (arm_asid_table (arch_state s)) \ {x. x \ 2 ^ asid_high_bits - 1}) \ {} \ - guard_abstract_op - {fst (hd [(x, y)\assocs (arm_asid_table (arch_state s)) . - x \ 2 ^ asid_high_bits - 1 \ y = None])} - (- dom (arm_asid_table (arch_state s)) \ {x. x \ 2 ^ asid_high_bits - 1}) = - {fst (hd [(x, y)\assocs (arm_asid_table (arch_state s)) . - x \ 2 ^ asid_high_bits - 1 \ y = None])}" - apply (rule guard_abstract_op_abstract) - apply (drule dom_hd_assocsD | clarsimp)+ - done *) - lemma select_ext_fa: "free_asid_select asid_tbl \ S \ ((select_ext (\_. free_asid_select asid_tbl) S) :: (7 word) det_ext_monad) @@ -534,7 +508,7 @@ lemma lookup_pt_slot_no_fail_corres[simp]: lemma page_base_corres[simp]: "pageBase vaddr vmsize = page_base vaddr vmsize" - by (clarsimp simp: pageBase_def page_base_def complement_def) + by (clarsimp simp: pageBase_def page_base_def) lemma flush_type_map: "ARM_H.isPageFlushLabel (invocation_type (mi_label mi)) @@ -563,12 +537,12 @@ lemma resolve_vaddr_corres: apply (rule corres_split[OF _ get_master_pte_corres]) apply (rule corres_trivial) apply (case_tac rva, simp_all add: pte_relation'_def)[1] - apply (wp get_master_pte_inv) + apply (wp get_master_pte_inv)+ apply (clarsimp simp: page_table_pte_at_lookupI) 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 wp+ apply (clarsimp simp: page_directory_pde_at_lookupI less_kernel_base_mapping_slots) apply (clarsimp simp: page_directory_pde_at_lookupI' page_directory_at_state_relation) done @@ -634,7 +608,7 @@ lemma dec_arch_inv_page_flush_corres: label_to_flush_type_def labelToFlushType_def flush_type_map_def ARM_H.isPageFlushLabel_def split: flush_type.splits invocation_label.splits arch_invocation_label.splits) - apply wp + apply wp+ apply (fastforce simp: valid_cap_def mask_def) apply auto done @@ -712,7 +686,7 @@ lemma get_master_pde_sp: apply (erule order_trans) apply (rule ucast_mono_le) apply (rule le_shiftr) - apply (metis word_and_le1 word_bw_assocs word_bw_comms) + apply (metis word_and_le1 word_bw_assocs(1) word_bw_comms(1)) apply (rule shiftr_less_t2n) apply (rule order_less_le_trans, rule and_mask_less_size) apply (simp add: pd_bits_def pageBits_def word_size) @@ -910,7 +884,7 @@ shows apply (clarsimp simp: ucast_fst_hd_assocs) apply (wp hoareE_TrueI hoare_whenE_wp getASID_wp | simp)+ apply ((clarsimp simp: p2_low_bits_max | rule TrueI impI)+)[2] - apply (wp hoare_whenE_wp getASID_wp) + apply (wp hoare_whenE_wp getASID_wp)+ apply (clarsimp simp: valid_cap_def) apply auto[1] apply (simp add: isCap_simps split del: if_split) @@ -985,9 +959,9 @@ shows apply (clarsimp simp add: ucast_assocs[unfolded o_def] split_def filter_map asid_high_bits_def) apply (simp add: ord_le_eq_trans [OF word_n1_ge]) - apply wp + apply wp+ apply (simp add: o_def validE_R_def) - apply (wp hoare_whenE_wp) + apply (wp hoare_whenE_wp)+ apply fastforce apply clarsimp apply (simp add: null_def split_def asid_high_bits_def @@ -1061,7 +1035,7 @@ shows apply (rule corres_trivial) apply (rule corres_returnOk) apply (clarsimp simp: archinv_relation_def page_invocation_map_def) - apply (wp hoare_whenE_wp check_vp_wpR) + apply (wp hoare_whenE_wp check_vp_wpR)+ apply (clarsimp simp: valid_cap_def dest!: vmsz_aligned_less_kernel_base_eq) apply (frule_tac vptr="hd args" in page_directory_pde_at_lookupI, assumption) apply (clarsimp simp: vmsz_aligned_def pageBitsForSize_def page_directory_at_aligned_pd_bits @@ -1069,10 +1043,10 @@ shows apply (clarsimp simp: valid_cap'_def) apply simp apply (rule whenE_throwError_wp[unfolded validE_R_def]) - apply (wp hoare_whenE_wp) + apply (wp hoare_whenE_wp)+ apply (rule hoare_drop_imps)+ apply (simp add:not_le) - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (clarsimp simp: invs_def valid_state_def) apply fastforce apply (cases "invocation_type (mi_label mi) = ArchInvocationLabel ARMPageRemap") @@ -1124,7 +1098,7 @@ shows apply (rule corres_trivial) apply (rule corres_returnOk) apply (clarsimp simp: archinv_relation_def page_invocation_map_def) - apply wp + apply wp+ apply (subgoal_tac "valid_arch_objs s \ pspace_aligned s \ (snd v') < kernel_base \ equal_kernel_mappings s \ valid_global_objs s \ valid_arch_state s \ @@ -1286,7 +1260,7 @@ shows apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) valid_global_refsD_with_objSize) subgoal by (clarsimp simp: is_page_cap_def split: cap.split_asm) - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_cap_simps mask_2pm1 valid_arch_state_def valid_arch_caps_def linorder_not_le split: option.splits) @@ -1329,7 +1303,7 @@ lemma inv_arch_corres: apply (rule corres_guard_imp [OF pap_corres], rule refl) apply (fastforce simp: valid_arch_inv_def) apply (fastforce simp: valid_arch_inv'_def) - apply wp + apply wp+ done lemma asid_pool_typ_at_ext': @@ -1349,15 +1323,14 @@ lemma performASIDControlInvocation_tcb_at': apply (rule hoare_name_pre_state) apply (clarsimp simp: performASIDControlInvocation_def split: asidcontrol_invocation.splits) apply (clarsimp simp: valid_aci'_def cte_wp_at_ctes_of cong: conj_cong) - apply (rule hoare_pre) - apply (wp static_imp_wp |simp add:placeNewObject_def2)+ - apply (wp createObjects_orig_obj_at2' updateFreeIndex_pspace_no_overlap' getSlotCap_wp static_imp_wp) + apply (wp static_imp_wp |simp add:placeNewObject_def2)+ + apply (wp createObjects_orig_obj_at2' updateFreeIndex_pspace_no_overlap' getSlotCap_wp static_imp_wp)+ apply (clarsimp simp: projectKO_opts_defs) apply (strengthen st_tcb_strg' [where P=\]) apply (wp deleteObjects_invs_derivatives[where p="makePoolParent aci"] hoare_vcg_ex_lift deleteObjects_cte_wp_at'[where d=False] deleteObjects_st_tcb_at'[where p="makePoolParent aci"] static_imp_wp - updateFreeIndex_pspace_no_overlap' deleteObject_no_overlap[where d=False]) + updateFreeIndex_pspace_no_overlap' deleteObject_no_overlap[where d=False])+ apply (case_tac ctea) apply (clarsimp) apply (frule ctes_of_valid_cap') @@ -1726,7 +1699,7 @@ lemma createMappingEntires_valid_slots_duplicated'[wp]: apply (clarsimp simp:mask_def add.commute upto_enum_step_def) apply (drule(1) le_less_trans) apply simp - apply wp + apply wp+ apply (intro conjI impI) apply ((clarsimp simp: vmsz_aligned_def pageBitsForSize_def slots_duplicated_ensured_def @@ -1962,20 +1935,19 @@ lemma arch_decodeInvocation_wf[wp]: apply (rule word_and_le2) apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def isCap_simps Let_def) apply(cases "ARM_H.isPDFlushLabel (invocation_type label)", simp_all) - apply(cases args, simp_all) - apply(rule hoare_pre, wp) - defer - apply(rule hoare_pre, wp) - apply(case_tac list, simp_all) - defer + apply(cases args; simp) apply(wp) - apply(simp add:split_def, wp) - apply(case_tac xb, simp_all)[] - apply (wp whenE_throwError_wp) - apply(simp add:valid_arch_inv'_def)+ - apply wp + defer + apply(wp) + apply(case_tac list, simp_all) + defer + apply(wp) + apply(simp add:split_def, wp) + apply(case_tac xb, simp_all)[] + apply (wp whenE_throwError_wp)+ + apply(simp add:valid_arch_inv'_def)+ + apply wp+ apply(simp, wp) - apply(rule throwError_R') done lemma setObject_cte_nosch [wp]: @@ -2218,7 +2190,7 @@ lemma performASIDControlInvocation_invs' [wp]: updateFreeIndex_descendants_of2 updateFreeIndex_caps_overlap_reserved updateCap_cte_wp_at_cases freeIndexUpdate_ex_cte static_imp_wp - getSlotCap_wp) + getSlotCap_wp)+ apply (clarsimp simp:conj_comms ex_disj_distrib is_aligned_mask | strengthen invs_valid_pspace' invs_pspace_aligned' invs_pspace_distinct' empty_descendants_range_in')+ @@ -2262,7 +2234,7 @@ lemma doFlush_underlying_memory[wp]: "\ \m'. underlying_memory m' p = um \ doFlush flush_type vstart vend pstart \ \_ m'. underlying_memory m' p = um \" - unfolding doFlush_def by(cases flush_type, simp_all, wp) + unfolding doFlush_def by(cases flush_type; wpsimp) (* FIXME: move *) lemma dmo_invs'_simple: diff --git a/proof/refine/Bits_R.thy b/proof/refine/Bits_R.thy index d3a1d4527..c61ff7b93 100644 --- a/proof/refine/Bits_R.thy +++ b/proof/refine/Bits_R.thy @@ -343,13 +343,7 @@ lemmas corres_unify_failure = lemma ignoreFailure_wp[wp_split]: "\P\ v \\rv. Q ()\,\\rv. Q ()\ \ \P\ ignoreFailure v \Q\" - apply (simp add: ignoreFailure_def const_def) - apply wp - apply assumption - done - - - + by (simp add: ignoreFailure_def const_def) wp lemma ep'_cases_weak_wp: assumes "\P_A\ a \Q\" @@ -489,22 +483,16 @@ lemma corres_empty_on_failure: apply (rule corres_split_catch) apply (rule corres_trivial, simp) apply (erule corres_rel_imp) - apply (case_tac x) - apply simp - apply simp - apply wp + apply (case_tac x; simp) + apply wp+ apply simp+ done lemma emptyOnFailure_wp[wp]: - "\P\ m \Q\,\\rv. Q []\ - \ \P\ emptyOnFailure m \Q\" - apply (simp add: emptyOnFailure_def) - apply wp - apply assumption - done + "\P\ m \Q\,\\rv. Q []\ \ \P\ emptyOnFailure m \Q\" + by (simp add: emptyOnFailure_def) wp lemma withoutPreemption_lift: "\P\ f \Q\ \ \P\ withoutPreemption f \Q\, \E\" @@ -569,7 +557,7 @@ lemma corres_const_on_failure: apply (case_tac xa) apply (clarsimp simp: const_def) apply simp - apply wp + apply wp+ apply simp+ done diff --git a/proof/refine/CNodeInv_R.thy b/proof/refine/CNodeInv_R.thy index 4a34405b4..1a07c6450 100644 --- a/proof/refine/CNodeInv_R.thy +++ b/proof/refine/CNodeInv_R.thy @@ -239,7 +239,7 @@ lemma dec_cnode_inv_corres: apply simp apply simp apply simp - apply wp + apply wp+ apply (auto elim!: valid_cnode_capI)[1] apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) -- "Delete" @@ -252,7 +252,7 @@ lemma dec_cnode_inv_corres: apply simp apply simp apply simp - apply wp + apply wp+ apply (auto elim!: valid_cnode_capI)[1] apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) -- "SaveCall" @@ -266,11 +266,11 @@ lemma dec_cnode_inv_corres: apply simp apply (rule ensure_empty_corres) apply simp - apply wp + apply wp+ apply simp apply simp apply simp - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (auto elim!: valid_cnode_capI)[1] apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) -- "CancelBadgedSends" @@ -328,7 +328,7 @@ lemma dec_cnode_inv_corres: apply simp apply (intro conjI) apply (erule cap_map_update_data)+ - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (rule_tac F = "(src_slot \ dest_slot) = (srcSlot \ destSlot)" and P = "\s. cte_at src_slot s \ cte_at dest_slot s \ invs s" and P' = invs' in corres_req) apply simp @@ -343,12 +343,12 @@ lemma dec_cnode_inv_corres: apply simp apply clarsimp apply clarsimp - apply (wp hoare_whenE_wp) + apply (wp hoare_whenE_wp)+ apply simp apply simp apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid') apply (simp add: if_apply_def2) - apply (wp hoare_drop_imps)[1] + apply (wp hoare_drop_imps) apply wp apply simp apply simp @@ -375,7 +375,7 @@ lemma dec_cnode_inv_corres: apply (rule corres_splitEE[OF _ lsfc_corres]) apply (rule corres_trivial, clarsimp split: list.split_asm) apply simp+ - apply wp + apply wp+ apply (auto elim!: valid_cnode_capI)[1] apply fastforce apply (clarsimp simp: decode_cnode_invocation_def decodeCNodeInvocation_def @@ -411,9 +411,7 @@ lemma updateCapData_Zombie: lemma cte_wp_valid_cap': "\ cte_wp_at' (op = cte) p s; valid_objs' s \ \ s \' cteCap cte" by (erule(1) ctes_of_valid) - -lemma Null_valid' [iff]: "s \' NullCap" by (simp add: valid_cap'_def) - + lemma updateCapData_Zombie': "isZombie (updateCapData P x c) = isZombie c" apply (cases "updateCapData P x c = NullCap") @@ -558,7 +556,7 @@ lemma decodeCNodeInv_wf[wp]: apply (simp add: weak_derived_updateCapData capBadge_updateCapData_True valid_updateCapDataI ctes_of_valid') apply (fastforce simp:isCap_simps updateCapData_def) - apply (wp lsfco_cte_at') + apply (wp lsfco_cte_at')+ apply clarsimp -- "Errors" apply (elim disjE exE conjE, @@ -868,8 +866,8 @@ proof (induct rule: finalise_spec_induct) apply (subst finaliseSlot'_simps_ext) apply (simp only: split_def) apply wp - apply (simp, wp wp)[1] - apply (wp "1.hyps", assumption+) + apply (simp, wp wp) + apply (wp "1.hyps") apply (unfold Let_def split_def fst_conv snd_conv case_Zombie_assert_fold haskell_fail_def) apply (wp wp preemptionPoint_inv| simp add: o_def irq)+ @@ -898,6 +896,7 @@ lemma cteDelete_preservation: assumes irq: "irq_state_independent_H P" shows "\P\ cteDelete p e \\rv. P\" + including no_pre apply (simp add: cteDelete_def whenE_def split_def) apply (wp wp) apply (simp only: simp_thms cases_simp) @@ -1252,9 +1251,8 @@ lemma updateMDB_cte_wp_at_other: apply safe apply wp apply simp - apply wp - apply (wp setCTE_cte_wp_at_other) - done + apply (wp setCTE_cte_wp_at_other) + done (* CLAG from _next *) lemma mdb_chain_0_modify_map_0: @@ -5104,7 +5102,7 @@ lemma cteSwap_iflive'[wp]: simp only: if_live_then_nonz_cap'_def imp_conv_disj ex_nonz_cap_to'_def) apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift - hoare_vcg_ex_lift updateCap_cte_wp_at_cases static_imp_wp) + hoare_vcg_ex_lift updateCap_cte_wp_at_cases static_imp_wp)+ apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) if_live_then_nonz_capE') apply (clarsimp simp: ex_nonz_cap_to'_def cte_wp_at_ctes_of) @@ -5272,7 +5270,7 @@ lemma cteSwap_urz[wp]: apply (simp add: cteSwap_def) apply (rule hoare_pre) apply (rule untyped_ranges_zero_lift) - apply wp + apply wp+ apply clarsimp apply (erule untyped_ranges_zero_delta[where xs="[c1, c2]"]) apply (simp add: modify_map_def) @@ -5789,7 +5787,7 @@ lemma updateCap_untyped_ranges_zero_simple: "\cte_wp_at' ((\cp. untypedZeroRange cp = untypedZeroRange cap) o cteCap) sl and untyped_ranges_zero'\ updateCap sl cap \\_. untyped_ranges_zero'\" - apply (rule hoare_pre, rule untyped_ranges_zero_lift, wp) + apply (rule hoare_pre, rule untyped_ranges_zero_lift, wp+) apply (clarsimp simp: modify_map_def cteCaps_of_def cte_wp_at_ctes_of) apply (simp add: untyped_ranges_zero_inv_def) apply (rule arg_cong[where f=ran]) @@ -5818,6 +5816,7 @@ lemma make_zombie_invs': \ (\pr. p \ set (ksReadyQueues s pr)))) sl s\ updateCap sl cap \\rv. invs'\" + including no_pre apply (simp add: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def valid_irq_handlers'_def irq_issued'_def) apply (wp updateCap_ctes_of_wp sch_act_wf_lift valid_queues_lift cur_tcb_lift @@ -6124,7 +6123,7 @@ lemma cteSwap_cte_wp_cteCap: apply simp apply (wp hoare_drop_imps)[1] apply (wp updateMDB_weak_cte_wp_at updateCap_cte_wp_at_cases - getCTE_wp' hoare_vcg_all_lift static_imp_wp) + getCTE_wp' hoare_vcg_all_lift static_imp_wp)+ apply simp apply (clarsimp simp: o_def) done @@ -6138,7 +6137,7 @@ lemma capSwap_cte_wp_cteCap: apply(simp add: capSwapForDelete_def) apply(wp) apply(rule cteSwap_cte_wp_cteCap) - apply(wp getCTE_wp getCTE_cte_wp_at static_imp_wp) + apply(wp getCTE_wp getCTE_cte_wp_at static_imp_wp)+ apply(clarsimp) apply(rule conjI) apply(simp add: cte_at_cte_wp_atD) @@ -6290,8 +6289,8 @@ proof (induct rule: finalise_spec_induct) apply (subst finaliseSlot'_simps_ext) apply (simp only: split_def) apply (rule hoare_pre_spec_validE) - apply (wp | simp)+ - apply (wp "1.hyps" updateCap_cte_wp_at_cases, + apply (wp | simp)+ + apply ((wp "1.hyps" updateCap_cte_wp_at_cases)+, (assumption | rule refl | simp only: split_def fst_conv snd_conv)+) apply (wp | simp)+ apply (rule hoare_strengthen_post) @@ -6325,8 +6324,7 @@ lemma cteDelete_delete_cases: apply wp apply (rule hoare_strengthen_post [OF emptySlot_deletes]) apply (clarsimp simp: cte_wp_at_ctes_of) - apply wp - apply (rule hoare_pre, wp) + apply wp+ apply (rule hoare_post_imp_R, rule finaliseSlot_abort_cases) apply (clarsimp simp: cte_wp_at_ctes_of) apply simp @@ -6528,9 +6526,9 @@ lemma reduceZombie_invs'': in hoare_post_imp) apply (clarsimp simp: cte_wp_at_ctes_of mult.commute mult.left_commute dest!: isCapDs) apply (simp add: field_simps) - apply (wp getCTE_cte_wp_at) + apply (wp getCTE_cte_wp_at)+ apply simp - apply wp[1] +apply wp apply (rule spec_strengthen_postE) apply (rule_tac Q="\fc s. rv = capZombiePtr cap + of_nat (capZombieNumber cap) * 16 - 16" @@ -6642,7 +6640,7 @@ proof (induct arbitrary: P p rule: finalise_spec_induct2) apply (wp | simp)+ apply (wp make_zombie_invs' updateCap_cte_wp_at_cases hoare_vcg_disj_lift)[1] - apply (wp hyps, assumption+) + apply (wp hyps) apply ((wp preemptionPoint_invE preemptionPoint_invR | clarsimp simp: sch_act_simple_def @@ -6658,7 +6656,7 @@ proof (induct arbitrary: P p rule: finalise_spec_induct2) apply (clarsimp simp: cte_wp_at_ctes_of) apply (wp, simp) apply (wp make_zombie_invs' updateCap_ctes_of_wp updateCap_cap_to' - hoare_vcg_disj_lift updateCap_cte_wp_at_cases) + hoare_vcg_disj_lift updateCap_cte_wp_at_cases)+ apply simp apply (rule hoare_strengthen_post) apply (rule_tac Q="\fin s. invs' s \ sch_act_simple s \ s \' (fst fin) @@ -6911,9 +6909,8 @@ lemma cteDelete_cte_wp_at_invs: (\zb n. cteCap cte = Zombie slot zb n)) slot s)" and E="\rv. \" in hoare_post_impErr) - apply (rule hoare_pre, wp finaliseSlot_invs finaliseSlot_removeable - finaliseSlot_sch_act_simple - hoare_drop_imps(2)[OF finaliseSlot_irqs]) + apply (wp finaliseSlot_invs finaliseSlot_removeable finaliseSlot_sch_act_simple + hoare_drop_imps(2)[OF finaliseSlot_irqs]) apply (rule hoare_post_imp_R, rule finaliseSlot_abort_cases) apply (clarsimp simp: cte_wp_at_ctes_of dest!: isCapDs) apply simp @@ -6921,8 +6918,7 @@ lemma cteDelete_cte_wp_at_invs: apply simp apply (simp add: cte_wp_at_ctes_of validE_R_def) apply (simp add: whenE_def) - apply (rule hoare_pre) - apply (wp emptySlot_cte_wp_cap_other) + apply (wp emptySlot_cte_wp_cap_other) apply (rule_tac Q'="\rv s. invs' s \ sch_act_simple s \ (fst rv \ cte_wp_at' (\cte. removeable' slot s (cteCap cte)) slot s) \ @@ -6992,7 +6988,7 @@ lemma cteDelete_st_tcb_at': apply (rule cteDelete_preservation) apply (rule finaliseCap2_st_tcb_at' [OF x]) apply assumption - apply wp + apply wp+ apply auto done @@ -7090,7 +7086,7 @@ proof (induct rule: finalise_induct3) apply (rule hoare_pre_spec_validE) apply wp apply ((wp | simp)+)[1] - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply (unfold Let_def split_def fst_conv snd_conv haskell_fail_def case_Zombie_assert_fold) @@ -7143,6 +7139,7 @@ lemma cteDelete_rvk_prog: "\\s. revoke_progress_ord m (option_map capToRPO \ cteCaps_of s)\ cteDelete slot e \\rv s. revoke_progress_ord m (option_map capToRPO \ cteCaps_of s)\,-" + including no_pre apply (simp add: cteDelete_def whenE_def split_def) apply (wp emptySlot_rvk_prog) apply (simp only: cases_simp) @@ -7338,8 +7335,7 @@ lemma spec_corres_locate_Zombie: apply (rule word_of_nat_less) apply (simp add: cap_aligned_def) apply (erule corres_guard_imp, simp_all) - apply wp - apply (rule no_fail_pre, wp) + apply wp+ done lemma spec_corres_req: @@ -7758,7 +7754,7 @@ next apply simp apply (simp add: is_cap_simps) apply (rule_tac Q="\rv. cte_at' (cte_map ?target)" in valid_prove_more) - apply (wp, wp getCTE_wp) + apply (wp, (wp getCTE_wp)+) apply (clarsimp simp: cte_wp_at_ctes_of) apply (rule no_fail_pre, wp, simp) apply clarsimp @@ -7795,7 +7791,7 @@ next apply (simp add: returnOk_def) apply (clarsimp simp: zombie_alignment_oddity cte_map_replicate) apply (wp get_cap_cte_wp_at getCTE_wp' rec_del_cte_at - rec_del_invs rec_del_delete_cases) + rec_del_invs rec_del_delete_cases)+ apply (rule hoare_post_imp_R) apply (rule_tac P="\cp. cp = Zombie ptr (zbits_map bits) (Suc n)" in cteDelete_cte_wp_at_invs[where p="cte_map slot"]) @@ -7904,7 +7900,7 @@ proof (induct rule: cteRevoke.induct) case (1 p s') show ?case apply (subst cteRevoke.simps) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply (wp x y preemptionPoint_inv hoare_drop_imps irq | clarsimp)+ done qed @@ -8302,6 +8298,7 @@ lemma arch_recycleCap_improve_cases': "\\ isPageCap param_b; \ lemma threadSet_st_tcb_at2: assumes x: "\tcb. P (tcbState tcb) \ P (tcbState (f tcb))" shows "\st_tcb_at' P t\ threadSet f t' \\rv. st_tcb_at' P t\" + including no_pre apply (simp add: threadSet_def pred_tcb_at'_def) apply (wp setObject_tcb_strongest) apply (rule hoare_strengthen_post, rule getObject_tcb_sp) @@ -8980,7 +8977,7 @@ lemma cteMove_iflive'[wp]: ex_nonz_cap_to'_def) apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift hoare_vcg_ex_lift updateCap_cte_wp_at_cases - getCTE_wp static_imp_wp) + getCTE_wp static_imp_wp)+ apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) if_live_then_nonz_capE') apply (clarsimp simp: ex_nonz_cap_to'_def cte_wp_at_ctes_of) @@ -9148,8 +9145,7 @@ lemma cteMove_invs' [wp]: | rule hoare_vcg_conj_lift[rotated])+ apply (unfold cteMove_def) apply (wp cur_tcb_lift valid_queues_lift - sch_act_wf_lift ct_idle_or_in_cur_domain'_lift2 tcb_in_cur_domain'_lift - ) + sch_act_wf_lift ct_idle_or_in_cur_domain'_lift2 tcb_in_cur_domain'_lift)+ apply clarsimp done @@ -9217,7 +9213,7 @@ lemma corres_null_cap_update: (invs' and cte_at' (cte_map slot)) (set_cap cap slot) (updateCap (cte_map slot) cap')" apply (rule corres_caps_decomposition[rotated]) - apply (wp updateCap_ctes_of_wp) + apply (wp updateCap_ctes_of_wp)+ apply (clarsimp simp: cte_wp_at_ctes_of modify_map_apply fun_upd_def[symmetric]) apply (frule state_relation_pspace_relation) @@ -9344,7 +9340,7 @@ lemma inv_cnode_corres: apply (erule cap_move_corres) apply wp apply (simp add: cte_wp_at_caps_of_state) - apply (wp cap_move_caps_of_state cteMove_cte_wp_at [simplified o_def]) + apply (wp cap_move_caps_of_state cteMove_cte_wp_at [simplified o_def])+ apply (simp add: real_cte_tcb_valid invs_def valid_state_def valid_pspace_def) apply (elim conjE exE) apply (drule(3) real_cte_weak_derived_not_reply_masterD)+ @@ -9391,7 +9387,7 @@ lemma inv_cnode_corres: apply (simp add: real_cte_tcb_valid)+ apply (wp get_cap_wp) apply (simp add: getSlotCap_def) - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply clarsimp apply (rule conjI) apply (rule tcb_at_cte_at) @@ -9480,6 +9476,7 @@ lemma invokeCNode_invs' [wp]: "\invs' and sch_act_simple and valid_cnode_inv' cinv\ invokeCNode cinv \\y. invs'\" unfolding invokeCNode_def + including no_pre apply (cases cinv) apply (wp cteRevoke_invs' cteInsert_invs | simp split del: if_split)+ apply (clarsimp simp: cte_wp_at_ctes_of is_derived'_def isCap_simps badge_derived'_def) @@ -9498,13 +9495,13 @@ lemma invokeCNode_invs' [wp]: apply clarsimp apply (erule ctes_of_valid_cap') apply fastforce - apply (wp cteDelete_invs'|simp)+ + apply (wp cteDelete_invs'|simp)+ apply (intro impI conjI) apply (rule hoare_pre) - apply wp + apply wp+ apply (clarsimp simp: cte_wp_at_ctes_of weak_derived'_def) apply (rule hoare_pre) - apply (wp cteMove_ex cteMove_cte_wp_at) + apply (wp cteMove_ex cteMove_cte_wp_at)+ apply (clarsimp simp:cte_wp_at_ctes_of) apply (fastforce simp: isCap_simps weak_derived'_def) apply (rule hoare_pre) @@ -9533,7 +9530,7 @@ proof (induct rule: finalise_spec_induct) apply (rule hoare_pre_spec_validE) apply (subst finaliseSlot'_simps_ext) apply (simp only: split_def) - apply (wp "1.hyps", assumption+) + apply (wp "1.hyps") apply (unfold Let_def split_def fst_conv snd_conv case_Zombie_assert_fold haskell_fail_def) apply (wp getCTE_wp' preemptionPoint_invR| simp add: o_def irq_state_independent_HI)+ @@ -9566,11 +9563,12 @@ lemma cteDelete_IRQInactive: -, \\rv s. intStateIRQTable (ksInterruptState s) rv \ irqstate.IRQInactive\" apply (simp add: cteDelete_def split_def) apply (wp hoare_whenE_wp) - apply (rule hoare_post_impErr) - apply (rule validE_E_validE) - apply (rule finaliseSlot_IRQInactive) + apply (rule hoare_post_impErr) + apply (rule validE_E_validE) + apply (rule finaliseSlot_IRQInactive) + apply simp apply simp - apply simp + apply assumption done lemma cteDelete_irq_states': @@ -9578,11 +9576,12 @@ lemma cteDelete_irq_states': \\rv. valid_irq_states'\" apply (simp add: cteDelete_def split_def) apply (wp hoare_whenE_wp) - apply (rule hoare_post_impErr) - apply (rule hoare_valid_validE) - apply (rule finaliseSlot_irq_states') + apply (rule hoare_post_impErr) + apply (rule hoare_valid_validE) + apply (rule finaliseSlot_irq_states') + apply simp apply simp - apply simp + apply assumption done lemma cteRevoke_irq_states': @@ -9603,10 +9602,9 @@ lemma cteRevoke_IRQInactive': proof (induct rule: cteRevoke.induct) case (1 p s') show ?case - apply (subst cteRevoke.simps) - apply (wp "1.hyps" unlessE_wp hoare_whenE_wp,assumption+) - apply (wp preemptionPoint_IRQInactive_spec - cteDelete_IRQInactive cteDelete_irq_states' getCTE_wp') + apply (subst cteRevoke.simps) + apply (wp "1.hyps" unlessE_wp hoare_whenE_wp preemptionPoint_IRQInactive_spec + cteDelete_IRQInactive cteDelete_irq_states' getCTE_wp')+ apply clarsimp done qed diff --git a/proof/refine/CSpace1_R.thy b/proof/refine/CSpace1_R.thy index 885acb592..e2ca7429a 100644 --- a/proof/refine/CSpace1_R.thy +++ b/proof/refine/CSpace1_R.thy @@ -461,6 +461,7 @@ proof - done qed + lemma cte_map_shift: assumes bl: "to_bl cref' = zs @ cref" assumes pre: "guard \ cref" @@ -524,8 +525,7 @@ lemma corres_stateAssert_assume_stronger: apply (rule_tac F="P' x" in corres_req) apply clarsimp apply (auto elim: corres_guard_imp)[1] - apply wp - apply (rule no_fail_pre, wp) + apply wp+ done lemma cap_table_at_gsCNodes: @@ -628,17 +628,14 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct) apply clarsimp apply (rule corres_noopE) prefer 2 - apply (rule no_fail_pre, wp)[1] + apply wp apply wp apply (clarsimp simp: objBits_simps cte_level_bits_def) apply (erule (2) valid_CNodeCapE) apply (erule (3) cte_map_shift') apply simp apply simp - apply (subgoal_tac "cbits + length guard < length cref") - prefer 2 - apply simp - apply simp + apply (subgoal_tac "cbits + length guard < length cref"; simp) apply (rule corres_initial_splitE) apply clarsimp apply (rule corres_guard_imp) @@ -680,17 +677,11 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct) apply simp apply assumption apply (simp add: cte_level_bits_def) - apply wp + apply (wp get_cap_wp) apply clarsimp - apply (rule hoare_chain) - apply (rule hoare_conj [OF get_cap_inv [of "valid_objs and pspace_aligned"] get_cap_valid]) - apply clarsimp - apply clarsimp - apply clarsimp - apply wp - apply simp - apply simp - done + apply (erule (1) cte_wp_valid_cap) + apply wpsimp + done } ultimately show ?thesis by fast @@ -903,31 +894,16 @@ lemma updateMDB_weak_cte_wp_at: unfolding updateMDB_def apply simp apply safe - apply (wp setCTE_weak_cte_wp_at) - apply (rule hoare_post_imp [OF _ getCTE_sp]) - apply (clarsimp simp: cte_wp_at'_def) + apply (wp setCTE_weak_cte_wp_at getCTE_wp) + apply (auto simp: cte_wp_at'_def) done lemma cte_wp_at_extract': "\ cte_wp_at' (\c. c = x) p s; cte_wp_at' P p s \ \ P x" by (clarsimp simp: cte_wp_at_ctes_of) -lemma cteCap_update_id [simp]: - "cteCap (cteCap_update (\_. cap) c) = cap" - by (cases c) simp - lemmas setCTE_valid_objs = setCTE_valid_objs' -lemma updateMDB_objs [wp]: - "\valid_objs'\ - updateMDB p f - \\rv. valid_objs'\" - apply (simp add: updateMDB_def) - apply clarsimp - apply (wp setCTE_valid_objs | simp)+ - done - - lemma capFreeIndex_update_valid_cap': "\fa \ fb; fb \ 2 ^ bits; is_aligned (of_nat fb :: word32) 4; s \' capability.UntypedCap d v bits fa\ @@ -965,8 +941,8 @@ lemma maxFreeIndex_update_valid_cap'[simp]: s \' capability.UntypedCap d v0a v1a (maxFreeIndex v1a)" apply (rule capFreeIndex_update_valid_cap'[rotated -1]) apply assumption - apply (clarsimp simp:valid_cap'_def capAligned_def - valid_untyped'_def ko_wp_at'_def maxFreeIndex_def shiftL_nat)+ + apply (clarsimp simp: valid_cap'_def capAligned_def ko_wp_at'_def + maxFreeIndex_def shiftL_nat)+ apply (erule is_aligned_weaken[OF is_aligned_triv]) done @@ -976,19 +952,20 @@ lemma ctes_of_valid_cap'': apply (simp add: cte_wp_at_ctes_of) apply assumption done - + lemma cap_insert_objs' [wp]: "\valid_objs' and valid_cap' cap\ cteInsert cap src dest \\rv. valid_objs'\" + including no_pre apply (simp add: cteInsert_def updateCap_def setUntypedCapAsFull_def bind_assoc split del: if_split) apply (wp setCTE_valid_objs) apply simp - apply wp + apply wp+ apply (clarsimp simp: updateCap_def) apply (wp|simp)+ apply (rule hoare_drop_imp)+ - apply wp + apply wp+ apply (rule hoare_strengthen_post[OF getCTE_sp]) apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps dest!: ctes_of_valid_cap'') @@ -1002,7 +979,7 @@ lemma cteInsert_weak_cte_wp_at: unfolding cteInsert_def error_def updateCap_def setUntypedCapAsFull_def apply (simp add: bind_assoc split del: if_split) apply (wp setCTE_weak_cte_wp_at updateMDB_weak_cte_wp_at static_imp_wp | simp)+ - apply (wp getCTE_ctes_wp) + apply (wp getCTE_ctes_wp)+ apply (clarsimp simp: isCap_simps split:if_split_asm| rule conjI)+ done @@ -1011,9 +988,7 @@ lemma setCTE_valid_cap: by (rule typ_at_lifts, rule setCTE_typ_at') lemma setCTE_weak_cte_at: - "\\s. cte_at' p s\ - setCTE ptr cte - \\uu. cte_at' p\" + "\\s. cte_at' p s\ setCTE ptr cte \\uu. cte_at' p\" by (rule typ_at_lifts, rule setCTE_typ_at') lemma updateMDB_valid_cap: @@ -1040,9 +1015,7 @@ lemma updateMDB_ctes_of_wp: \\rv s. P (ctes_of s)\" apply (simp add: updateMDB_def) apply safe - apply wp - apply (rule hoare_pre) - apply (wp getCTE_wp) + apply (wp getCTE_wp) apply (clarsimp simp: cte_wp_at_ctes_of simp del: fun_upd_apply) apply (simp add: modify_map_def set_is_modify) done @@ -1661,13 +1634,8 @@ lemma cteInsert_valid_cap: "\valid_cap' c\ cteInsert cap src dest \ \_. valid_cap' c\" unfolding cteInsert_def updateCap_def setUntypedCapAsFull_def apply (simp split del: if_split) - apply (wp updateMDB_valid_cap setCTE_valid_cap ) - prefer 2 - apply (rule getCTE_sp) - apply (rule hoare_post_imp) - prefer 2 - apply (rule getCTE_sp) - apply clarsimp + apply (wp updateMDB_valid_cap setCTE_valid_cap, (wp getCTE_wp)+) + apply (fastforce dest: cte_at_cte_wp_atD) done lemma subtree_not_Null: @@ -2734,8 +2702,7 @@ lemma no_fail_setCTE [wp]: updateObject_cte alignCheck_def alignError_def typeError_def is_aligned_mask[symmetric] cong: kernel_object.case_cong) - apply (rule no_fail_pre) - apply (wp, wpc, wp) + apply (wp|wpc)+ apply (clarsimp simp: cte_wp_at'_def getObject_def split_def in_monad loadObject_cte dest!: in_singleton @@ -2829,23 +2796,8 @@ lemma cap_update_corres: apply (clarsimp simp: cte_wp_at_ctes_of) apply (clarsimp simp add: state_relation_def) apply (drule(1) pspace_relationsD) - apply (frule (3) set_cap_not_quite_corres) - apply fastforce - apply fastforce - apply fastforce - apply fastforce - apply assumption - apply fastforce - apply fastforce - apply fastforce - apply fastforce - apply (erule cte_wp_at_weakenE, rule TrueI) - apply fastforce - apply fastforce - apply assumption - apply assumption - apply assumption - apply (rule refl) + apply (frule (3) set_cap_not_quite_corres; fastforce?) + apply (erule cte_wp_at_weakenE, rule TrueI) apply clarsimp apply (rule bexI) prefer 2 @@ -2882,7 +2834,7 @@ lemma cap_update_corres: apply (frule(3) is_final_untyped_ptrs [OF _ _ not_sym], clarsimp+) apply (clarsimp simp: cte_wp_at_caps_of_state) apply (simp add: is_cap_simps, elim disjE exE, simp_all)[1] - apply (simp add: disj_ac eq_commute) + apply (simp add: eq_commute) apply (drule cte_wp_at_eqD, clarsimp) apply (drule(1) pspace_relation_ctes_ofI, clarsimp+) apply (drule(1) capClass_ztc_relation)+ @@ -4538,8 +4490,7 @@ lemma set_untyped_cap_as_full_corres: apply simp+ apply (clarsimp simp:free_index_update_def isCap_simps is_cap_simps) apply (subst identity_eq) - apply (wp getCTE_sp getCTE_get) - apply (rule no_fail_pre[OF no_fail_getCTE]) + apply (wp getCTE_sp getCTE_get)+ apply (clarsimp simp:cte_wp_at_ctes_of)+ apply (clarsimp simp:is_cap_simps isCap_simps)+ apply (case_tac c,simp_all) @@ -6269,7 +6220,7 @@ lemma cins_corres: apply (subgoal_tac "cte_map (aa,bb) \ cte_map dest") subgoal by (clarsimp simp: modify_map_def split: if_split_asm) apply (erule (5) cte_map_inj) -(* FIX ME *) +(* FIXME *) apply (rule set_untyped_cap_as_full_corres) apply simp+ @@ -6277,7 +6228,7 @@ lemma cins_corres: set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap setUntypedCapAsFull_cte_wp_at | clarsimp simp: cte_wp_at_caps_of_state| wps)+ apply (case_tac rv',clarsimp simp:cte_wp_at_ctes_of maskedAsFull_def) - apply (wp getCTE_wp' get_cap_wp) + apply (wp getCTE_wp' get_cap_wp)+ apply clarsimp subgoal by (fastforce elim: cte_wp_at_weakenE) apply (clarsimp simp: cte_wp_at'_def) @@ -6373,8 +6324,7 @@ lemma cins_corres: apply clarsimp apply (subst mdb_insert_abs_sib.descendants, erule mdb_insert_abs_sib.intro) apply (frule(4) iffD1[OF is_derived_eq]) - apply (drule_tac src_cap' = src_cap' in - maskedAsFull_revokable[where a = c',symmetric]) + apply (drule_tac src_cap' = src_cap' in maskedAsFull_revokable[where a = c',symmetric]) apply simp apply (subst mdb_insert_sib.descendants) apply (rule mdb_insert_sib.intro, assumption) @@ -7338,7 +7288,7 @@ lemma cap_swap_corres: (\s. cte_wp_at' (weak_derived' scap' o cteCap) src' s \ cte_wp_at' (weak_derived' dcap' o cteCap) dest' s)) (cap_swap scap src dcap dest) (cteSwap scap' src' dcap' dest')" - (is "corres _ ?P ?P' _ _") using assms + (is "corres _ ?P ?P' _ _") using assms including no_pre apply (unfold cap_swap_def cteSwap_def) apply (cases "src=dest") apply (rule corres_assume_pre) @@ -7445,7 +7395,10 @@ lemma cap_swap_corres: apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) apply (drule in_getCTE, clarsimp) - apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp)+ + apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) + apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) + apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) + apply (drule (2) updateMDB_the_lot', fastforce, fastforce, simp, clarsimp) apply (thin_tac "ksMachineState t = p" for t p)+ apply (thin_tac "ksCurThread t = p" for t p)+ apply (thin_tac "ksReadyQueues t = p" for t p)+ @@ -7792,7 +7745,7 @@ lemma cap_swap_for_delete_corres: apply (rule_tac P1=wellformed_cap in corres_split [OF _ get_cap_corres_P]) apply (rule_tac P1=wellformed_cap in corres_split [OF _ get_cap_corres_P]) apply (rule cap_swap_corres, rule refl, rule refl, clarsimp+) - apply (wp get_cap_wp getCTE_wp') + apply (wp get_cap_wp getCTE_wp')+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (drule (1) caps_of_state_valid_cap)+ apply (simp add: valid_cap_def2) @@ -7907,7 +7860,6 @@ lemma ensure_no_children_save': apply clarsimp apply (erule cte_wp_at_weakenE') apply (clarsimp simp: no_child'_def Let_def nullPointer_def) - done end diff --git a/proof/refine/CSpace_I.thy b/proof/refine/CSpace_I.thy index aea935750..18028e471 100644 --- a/proof/refine/CSpace_I.thy +++ b/proof/refine/CSpace_I.thy @@ -18,8 +18,6 @@ begin context begin interpretation Arch . (*FIXME: arch_split*) -declare word_neq_0_conv[simp del] - lemma capUntypedPtr_simps [simp]: "capUntypedPtr (ThreadCap r) = r" "capUntypedPtr (NotificationCap r badge a b) = r" @@ -239,7 +237,7 @@ next show ?case proof (cases "q = y") case True thus ?thesis using step - by (clarsimp intro!: r_into_rtrancl) + by fastforce next case False have "m \ y \\<^sup>* q" @@ -557,7 +555,7 @@ lemma fresh_virt_cap_class_Physical[simp]: lemma fresh_virt_cap_classD: "\ m x = Some cte; fresh_virt_cap_class C m \ \ C \ PhysicalClass \ capClass (cteCap cte) \ C" - by (auto simp: fresh_virt_cap_class_def intro: ranI) + by (auto simp: fresh_virt_cap_class_def) lemma capRange_untyped: "capRange cap' \ untypedRange cap \ {} \ isUntypedCap cap" @@ -783,14 +781,13 @@ lemma sameRegionAs_def2: isCap_Master capRange_Master capClass_Master) apply (clarsimp simp: isCap_simps capMasterCap_def[where cap="UntypedCap d p n f" for d p n f]) - apply (simp add: capRange_def interval_empty capUntypedSize_capBits) + apply (simp add: capRange_def capUntypedSize_capBits) apply (intro impI iffI) apply (clarsimp del: subsetI intro!: range_subsetI) apply clarsimp - apply (simp add: range_subset_eq2 interval_empty) + apply (simp add: range_subset_eq2) apply (simp cong: conj_cong) - apply (simp add: capMasterCap_def sameRegionAs_def isCap_simps - capBadge_simps isArchPageCap_def + apply (simp add: capMasterCap_def sameRegionAs_def isArchPageCap_def split: capability.split split del: if_split cong: if_cong) apply (simp add: ARM_H.sameRegionAs_def isCap_simps @@ -798,8 +795,7 @@ lemma sameRegionAs_def2: split del: if_split cong: if_cong) apply (clarsimp simp: capRange_def Let_def) apply (simp add: range_subset_eq2 cong: conj_cong) - apply (simp add: interval_empty conj_comms) - by blast + by (simp add: conj_comms) lemma sameObjectAs_def2: "sameObjectAs cap cap' = (\cap cap'. @@ -2240,7 +2236,7 @@ lemma insertInitCap_valid_pspace: apply (erule_tac P="pspace_aligned' s \ pspace_distinct' s \ no_0_obj' s" in conjunct2) apply (simp cong: conj_cong) - apply (wp setCTE_map_to_ctes getCTE_ctes_wp) + apply (wp setCTE_map_to_ctes getCTE_ctes_wp)+ apply clarsimp apply (rule conjI) apply (clarsimp simp: valid_mdb_ctes_def) diff --git a/proof/refine/CSpace_R.thy b/proof/refine/CSpace_R.thy index bd6ca93d6..b40e1b727 100644 --- a/proof/refine/CSpace_R.thy +++ b/proof/refine/CSpace_R.thy @@ -1207,8 +1207,7 @@ lemma valid_bitmapQ_lift: shows "\Invariants_H.valid_bitmapQ\ f \\_. Invariants_H.valid_bitmapQ\" unfolding valid_bitmapQ_def bitmapQ_def apply (wp hoare_vcg_all_lift) - apply (rule hoare_pre) - apply (wps prq prqL1 prqL2) + apply (wps prq prqL1 prqL2) apply (rule hoare_vcg_prop, assumption) done @@ -1219,8 +1218,7 @@ lemma bitmapQ_no_L1_orphans_lift: shows "\ bitmapQ_no_L1_orphans \ f \\_. bitmapQ_no_L1_orphans \" unfolding valid_bitmapQ_def bitmapQ_def bitmapQ_no_L1_orphans_def apply (wp hoare_vcg_all_lift) - apply (rule hoare_pre) - apply (wps prq prqL1 prqL2) + apply (wps prq prqL1 prqL2) apply (rule hoare_vcg_prop, assumption) done @@ -1231,8 +1229,7 @@ lemma bitmapQ_no_L2_orphans_lift: shows "\ bitmapQ_no_L2_orphans \ f \\_. bitmapQ_no_L2_orphans \" unfolding valid_bitmapQ_def bitmapQ_def bitmapQ_no_L2_orphans_def apply (wp hoare_vcg_all_lift) - apply (rule hoare_pre) - apply (wps prq prqL1 prqL2) + apply (wps prq prqL1 prqL2) apply (rule hoare_vcg_prop, assumption) done @@ -1843,7 +1840,7 @@ lemma cteInsert_mdb_chain_0: apply (wp hoare_vcg_imp_lift hoare_vcg_all_lift setUntypedCapAsFull_ctes_of setUntypedCapAsFull_ctes_of_no_0 mdb_inv_preserve_modify_map setUntypedCapAsFull_mdb_chain_0 mdb_inv_preserve_fun_upd | simp del:fun_upd_apply)+ - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply) apply (subgoal_tac "src \ 0") prefer 2 @@ -1882,7 +1879,7 @@ lemma cteInsert_mdb_chunked: apply (wp hoare_vcg_imp_lift hoare_vcg_all_lift setUntypedCapAsFull_ctes_of setUntypedCapAsFull_ctes_of_no_0 mdb_inv_preserve_modify_map setUntypedCapAsFull_mdb_chunked mdb_inv_preserve_fun_upd,simp) - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply) apply (subgoal_tac "src \ 0") prefer 2 @@ -1899,7 +1896,7 @@ lemma cteInsert_mdb_chunked: apply (simp add: nullPointer_def) apply (subgoal_tac "mdb_insert (ctes_of s) src s_cap s_node dest NullCap d_node") apply (drule mdb_insert.chunked_n, erule is_derived_badge_derived') - apply (clarsimp simp: modify_map_apply mdb_chunked_prev_update) + apply (clarsimp simp: modify_map_apply mdb_chunked_prev_update fun_upd_def) apply unfold_locales apply (assumption|rule refl)+ apply (simp add: valid_mdb_ctes_def) @@ -1920,7 +1917,7 @@ lemma cteInsert_untyped_mdb: apply (wp hoare_vcg_imp_lift hoare_vcg_all_lift setUntypedCapAsFull_ctes_of setUntypedCapAsFull_ctes_of_no_0 mdb_inv_preserve_modify_map setUntypedCapAsFull_untyped_mdb' mdb_inv_preserve_fun_upd,simp) - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply) apply (subgoal_tac "src \ 0") prefer 2 @@ -1951,19 +1948,19 @@ lemma cteInsert_untyped_mdb: apply (simp add: mdb_insert_child_def mdb_insert_child_axioms_def) apply (drule mdb_insert_child.untyped_mdb_n) apply (clarsimp simp: modify_map_apply untyped_mdb_prev_update - descendants_of_prev_update) + descendants_of_prev_update fun_upd_def) apply (subgoal_tac "mdb_insert_sib (ctes_of s) src s_cap s_node dest NullCap d_node cap") prefer 2 apply (simp add: mdb_insert_sib_def mdb_insert_sib_axioms_def) apply (drule mdb_insert_sib.untyped_mdb_n) apply (clarsimp simp: modify_map_apply untyped_mdb_prev_update - descendants_of_prev_update) + descendants_of_prev_update fun_upd_def) done lemma valid_mdb_ctes_maskedAsFull: "\valid_mdb_ctes m;m src = Some (CTE s_cap s_node)\ \ valid_mdb_ctes (m(src \ CTE (maskedAsFull s_cap cap) s_node))" - apply (clarsimp simp:fun_upd_apply maskedAsFull_def) + apply (clarsimp simp: maskedAsFull_def) apply (intro conjI impI) apply (frule mdb_inv_preserve_updateCap [where m = m and slot = src and index = "max_free_index (capBlockSize cap)"]) @@ -2033,7 +2030,7 @@ lemma cteInsert_untyped_inc': apply (wp hoare_vcg_imp_lift hoare_vcg_all_lift setUntypedCapAsFull_ctes_of setUntypedCapAsFull_ctes_of_no_0 mdb_inv_preserve_modify_map setUntypedCapAsFull_untyped_mdb' mdb_inv_preserve_fun_upd) - apply (wp getCTE_wp setUntypedCapAsFull_ctes) + apply (wp getCTE_wp setUntypedCapAsFull_ctes)+ apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply) apply (subgoal_tac "src \ 0") prefer 2 @@ -2131,7 +2128,7 @@ lemma cteInsert_irq_control: apply (wp hoare_vcg_imp_lift hoare_vcg_all_lift setUntypedCapAsFull_ctes_of setUntypedCapAsFull_ctes_of_no_0 setUntypedCapAsFull_irq_control mdb_inv_preserve_fun_upd mdb_inv_preserve_modify_map,simp) - apply (wp getCTE_wp) + apply (wp getCTE_wp)+ apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply) apply (subgoal_tac "src \ 0") prefer 2 @@ -2154,7 +2151,7 @@ lemma cteInsert_irq_control: apply (simp add: valid_mdb_ctes_def) apply assumption+ apply (drule mdb_insert_der.irq_control_n) - apply (clarsimp simp: modify_map_apply irq_control_prev_update) + apply (clarsimp simp: modify_map_apply irq_control_prev_update fun_upd_def) done lemma capMaster_isUntyped: @@ -2838,17 +2835,16 @@ lemma setUntypedCapAsFull_if_live_then_nonz_cap': \\rv s. if_live_then_nonz_cap' s\" apply (clarsimp simp:if_live_then_nonz_cap'_def) apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift) - apply (clarsimp simp:setUntypedCapAsFull_def split del:if_splits) - apply (wp hoare_vcg_split_if) + apply (clarsimp simp:setUntypedCapAsFull_def split del: if_split) + apply (wp hoare_vcg_split_if) apply (clarsimp simp:ex_nonz_cap_to'_def cte_wp_at_ctes_of) - apply (wp updateCap_ctes_of_wp) - apply clarsimp - apply (elim allE impE) - apply (assumption) - apply (clarsimp simp:ex_nonz_cap_to'_def cte_wp_at_ctes_of modify_map_def split:if_splits) - apply (rule_tac x = cref in exI) - apply (intro conjI impI) - apply clarsimp+ + apply (wp updateCap_ctes_of_wp)+ + apply clarsimp + apply (elim allE impE) + apply (assumption) + apply (clarsimp simp:ex_nonz_cap_to'_def cte_wp_at_ctes_of modify_map_def split:if_splits) + apply (rule_tac x = cref in exI) + apply (intro conjI impI; clarsimp) done @@ -2861,16 +2857,14 @@ lemma cteInsert_iflive'[wp]: \ cte_wp_at' (\c. cteCap c = NullCap) dest s\ cteInsert cap src dest \\rv. if_live_then_nonz_cap'\" - apply (rule hoare_pre) apply (simp add: cteInsert_def split del: if_split) apply (wp updateCap_iflive' hoare_drop_imps) - apply (clarsimp simp:cte_wp_at_ctes_of) - apply (wp hoare_vcg_conj_lift hoare_vcg_ex_lift hoare_vcg_ball_lift getCTE_wp - setUntypedCapAsFull_ctes_of setUntypedCapAsFull_if_live_then_nonz_cap') + apply (clarsimp simp:cte_wp_at_ctes_of) + apply (wp hoare_vcg_conj_lift hoare_vcg_ex_lift hoare_vcg_ball_lift getCTE_wp + setUntypedCapAsFull_ctes_of setUntypedCapAsFull_if_live_then_nonz_cap')+ apply (clarsimp simp:cte_wp_at_ctes_of) apply (intro conjI) apply (rule_tac x = "case (ctes_of s dest) of Some a \a" in exI) - apply (intro conjI impI) apply (clarsimp) apply (case_tac cte,simp) apply clarsimp+ @@ -3005,7 +2999,7 @@ lemma setCTE_idle [wp]: "\valid_idle'\ setCTE p cte \\rv. valid_idle'\" apply (simp add: valid_idle'_def) apply (rule hoare_lift_Pf [where f="ksIdleThread"]) - apply (wp setCTE_pred_tcb_at') + apply (wp setCTE_pred_tcb_at')+ done crunch it[wp]: getCTE "\s. P (ksIdleThread s)" @@ -3074,7 +3068,7 @@ lemma setCTE_valid_globals[wp]: apply wp apply (clarsimp simp: ran_def valid_cap_sizes'_def) apply metis - apply wp + apply wp+ done lemma updateMDB_global_refs [wp]: @@ -3102,7 +3096,7 @@ crunch arch [wp]: cteInsert "\s. P (ksArchState s)" lemma cteInsert_valid_arch [wp]: "\valid_arch_state'\ cteInsert cap src dest \\rv. valid_arch_state'\" - by (rule valid_arch_state_lift') wp + by (rule valid_arch_state_lift'; wp) lemma cteInsert_valid_irq_handlers'[wp]: "\\s. valid_irq_handlers' s \ (\irq. cap = IRQHandlerCap irq \ irq_issued' irq s)\ @@ -3126,10 +3120,11 @@ done lemma setCTE_valid_mappings'[wp]: "\valid_pde_mappings'\ setCTE x y \\rv. valid_pde_mappings'\" apply (wp valid_pde_mappings_lift' setCTE_typ_at') - apply (simp add: setCTE_def) - apply (rule obj_at_setObject2) - apply (clarsimp simp: updateObject_cte typeError_def in_monad - split: Structures_H.kernel_object.split_asm if_split_asm) + apply (simp add: setCTE_def) + apply (rule obj_at_setObject2) + apply (clarsimp simp: updateObject_cte typeError_def in_monad + split: Structures_H.kernel_object.split_asm if_split_asm) + apply assumption done crunch pde_mappings' [wp]: cteInsert valid_pde_mappings' @@ -3138,13 +3133,14 @@ crunch pde_mappings' [wp]: cteInsert valid_pde_mappings' lemma setCTE_irq_states' [wp]: "\valid_irq_states'\ setCTE x y \\_. valid_irq_states'\" apply (rule valid_irq_states_lift') - apply wp + apply wp apply (simp add: setCTE_def) apply (wp setObject_ksMachine) - apply (simp add: updateObject_cte) - apply (rule hoare_pre) - apply (wp hoare_unless_wp|wpc|simp)+ - apply fastforce + apply (simp add: updateObject_cte) + apply (rule hoare_pre) + apply (wp hoare_unless_wp|wpc|simp)+ + apply fastforce + apply assumption done crunch irq_states' [wp]: cteInsert valid_irq_states' @@ -3273,7 +3269,7 @@ lemma cteInsert_vms'[wp]: pointerInUserData_def) apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift) apply (wp setObject_typ_at_inv setObject_ksMachine updateObject_default_inv | - intro hoare_drop_imp)+ + intro hoare_drop_imp|assumption)+ done crunch pspace_domain_valid[wp]: cteInsert "pspace_domain_valid" @@ -3341,9 +3337,10 @@ crunch tcbPriority_inv[wp]: cteInsert "obj_at' (\tcb. P (tcbPriority tcb (wp: crunch_simps hoare_drop_imps) -lemma cteInsert_ct_idle_or_in_cur_domain'[wp]: "\ ct_idle_or_in_cur_domain' \ cteInsert a b c \ \_. ct_idle_or_in_cur_domain' \" +lemma cteInsert_ct_idle_or_in_cur_domain'[wp]: + "\ ct_idle_or_in_cur_domain' \ cteInsert a b c \ \_. ct_idle_or_in_cur_domain' \" apply (rule ct_idle_or_in_cur_domain'_lift) - apply (wp hoare_vcg_disj_lift) + apply (wp hoare_vcg_disj_lift)+ done lemma setObject_cte_domIdx: @@ -3505,8 +3502,8 @@ lemma cteInsert_invs: and ex_cte_cap_to' dest and (\s. \irq. cap = IRQHandlerCap irq \ irq_issued' irq s)\ cteInsert cap src dest \\rv. invs'\" - apply (rule hoare_pre) apply (simp add: invs'_def valid_state'_def valid_pspace'_def) + (* FIXME: wp_cleanup apply (wp cur_tcb_lift tcb_in_cur_domain'_lift sch_act_wf_lift valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq | simp add: st_tcb_at'_def)+ @@ -3516,6 +3513,11 @@ lemma cteInsert_invs: apply (auto simp: invs'_def valid_state'_def valid_pspace'_def cte_wp_at_ctes_of elim: valid_capAligned is_derived_badge_derived') + *) + apply (wpsimp wp: cur_tcb_lift tcb_in_cur_domain'_lift sch_act_wf_lift CSpace_R.valid_queues_lift + valid_irq_node_lift valid_queues_lift' irqs_masked_lift cteInsert_norq + simp: st_tcb_at'_def) + apply (auto simp: invs'_def valid_state'_def valid_pspace'_def elim: valid_capAligned) done lemma derive_cap_corres: @@ -3528,10 +3530,11 @@ lemma derive_cap_corres: apply (case_tac c) apply (simp_all add: returnOk_def Let_def is_zombie_def isCap_simps split: sum.splits) - apply (rule corres_initial_splitE [OF ensure_no_children_corres]) + apply (rule_tac Q="\_ _. True" and Q'="\_ _. True" in + corres_initial_splitE [OF ensure_no_children_corres]) apply simp apply clarsimp - apply wp + apply wp+ apply clarsimp apply (rule corres_rel_imp) apply (rule corres_guard_imp) @@ -3571,19 +3574,13 @@ lemma capAligned_Null [simp]: lemma guarded_lookup_valid_cap': "\ valid_objs' \ nullCapOnFailure (lookupCap t c) \\rv. valid_cap' rv \" apply (simp add: nullCapOnFailure_def) - apply wp + apply (wp lookup_cap_valid') apply (simp add: valid_cap'_def) - apply (fold validE_R_def) - apply (rule lookup_cap_valid') done lemma setObject_tcb_tcb': "\tcb_at' p\ setObject p (t::tcb) \\rv. tcb_at' p\" - apply (rule obj_at_setObject1) - apply (simp add: updateObject_default_def in_monad) - apply (simp add: projectKOs) - apply (simp add: objBits_simps) - done + by (rule setObject_typ_ats) lemma cte_wp_at'_conjI: "\ cte_wp_at' P p s; cte_wp_at' Q p s \ \ cte_wp_at' (\c. P c \ Q c) p s" @@ -3603,11 +3600,7 @@ lemma lookupSlotForCNodeOp_inv'[wp]: lemma unifyFailure_inv [wp]: "\P\ f \\_. P\, \\_. P\ \ \P\ unifyFailure f \\_. P\, \\_. P\" - unfolding unifyFailure_def - apply (simp add: rethrowFailure_def const_def o_def) - apply wp - apply simp - done + by (rule unifyFailure_wp) (* FIXME: move *) lemma loadWordUser_inv [wp]: @@ -3668,7 +3661,7 @@ lemma lookup_cap_corres: apply (rule getSlotCap_corres, rule refl) apply (rule corres_returnOk [of _ \ \]) apply simp - apply wp + apply wp+ apply auto done @@ -3681,7 +3674,7 @@ lemma ensure_empty_corres: apply (rule corres_split [OF _ get_cap_corres]) apply (rule corres_trivial) apply (case_tac cap, auto simp add: whenE_def returnOk_def)[1] - apply wp + apply wp+ apply (clarsimp simp: invs_valid_objs invs_psp_aligned) apply fastforce done @@ -3708,7 +3701,7 @@ lemma lsfc_corres: apply (clarsimp simp: returnOk_def lookup_failure_map_def split: list.split) apply simp+ - apply wp + apply wp+ apply clarsimp apply clarsimp done @@ -3742,6 +3735,7 @@ lemma deriveCap_derived: deriveCap slot c' \\rv s. rv \ NullCap \ cte_wp_at' (is_derived' (ctes_of s) slot rv \ cteCap) slot s\, -" + including no_pre unfolding deriveCap_def badge_derived'_def apply (cases c'; (wp ensureNoChildren_wp | simp add: isCap_simps Let_def | clarsimp simp: badge_derived'_def vsCapRef_def @@ -3933,7 +3927,7 @@ proof - apply (subst pspace_relations_def[symmetric]) apply (rule corres_underlying_decomposition [OF x]) apply (simp add: ghost_relation_of_heap) - apply (wp hoare_vcg_conj_lift mdb_wp rvk_wp list_wp u abs_irq_together) + apply (wp hoare_vcg_conj_lift mdb_wp rvk_wp list_wp u abs_irq_together)+ apply (intro z[simplified o_def] conjI | simp add: state_relation_def pspace_relations_def swp_cte_at | (clarsimp, drule (1) z(6), simp add: state_relation_def pspace_relations_def swp_cte_at))+ done @@ -4288,12 +4282,11 @@ lemma setupReplyMaster_wps[wp]: \\s. P ((cteCaps_of s)(slot \ (capability.ReplyCap t True))) \ P (cteCaps_of s)\ setupReplyMaster t \\rv s. P (cteCaps_of s)\" - apply (simp_all add: setupReplyMaster_def locateSlot_conv) - apply (wp hoare_drop_imps - | simp add: o_def - | rule hoare_strengthen_post [OF getCTE_sp])+ - apply (clarsimp elim!: rsubst[where P=P] intro!: ext) - apply (clarsimp simp: tcbReplySlot_def objBits_def objBitsKO_def + apply (simp_all add: setupReplyMaster_def locateSlot_conv) + apply (wp getCTE_wp | simp add: o_def cte_wp_at_ctes_of)+ + apply clarsimp + apply (rule_tac x=cte in exI) + apply (clarsimp simp: tcbReplySlot_def objBits_def objBitsKO_def fun_upd_def tcb_cnode_index_def2 cte_map_nat_to_cref cte_level_bits_def) done @@ -4306,7 +4299,7 @@ lemma setupReplyMaster_valid_pspace': \\rv. valid_pspace'\" apply (simp add: valid_pspace'_def) apply (wp setupReplyMaster_valid_mdb) - apply (simp_all add: valid_pspace'_def) + apply (simp_all add: valid_pspace'_def) done lemma setupReplyMaster_ifunsafe'[wp]: @@ -4411,7 +4404,7 @@ lemma setupReplyMaster_vms'[wp]: "\valid_machine_state'\ setupReplyMaster t \\_. valid_machine_state'\" apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def ) apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift) - apply wp + apply wp+ done crunch pspace_domain_valid[wp]: setupReplyMaster "pspace_domain_valid" @@ -4673,6 +4666,7 @@ lemma arch_update_setCTE_ifunsafe: apply (rule hoare_lift_Pf2 [where f=irq_node']) prefer 2 apply wp + apply wp apply (clarsimp simp: cte_wp_at_ctes_of is_arch_update'_def) apply (frule capMaster_same_refs) apply clarsimp @@ -4699,7 +4693,7 @@ lemma setCTE_vms'[wp]: "\valid_machine_state'\ setCTE ptr val \\rv. valid_machine_state'\" apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def ) apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift) - apply wp + apply wp+ done lemma arch_update_setCTE_invs: @@ -4707,8 +4701,7 @@ lemma arch_update_setCTE_invs: setCTE p (cteCap_update (\_. cap) oldcte) \\rv. invs'\" apply (simp add: invs'_def valid_state'_def valid_pspace'_def) - apply (rule hoare_pre) - apply (wp arch_update_setCTE_mdb valid_queues_lift sch_act_wf_lift tcb_in_cur_domain'_lift ct_idle_or_in_cur_domain'_lift + apply (wp arch_update_setCTE_mdb valid_queues_lift sch_act_wf_lift tcb_in_cur_domain'_lift ct_idle_or_in_cur_domain'_lift arch_update_setCTE_iflive arch_update_setCTE_ifunsafe valid_irq_node_lift setCTE_typ_at' setCTE_irq_handlers' valid_queues_lift' setCTE_pred_tcb_at' irqs_masked_lift @@ -4999,27 +4992,27 @@ lemma cins_corres_simple: apply (erule allE)+ apply (erule (1) impE) apply (simp add: nullPointer_def) - apply (rule corres_guard_imp) - apply (rule_tac R="\r. ?P and cte_at dest and + apply (rule corres_guard_imp) + apply (rule_tac R="\r. ?P and cte_at dest and (\s. cte_wp_at (safe_parent_for (cdt s) src c) src s) and cte_wp_at (op = (masked_as_full src_cap c)) src" and R'="\r. ?P' and cte_wp_at' (op = rv') (cte_map dest) and cte_wp_at' (op = (CTE (maskedAsFull (cteCap srcCTE) c') (cteMDBNode srcCTE))) (cte_map src) and (\s. safe_parent_for' (ctes_of s) src' c')" in corres_split[where r'=dc]) - apply (rule corres_stronger_no_failI) - apply (rule no_fail_pre, wp hoare_weak_lift_imp) - apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) - apply (erule_tac valid_dlistEn[where p = "cte_map src"]) - apply (simp+)[3] - apply (clarsimp simp: corres_underlying_def state_relation_def - in_monad valid_mdb'_def valid_mdb_ctes_def) - apply (drule (1) pspace_relationsD) - apply (drule (18) set_cap_not_quite_corres) - apply (rule refl) - apply (elim conjE exE) - apply (rule bind_execI, assumption) - apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") + apply (rule corres_stronger_no_failI) + apply (rule no_fail_pre, wp hoare_weak_lift_imp) + apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) + apply (erule_tac valid_dlistEn[where p = "cte_map src"]) + apply (simp+)[3] + apply (clarsimp simp: corres_underlying_def state_relation_def + in_monad valid_mdb'_def valid_mdb_ctes_def) + apply (drule (1) pspace_relationsD) + apply (drule (18) set_cap_not_quite_corres) + apply (rule refl) + apply (elim conjE exE) + apply (rule bind_execI, assumption) + apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") prefer 2 apply (clarsimp simp: cte_wp_at_caps_of_state valid_mdb_def2) apply (rule mdb_insert_abs.intro) @@ -5114,39 +5107,35 @@ lemma cins_corres_simple: setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for' | clarsimp | wps)+ apply (clarsimp simp:cte_wp_at_caps_of_state ) apply (case_tac rv',clarsimp simp:cte_wp_at_ctes_of maskedAsFull_def) - apply (wp getCTE_wp' get_cap_wp) - apply clarsimp - subgoal by (fastforce elim: cte_wp_at_weakenE) - subgoal by (clarsimp simp: cte_wp_at'_def) - apply (thin_tac "ctes_of s = t" for s t)+ - apply (thin_tac "pspace_relation s t" for s t)+ - apply (thin_tac "machine_state t = s" for t s)+ - apply (case_tac "srcCTE") - apply (rename_tac src_cap' src_node) - apply (case_tac "rv'") - apply (rename_tac dest_node) - apply (clarsimp simp: in_set_cap_cte_at_swp) - apply (subgoal_tac "cte_at src a \ safe_parent_for (cdt a) src c src_cap") - prefer 2 - subgoal by (fastforce simp: cte_wp_at_def safe_parent_for_masked_as_full) - apply (erule conjE) + apply (wp getCTE_wp' get_cap_wp)+ + apply clarsimp + subgoal by (fastforce elim: cte_wp_at_weakenE) + subgoal by (clarsimp simp: cte_wp_at'_def) + apply (thin_tac "ctes_of s = t" for s t)+ + apply (thin_tac "pspace_relation s t" for s t)+ + apply (thin_tac "machine_state t = s" for t s)+ + apply (case_tac "srcCTE") + apply (rename_tac src_cap' src_node) + apply (case_tac "rv'") + apply (rename_tac dest_node) + apply (clarsimp simp: in_set_cap_cte_at_swp) + apply (subgoal_tac "cte_at src a \ safe_parent_for (cdt a) src c src_cap") + prefer 2 + subgoal by (fastforce simp: cte_wp_at_def safe_parent_for_masked_as_full) + apply (erule conjE) - apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node + apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node (cte_map dest) NullCap dest_node") - prefer 2 - apply (rule mdb_insert.intro) - apply (rule mdb_ptr.intro) - apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) - apply (erule mdb_ptr_axioms.intro) + prefer 2 + apply (rule mdb_insert.intro) apply (rule mdb_ptr.intro) - apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) - apply (erule mdb_ptr_axioms.intro) - apply (rule mdb_insert_axioms.intro) - apply (rule refl) - apply assumption - apply assumption - apply assumption - apply assumption + apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) + apply (erule mdb_ptr_axioms.intro) + apply (rule mdb_ptr.intro) + apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) + apply (erule mdb_ptr_axioms.intro; assumption) + apply (rule mdb_insert_axioms.intro; assumption?) + apply (rule refl) apply (erule (5) cte_map_inj) apply (rule conjI) apply (simp (no_asm_simp) add: cdt_relation_def split: if_split) @@ -6428,7 +6417,7 @@ lemma updateCap_same_master: apply(erule_tac x=bb in allE)+ apply(clarsimp split: if_split_asm) apply(case_tac rv, clarsimp) - apply (wp getCTE_wp') + apply (wp getCTE_wp')+ apply clarsimp apply (rule no_fail_pre, wp) apply clarsimp @@ -6465,25 +6454,23 @@ lemma updateCapFreeIndex_valid_mdb_ctes: apply (wp updateCap_ctes_of_wp) apply (subgoal_tac "mdb_inv_preserve (Q (ctes_of s)) (Q (modify_map (ctes_of s) src (cteCap_update (\_. capFreeIndex_update (\_. index) cap))))") - apply (clarsimp simp:valid_mdb_ctes_def) + apply (clarsimp simp:valid_mdb_ctes_def) apply (intro conjI) - apply ((simp add:mdb_inv_preserve.preserve_stuff - mdb_inv_preserve.by_products)+)[7] - apply (rule mdb_inv_preserve.untyped_inc') - apply assumption - apply (clarsimp simp:assoc cte_wp_at_ctes_of) - apply (clarsimp simp:modify_map_def split:if_splits) - apply (drule coin) - apply clarsimp - apply (erule(1) subsetD) - apply simp - apply (simp_all add:mdb_inv_preserve.preserve_stuff - mdb_inv_preserve.by_products) + apply ((simp add:mdb_inv_preserve.preserve_stuff mdb_inv_preserve.by_products)+)[7] + apply (rule mdb_inv_preserve.untyped_inc') + apply assumption + apply (clarsimp simp:assoc cte_wp_at_ctes_of) + apply (clarsimp simp:modify_map_def split:if_splits) + apply (drule coin) + apply clarsimp + apply (erule(1) subsetD) + apply simp + apply (simp_all add:mdb_inv_preserve.preserve_stuff mdb_inv_preserve.by_products) apply (rule preserve) apply (clarsimp simp:cte_wp_at_ctes_of) apply (rule mdb_inv_preserve_updateCap) - apply (clarsimp simp:cte_wp_at_ctes_of)+ -done + apply (clarsimp simp:cte_wp_at_ctes_of)+ + done lemma usableUntypedRange_mono1: "is_aligned ptr sz \ idx \ 2 ^ sz \ idx' \ 2 ^ sz @@ -6543,12 +6530,12 @@ lemma updateFreeIndex_pspace': 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) + split del:if_split) apply (drule_tac x = ptr' in spec) apply (clarsimp simp:ko_wp_at'_def simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff usableUntypedRange.simps - split del:if_splits) + split del:if_split) apply blast apply (rule usableUntypedRange_mono2, auto simp add: isCap_simps capAligned_def valid_cap_simps') @@ -6614,7 +6601,7 @@ lemma updateFreeIndex_forward_invs': apply (rule hoare_vcg_conj_lift) apply (simp add: ifunsafe'_def3 cteInsert_def setUntypedCapAsFull_def split del: if_split) - apply wp + apply wp+ apply (rule hoare_vcg_conj_lift) apply (simp add:updateCap_def) apply wp diff --git a/proof/refine/Detype_R.thy b/proof/refine/Detype_R.thy index 07eaa0813..55f5b5cbe 100644 --- a/proof/refine/Detype_R.thy +++ b/proof/refine/Detype_R.thy @@ -609,7 +609,7 @@ lemma cNodeNoPartialOverlap: apply (clarsimp simp: is_aligned_no_overflow) apply (blast intro: order_trans) apply (simp add: is_aligned_no_overflow power_overflow word_bits_def) - apply wp + apply wp+ done @@ -668,7 +668,7 @@ lemma detype_corres: apply (rule corres_split[OF cNodeNoPartialOverlap]) apply (rule corres_machine_op[OF corres_Id], simp+) apply (rule no_fail_freeMemory, simp+) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply auto[1] apply (auto elim: is_aligned_weaken) apply (rule corres_modify) @@ -1000,22 +1000,21 @@ lemma valid_obj': apply fastforce apply simp apply (rename_tac tcb) - apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def valid_bound_ntfn'_def - split:option.splits)[1] - apply (clarsimp dest!: refs_notRange)+ + apply (case_tac "tcbState tcb"; + clarsimp simp: valid_tcb_state'_def valid_bound_ntfn'_def + dest!: refs_notRange split: option.splits) apply (clarsimp simp: valid_cte'_def) apply (rule_tac p=p in valid_cap2) - apply (clarsimp simp: ko_wp_at'_def objBits_simps - cte_level_bits_def[symmetric]) + apply (clarsimp simp: ko_wp_at'_def objBits_simps cte_level_bits_def[symmetric]) apply (erule(2) cte_wp_at_cteI') apply simp apply (rename_tac arch_kernel_object) apply (case_tac "arch_kernel_object", simp_all) - apply (rename_tac asidpool) + apply (rename_tac asidpool) apply (case_tac asidpool, clarsimp simp: page_directory_at'_def) - apply (rename_tac pte) + apply (rename_tac pte) apply (case_tac pte, simp_all add: valid_mapping'_def) -apply(rename_tac pde) + apply(rename_tac pde) apply (case_tac pde, simp_all add: valid_mapping'_def) done @@ -1887,8 +1886,7 @@ lemma setCTE_pspace_no_overlap': "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\ setCTE cte src \\r. pspace_no_overlap' ptr sz\" - apply (rule pspace_no_overlap'_lift) - apply (wp setCTE_typ_at') + apply (rule pspace_no_overlap'_lift; wp setCTE_typ_at') apply auto done @@ -2492,8 +2490,7 @@ lemma placeNewObject_cte_wp_at'': pspace_aligned' s \ pspace_distinct' s\ placeNewObject ptr val us \\a s. cte_wp_at' P slot s\" apply (simp add:cte_wp_at_cases_mask' obj_at'_real_def) - apply (wp hoare_vcg_disj_lift) - apply (wp placeNewObject_ko_wp_at') + apply (wp hoare_vcg_disj_lift placeNewObject_ko_wp_at') apply (clarsimp simp:conj_comms) apply (intro conjI impI allI impI) apply (drule(4) not_in_new_cap_addrs') @@ -2743,7 +2740,7 @@ lemma setCTE_pde_at': setCTE src cte \\x s. ko_wp_at' (op = (KOArch (KOPDE pde))) ptr s\" apply (clarsimp simp:setCTE_def2) - apply wp + including no_pre apply wp apply (simp add:split_def) apply (clarsimp simp:valid_def) apply (subgoal_tac "b = s") @@ -3183,7 +3180,7 @@ lemma setCTE_gets_globalPD_commute: apply (rule commute_commute[OF monad_commute_split[where Q = "\r. \"]]) apply (clarsimp simp:monad_commute_def gets_def simpler_modify_def bind_def get_def return_def) apply (rule commute_commute[OF locateCTE_commute]) - apply (wp locateCTE_cte_no_fail) + apply (wp locateCTE_cte_no_fail)+ apply clarsimp apply (wp|clarsimp)+ apply fastforce @@ -3222,7 +3219,7 @@ lemma copyGlobalMappings_setCTE_commute: apply (rule mapM_x_commute[where f = id]) apply (rule monad_commute_split[OF _ getPDE_setCTE_commute]) apply (rule storePDE_setCTE_commute) - apply wp + apply wp+ apply clarsimp apply (rule setCTE_gets_globalPD_commute) apply wp @@ -3242,7 +3239,7 @@ lemma setCTE_doMachineOp_commute: apply (rule commute_commute[OF monad_commute_split]) apply (rule doMachineOp_upd_heap_commute) apply (rule commute_commute[OF locateCTE_commute]) - apply (wp nf locateCTE_cte_no_fail) + apply (wp nf locateCTE_cte_no_fail)+ apply clarsimp apply (wp|clarsimp|fastforce)+ done @@ -3432,7 +3429,7 @@ lemma setCTE_modify_tcbDomain_commute: apply (rule hint) apply (rule commute_commute) apply (rule locateCTE_commute) - apply (wp locateCTE_cte_no_fail) + apply (wp locateCTE_cte_no_fail)+ apply (wp threadSet_ko_wp_at2') apply (clarsimp simp:objBitsKO_simps) apply (wp|simp)+ @@ -3537,7 +3534,7 @@ lemma createObject_setCTE_commute: apply (rule setCTE_modify_tcbDomain_commute) apply wp apply (rule curDomain_commute) - apply wp + apply wp+ apply (rule setCTE_placeNewObject_commute) apply (wp placeNewObject_tcb_at' placeNewObject_cte_wp_at' placeNewObject_pspace_distinct' @@ -3787,7 +3784,7 @@ lemma createObject_updateTrackedFreeIndex_commute: apply (rule monad_commute_split[OF _ createObject_getCTE_commute] monad_commute_split[OF _ createObject_gsUntypedZeroRanges_commute] createObject_gsUntypedZeroRanges_commute)+ - apply (wp getCTE_wp') + apply (wp getCTE_wp')+ apply (clarsimp simp: pspace_no_overlap'_def) done @@ -4202,7 +4199,7 @@ lemma objSize_eq_capBits: "Types_H.getObjectSize ty us = APIType_capBits ty us" apply (case_tac ty) apply (clarsimp simp:ARM_H.getObjectSize_def objBits_simps - getObjectSize_def APIType_capBits_def apiGetObjectSize_def ptBits_def + APIType_capBits_def apiGetObjectSize_def ptBits_def tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def cteSizeBits_def pageBits_def pdBits_def split : apiobject_type.splits)+ @@ -4212,19 +4209,20 @@ lemma createNewCaps_ret_len: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" + including no_pre apply (rule hoare_name_pre_state) apply clarsimp apply (case_tac ty) - apply (simp_all add:createNewCaps_def ARM_H.toAPIType_def - ) + apply (simp_all add:createNewCaps_def ARM_H.toAPIType_def) apply (rule hoare_pre) apply wpc - apply (wp|simp add:Arch_createNewCaps_def ARM_H.toAPIType_def + apply ((wp+)|simp add:Arch_createNewCaps_def ARM_H.toAPIType_def unat_of_nat_minus_1 [where 'a=32, folded word_bits_def] | erule hoare_strengthen_post[OF createObjects_ret],clarsimp+ | intro conjI impI)+ apply (rule hoare_pre, - (wp | simp add: Arch_createNewCaps_def toAPIType_def + ((wp+) + | simp add: Arch_createNewCaps_def toAPIType_def ARM_H.toAPIType_def unat_of_nat_minus_1 | erule hoare_strengthen_post[OF createObjects_ret],clarsimp+ | intro conjI impI)+)+ @@ -4561,7 +4559,7 @@ lemma doMachineOp_copyGlobalMapping_commute: apply (rule mapM_x_commute[where f = id]) apply (rule monad_commute_split[OF _ getPDE_doMachineOp_commute]) apply (rule doMachineOp_storePDE_commute) - apply wp + apply wp+ apply clarsimp apply (rule doMachineOp_ksArchState_commute) apply wp @@ -5055,7 +5053,7 @@ proof - -- Untyped apply (simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def pdBits_def - bind_assoc getObjectSize_def ARM_H.getObjectSize_def + bind_assoc ARM_H.getObjectSize_def mapM_def sequence_def Retype_H.createObject_def ARM_H.toAPIType_def createObjects_def ARM_H.createObject_def @@ -5066,7 +5064,7 @@ proof - -- "TCB, EP, NTFN" apply (simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc - getObjectSize_def ARM_H.getObjectSize_def + ARM_H.getObjectSize_def sequence_def Retype_H.createObject_def ARM_H.toAPIType_def createObjects_def ARM_H.createObject_def @@ -5088,7 +5086,7 @@ proof - apply simp apply (subst monad_commute_simple[symmetric]) apply (rule commute_commute[OF curDomain_commute]) - apply wp + apply wp+ apply (rule_tac Q = "\r s. r = (ksCurDomain s) \ pspace_aligned' s \ pspace_distinct' s \ @@ -5138,7 +5136,7 @@ proof - apply simp apply (((simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc - getObjectSize_def ARM_H.getObjectSize_def + ARM_H.getObjectSize_def mapM_def sequence_def Retype_H.createObject_def ARM_H.toAPIType_def createObjects_def ARM_H.createObject_def @@ -5152,7 +5150,7 @@ proof - -- CNode apply (simp add: cteSizeBits_def pageBits_def tcbBlockSizeBits_def epSizeBits_def ntfnSizeBits_def pdBits_def bind_assoc - getObjectSize_def ARM_H.getObjectSize_def + ARM_H.getObjectSize_def mapM_def sequence_def Retype_H.createObject_def ARM_H.toAPIType_def createObjects_def ARM_H.createObject_def @@ -5226,8 +5224,7 @@ proof - | simp add: modify_modify_bind o_def)+)[1] apply (subst monad_eq, rule createObjects_Cons) apply (simp_all add: field_simps shiftl_t2n pageBits_def - getObjectSize_def ARM_H.getObjectSize_def - objBits_simps)[6] + ARM_H.getObjectSize_def objBits_simps)[6] apply (simp add: bind_assoc placeNewObject_def2 objBits_simps ARM_H.getObjectSize_def pageBits_def add.commute append) @@ -5258,8 +5255,7 @@ proof - | simp add: modify_modify_bind o_def)+)[1] apply (subst monad_eq, rule createObjects_Cons) apply (simp_all add: field_simps shiftl_t2n pageBits_def - getObjectSize_def ARM_H.getObjectSize_def - objBits_simps)[6] + ARM_H.getObjectSize_def objBits_simps)[6] apply (simp add: bind_assoc placeNewObject_def2 objBits_simps ARM_H.getObjectSize_def pageBits_def add.commute append) @@ -5290,8 +5286,7 @@ proof - | simp add: modify_modify_bind o_def)+)[1] apply (subst monad_eq, rule createObjects_Cons) apply (simp_all add: field_simps shiftl_t2n pageBits_def - getObjectSize_def ARM_H.getObjectSize_def - objBits_simps)[6] + ARM_H.getObjectSize_def objBits_simps)[6] apply (simp add: bind_assoc placeNewObject_def2 objBits_simps ARM_H.getObjectSize_def pageBits_def add.commute append) @@ -5321,8 +5316,8 @@ proof - ARM_H.createObject_def) apply (subgoal_tac "distinct (map (\n. ptr + (n << 14)) [0.e.((of_nat n)::word32)])") prefer 2 - apply (clarsimp simp:objBits_simps archObjSize_def pdBits_def pageBits_def - getObjectSize_def ARM_H.getObjectSize_def) + apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def pageBits_def + ARM_H.getObjectSize_def) apply (subst upto_enum_word) apply (clarsimp simp:distinct_map) apply (frule range_cover.range_cover_n_le) @@ -5358,10 +5353,9 @@ proof - apply (simp_all add: word_bits_def)[3] apply (subst monad_eq,rule createObjects_Cons) apply ((simp add: field_simps shiftl_t2n pageBits_def archObjSize_def - getObjectSize_def ARM_H.getObjectSize_def pdBits_def + ARM_H.getObjectSize_def pdBits_def objBits_simps ptBits_def)+)[6] - apply (simp add:objBits_simps archObjSize_def pdBits_def pageBits_def - getObjectSize_def ARM_H.getObjectSize_def) + apply (simp add:objBits_simps archObjSize_def pdBits_def pageBits_def ARM_H.getObjectSize_def) apply (simp add:bind_assoc) apply (simp add: placeNewObject_def2[where val = "makeObject::ARM_H.pde",simplified,symmetric]) apply (rule_tac Q = "\r s. valid_arch_state' s \ @@ -5390,7 +5384,7 @@ proof - apply (rule monad_eq_split[where Q = "\ r s. pspace_aligned' s \ pspace_distinct' s \ valid_arch_state' s \ page_directory_at' (ptr + (1 + of_nat n << 14)) s"]) apply (subst doMachineOp_bind) - apply (wp empty_fail_mapM_x empty_fail_cleanCacheRange_PoU) + apply (wp empty_fail_mapM_x empty_fail_cleanCacheRange_PoU)+ apply (simp add:bind_assoc objBits_simps field_simps archObjSize_def shiftL_nat) apply wp apply simp @@ -5435,7 +5429,6 @@ proof - apply simp apply (clarsimp simp:word_bits_def valid_pspace'_def) apply (clarsimp simp:aligned_add_aligned[OF range_cover.aligned] is_aligned_shiftl_self word_bits_def)+ - done qed @@ -5676,7 +5669,7 @@ lemma ArchCreateObject_pspace_no_overlap': apply (frule(1) range_cover_no_0[where p = n]) apply simp apply (subgoal_tac "is_aligned (ptr + (of_nat n << APIType_capBits ty userSize)) - (APIType_capBits ty userSize) ") + (APIType_capBits ty userSize) ") prefer 2 apply (rule aligned_add_aligned[OF range_cover.aligned],assumption) apply (simp add:is_aligned_shiftl_self range_cover_sz') @@ -5698,11 +5691,9 @@ lemma ArchCreateObject_pspace_no_overlap': apply (metis numeral_2_eq_2) apply (simp add:shiftl_t2n field_simps) apply (intro conjI allI) - apply (clarsimp simp:field_simps pageBits_def - pdBits_def - word_bits_conv archObjSize_def ptBits_def - APIType_capBits_def shiftl_t2n objBits_simps - | rule conjI | erule range_cover_le,simp)+ + apply (clarsimp simp: field_simps pageBits_def pdBits_def word_bits_conv archObjSize_def ptBits_def + APIType_capBits_def shiftl_t2n objBits_simps + | rule conjI | erule range_cover_le,simp)+ done lemma to_from_apiTypeD: "toAPIType ty = Some x \ ty = fromAPIType x" @@ -5793,13 +5784,7 @@ lemma createObject_pspace_aligned_distinct': split:ARM_H.object_type.splits apiobject_type.splits) done -lemma APIType_capBits[simp]: "Types_H.getObjectSize a b = APIType_capBits a b" - apply (case_tac a) - apply (clarsimp simp:getObjectSize_def APIType_capBits_def ARM_H.getObjectSize_def - split:apiobject_type.splits simp: - apiGetObjectSize_def tcbBlockSizeBits_def objBits_def objBitsKO_def pdBits_def - epSizeBits_def ntfnSizeBits_def cteSizeBits_def ptBits_def pageBits_def)+ - done +declare objSize_eq_capBits [simp] lemma createNewObjects_Cons: assumes dlength: "length dest < 2 ^ word_bits" diff --git a/proof/refine/DomainTime_R.thy b/proof/refine/DomainTime_R.thy index 6d11734bd..f45ad4097 100644 --- a/proof/refine/DomainTime_R.thy +++ b/proof/refine/DomainTime_R.thy @@ -283,7 +283,6 @@ lemma handleInterrupt_valid_domain_time: apply (rule hoare_pre, (wp | wpc)+) apply (rule_tac Q="\_ s. 0 < ksDomainTime s" in hoare_post_imp, clarsimp) apply wp - apply assumption (* IRQTimer : tick occurs *) (* IRQReserved : trivial *) apply (wp timerTick_valid_domain_time | clarsimp simp: handleReservedIRQ_def @@ -316,6 +315,7 @@ lemma callKernel_domain_time_left: "\ (\s. 0 < ksDomainTime s) and valid_domain_list' and (\s. e \ Interrupt \ ct_running' s) \ callKernel e \\_ s. 0 < ksDomainTime s \" + including no_pre unfolding callKernel_def supply word_neq_0_conv[simp] apply (case_tac "e = Interrupt") diff --git a/proof/refine/Finalise_R.thy b/proof/refine/Finalise_R.thy index 62ce2750d..798587937 100644 --- a/proof/refine/Finalise_R.thy +++ b/proof/refine/Finalise_R.thy @@ -1249,7 +1249,7 @@ lemma emptySlot_ifunsafe'[wp]: apply (rule hoare_pre, rule hoare_use_eq_irq_node'[OF emptySlot_irq_node']) apply (simp add: emptySlot_def case_Null_If) apply (wp opt_return_pres_lift | simp add: o_def)+ - apply (wp getCTE_cteCap_wp clearUntypedFreeIndex_cteCaps_of) + apply (wp getCTE_cteCap_wp clearUntypedFreeIndex_cteCaps_of)+ apply (clarsimp simp: tree_cte_cteCap_eq[unfolded o_def] modify_map_same modify_map_comp[symmetric] @@ -1326,10 +1326,8 @@ lemma deletedIRQHandler_irq_handlers'[wp]: "\\s. valid_irq_handlers' s \ (IRQHandlerCap irq \ ran (cteCaps_of s))\ deletedIRQHandler irq \\rv. valid_irq_handlers'\" - apply (simp add: deletedIRQHandler_def setIRQState_def) + apply (simp add: deletedIRQHandler_def setIRQState_def setInterruptState_def getInterruptState_def) apply wp - apply (simp_all add: setInterruptState_def getInterruptState_def) - apply wp apply (clarsimp simp: valid_irq_handlers'_def irq_issued'_def ran_def cteCaps_of_def) done @@ -1341,8 +1339,7 @@ lemma emptySlot_valid_irq_handlers'[wp]: emptySlot sl opt \\rv. valid_irq_handlers'\" apply (simp add: emptySlot_def case_Null_If) - apply (rule hoare_pre) - apply (wp | wpc)+ + apply (wp | wpc)+ apply (unfold valid_irq_handlers'_def irq_issued'_def) apply (wp getCTE_cteCap_wp clearUntypedFreeIndex_cteCaps_of | wps clearUntypedFreeIndex_ksInterruptState)+ @@ -1351,7 +1348,6 @@ lemma emptySlot_valid_irq_handlers'[wp]: apply auto done -(* Levity: added (20090126 19:32:20) *) declare setIRQState_irq_states' [wp] crunch irq_states' [wp]: emptySlot valid_irq_states' @@ -1525,7 +1521,7 @@ lemma empty_slot_corres: R'="\cte. valid_pspace' and cte_wp_at' (op = cte) (cte_map slot)" in corres_split [OF _ get_cap_corres]) defer - apply (wp get_cap_wp getCTE_wp') + apply (wp get_cap_wp getCTE_wp')+ apply (simp add: cte_wp_at_ctes_of) apply (wp hoare_vcg_imp_lift clearUntypedFreeIndex_valid_pspace') apply fastforce @@ -1539,7 +1535,7 @@ lemma empty_slot_corres: apply (simp only: bind_assoc[symmetric]) apply (rule corres_split'[where r'=dc, OF _ opt_deleted_irq_corres]) defer - apply wp + apply wp+ apply (rule corres_no_failI) apply (rule no_fail_pre, wp static_imp_wp) apply (clarsimp simp: cte_wp_at_ctes_of valid_pspace'_def) @@ -1870,7 +1866,6 @@ lemma isFinal: apply (wp getCTE_wp') apply (cases "mdbPrev (cteMDBNode cte) = nullPointer") apply simp - apply wp apply (clarsimp simp: valid_mdb_ctes_def valid_mdb'_def cte_wp_at_ctes_of) apply (rule conjI, clarsimp simp: nullPointer_def) @@ -1897,7 +1892,6 @@ lemma isFinal: apply simp apply (clarsimp simp: sameObjectAs_def3 isCap_simps) apply simp - apply (wp getCTE_wp') apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb_ctes_def valid_mdb'_def) apply (case_tac cte) @@ -2156,8 +2150,7 @@ lemma final_cap_corres: apply (rule corres_no_failI) apply wp apply (clarsimp simp: in_monad is_final_cap_def simpler_gets_def) - apply (wp isFinalCapability_inv) - apply (rule no_fail_pre, rule no_fail_isFinalCapability[where p="cte_map ptr"]) + apply (wp isFinalCapability_inv)+ apply fastforce done @@ -2263,7 +2256,7 @@ lemma unbindNotification_invs[wp]: irqs_masked_lift setBoundNotification_ct_not_inQ untyped_ranges_zero_lift | clarsimp simp: cteCaps_of_def o_def)+ apply (rule conjI) - apply (clarsimp elim!: obj_atE' valid_objsE' + apply (clarsimp elim!: obj_atE' simp: projectKOs dest!: pred_tcb_at') apply (clarsimp simp: pred_tcb_at' conj_comms) @@ -2490,7 +2483,7 @@ lemma cteDeleteOne_cteCaps_of: apply (wp emptySlot_cteCaps_of) apply (simp add: cteCaps_of_def) apply (wp_once hoare_drop_imps) - apply (wp isFinalCapability_inv getCTE_wp') + apply (wp isFinalCapability_inv getCTE_wp')+ apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of) apply (auto simp: fun_upd_idem fun_upd_def[symmetric] o_def) done @@ -2595,9 +2588,10 @@ lemma unbindNotification_valid_objs'_helper': lemma typ_at'_valid_tcb'_lift: assumes P: "\P T p. \\s. P (typ_at' T p s)\ f \\rv s. P (typ_at' T p s)\" shows "\\s. valid_tcb' tcb s\ f \\rv s. valid_tcb' tcb s\" + including no_pre apply (simp add: valid_tcb'_def) apply (case_tac "tcbState tcb", simp_all add: valid_tcb_state'_def split_def valid_bound_ntfn'_def) - apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P] + apply (wp hoare_vcg_const_Ball_lift typ_at_lifts[OF P] | case_tac "tcbBoundNotification tcb", simp_all)+ done @@ -3088,9 +3082,9 @@ lemma cancelAllIPC_mapM_x_valid_objs': tcbSchedEnqueue t od) q \\_. valid_objs'\" -apply (wp mapM_x_wp' sts_valid_objs') -apply (clarsimp simp: valid_tcb_state'_def) -done + apply (wp mapM_x_wp' sts_valid_objs') + apply (clarsimp simp: valid_tcb_state'_def)+ + done lemma cancelAllIPC_mapM_x_tcbDomain_obj_at': "\obj_at' (\tcb. P (tcbDomain tcb)) t'\ @@ -3286,7 +3280,7 @@ lemma cancelAllSignals_valid_inQ_queues[wp]: apply (rule hoare_seq_ext [OF _ get_ntfn_sp']) apply (case_tac "ntfnObj ntfna", simp_all) apply (wp, simp)+ - apply (wp cancelAllIPC_mapM_x_valid_inQ_queues) + apply (wp cancelAllIPC_mapM_x_valid_inQ_queues)+ apply (simp) done @@ -3309,13 +3303,7 @@ lemma cteDeleteOne_valid_inQ_queues[wp]: cteDeleteOne sl \\_. valid_inQ_queues\" apply (simp add: cteDeleteOne_def unless_def) - apply (wp) - apply (clarsimp) - apply (wp) - apply (fastforce) - apply (wp) - apply (clarsimp) - apply (wp) + apply (wpsimp wp: hoare_drop_imp hoare_vcg_all_lift) done crunch ksCurDomain[wp]: cteDeleteOne "\s. P (ksCurDomain s)" @@ -3329,7 +3317,7 @@ lemma cteDeleteOne_tcbDomain_obj_at': unbindMaybeNotification_tcbDomain_obj_at' | rule hoare_drop_imp | simp add: finaliseCapTrue_standin_def Let_def - split del: if_splits + split del: if_split | wpc)+ apply (clarsimp simp: cte_wp_at'_def) done @@ -3578,7 +3566,7 @@ lemma unbind_notification_corres: apply (rule corres_split[OF _ set_ntfn_corres]) apply (rule sbn_corres) apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits) - apply (wp gbn_wp' gbn_wp) + apply (wp gbn_wp' gbn_wp)+ apply (clarsimp elim!: obj_at_valid_objsE dest!: bound_tcb_at_state_refs_ofD invs_valid_objs simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def @@ -3605,7 +3593,7 @@ lemma unbind_maybe_notification_corres: apply (rule corres_split[OF _ set_ntfn_corres]) apply (rule sbn_corres) apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) - apply (wp get_ntfn_wp getNotification_wp) + apply (wp get_ntfn_wp getNotification_wp)+ apply (clarsimp elim!: obj_at_valid_objsE dest!: bound_tcb_at_state_refs_ofD invs_valid_objs simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def @@ -3668,10 +3656,10 @@ lemma cap_delete_one_corres: apply (rule corres_split [OF _ fast_finalise_corres[where sl=ptr]]) apply (rule empty_slot_corres) apply simp+ - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (wp isFinalCapability_inv | wp_once isFinal[where x="cte_map ptr"])+ apply (rule corres_trivial, simp) - apply (wp get_cap_wp getCTE_wp) + apply (wp get_cap_wp getCTE_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state can_fast_finalise_Null elim!: caps_of_state_valid_cap) apply (clarsimp simp: cte_wp_at_ctes_of) @@ -3722,7 +3710,7 @@ lemma finalise_cap_corres: apply (rule corres_split[OF _ unbind_notification_corres]) apply (clarsimp simp: liftM_def[symmetric] o_def dc_def[symmetric] zbits_map_def) apply (rule suspend_corres) - apply (wp unbind_notification_invs) + apply (wp unbind_notification_invs)+ apply (simp add: valid_cap_def) apply (simp add: valid_cap'_def) apply (simp add: final_matters'_def liftM_def[symmetric] @@ -4037,7 +4025,7 @@ lemma thread_set_all_corresT: apply (clarsimp simp: bspec_split [OF spec [OF z]]) apply fastforce apply (erule e) - apply (simp add: thread_gets_the_all_def, wp) + apply (simp add: thread_gets_the_all_def, wp+) apply clarsimp apply (frule(1) tcb_at_is_etcb_at) apply (clarsimp simp add: tcb_at_def get_etcb_def obj_at_def) @@ -4097,9 +4085,8 @@ lemma cancelAll_ct_not_ksQ_helper: \\rv s. ksCurThread s \ set (ksReadyQueues s p)\" apply (rule mapM_x_inv_wp2, simp) apply (wp) - apply (wps tcbSchedEnqueue_ct') - apply (wp tcbSchedEnqueue_ksQ) - apply (rule hoare_weaken_pre) + apply (wps tcbSchedEnqueue_ct') + apply (wp tcbSchedEnqueue_ksQ) apply (wps setThreadState_ct') apply (wp sts_ksQ') apply (clarsimp) @@ -4113,16 +4100,18 @@ lemma cancelAllIPC_ct_not_ksQ: (is "\?PRE\ _ \\_. ?POST\") apply (simp add: cancelAllIPC_def) apply (wp, wpc, wp) - apply (wps rescheduleRequired_ct') - apply (wp rescheduleRequired_ksQ') - apply (clarsimp simp: forM_x_def) - apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) - apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct']) - apply (wps rescheduleRequired_ct') - apply (wp rescheduleRequired_ksQ') - apply (clarsimp simp: forM_x_def) - apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) - apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct']) + apply (wps rescheduleRequired_ct') + apply (wp rescheduleRequired_ksQ') + apply (clarsimp simp: forM_x_def) + apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) + apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+ + apply (wps rescheduleRequired_ct') + apply (wp rescheduleRequired_ksQ') + apply (clarsimp simp: forM_x_def) + apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) + apply (wp hoare_lift_Pf2 [OF setEndpoint_ksQ setEndpoint_ct'])+ + prefer 2 + apply assumption apply (rule_tac Q="\ep. ?PRE and ko_at' ep epptr" in hoare_post_imp) apply (clarsimp) apply (rule conjI) @@ -4139,13 +4128,15 @@ lemma cancelAllSignals_ct_not_ksQ: \\rv s. ksCurThread s \ set (ksReadyQueues s p)\" (is "\?PRE\ _ \\_. ?POST\") apply (simp add: cancelAllSignals_def) - apply (wp, wpc, wp) - apply (wps rescheduleRequired_ct') - apply (wp rescheduleRequired_ksQ') - apply (clarsimp simp: forM_x_def) - apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) - apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ct']) - apply (wps setNotification_ct', wp) + apply (wp, wpc, wp+) + apply (wps rescheduleRequired_ct') + apply (wp rescheduleRequired_ksQ') + apply clarsimp + apply (wp cancelAll_ct_not_ksQ_helper mapM_x_wp_inv) + apply (wp hoare_lift_Pf2 [OF setNotification_ksQ setNotification_ct']) + apply (wps setNotification_ct', wp) + prefer 2 + apply assumption apply (rule_tac Q="\ep. ?PRE and ko_at' ep ntfnptr" in hoare_post_imp) apply ((clarsimp simp: invs'_def valid_state'_def sch_act_sane_def | drule(1) ct_not_in_ntfnQueue)+)[1] @@ -4257,7 +4248,7 @@ lemma cteDeleteOne_ct_not_ksQ: apply (wp emptySlot_cteCaps_of hoare_lift_Pf2 [OF emptySlot_ksQ emptySlot_ct]) apply (simp add: cteCaps_of_def) apply (wp_once hoare_drop_imps) - apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv) + apply (wp finaliseCapTrue_standin_ct_not_ksQ isFinalCapability_inv)+ apply (clarsimp) done diff --git a/proof/refine/Interrupt_R.thy b/proof/refine/Interrupt_R.thy index 8fc33b6d2..6bdfe7a13 100644 --- a/proof/refine/Interrupt_R.thy +++ b/proof/refine/Interrupt_R.thy @@ -166,15 +166,13 @@ lemma decode_irq_control_corres: apply (cases caps, simp split: list.split) apply (case_tac "\n. length args = Suc (Suc (Suc n))") apply (clarsimp simp: list_all2_Cons1 Let_def split_def liftE_bindE - lookup_target_slot_def lookupTargetSlot_def whenE_rangeCheck_eq length_Suc_conv checkIRQ_def) apply (rule corres_guard_imp) apply (rule whenE_throwError_corres) apply (simp add: minIRQ_def maxIRQ_def) apply (simp add: minIRQ_def ucast_nat_def) apply (simp add: linorder_not_less) - apply (simp add: maxIRQ_def word_le_nat_alt toEnum_of_nat) - + apply (simp add: maxIRQ_def word_le_nat_alt) apply (simp add: ucast_nat_def) apply (rule corres_split_eqr [OF _ is_irq_active_corres]) apply (rule whenE_throwError_corres, simp, simp) @@ -225,8 +223,7 @@ lemma decode_irq_control_valid'[wp]: whenE_throwError_wp | simp add: ARM_H.decodeIRQControlInvocation_def | wpc | wp_once hoare_drop_imps)+ - apply (clarsimp simp: minIRQ_def maxIRQ_def - toEnum_of_nat word_le_nat_alt unat_of_nat) + apply (clarsimp simp: minIRQ_def maxIRQ_def word_le_nat_alt unat_of_nat) done lemma irq_nodes_global_refs: @@ -270,11 +267,11 @@ lemma invoke_irq_handler_corres: \ cte_wp_at (is_derived (cdt s) (a, b) cap) (a, b) s" in hoare_post_imp) apply fastforce - apply (wp cap_delete_one_still_derived) + apply (wp cap_delete_one_still_derived)+ apply (strengthen invs_mdb_strengthen') - apply wp + apply wp+ apply (simp add: conj_comms eq_commute) - apply (wp get_irq_slot_different hoare_drop_imps) + apply (wp get_irq_slot_different hoare_drop_imps)+ apply (clarsimp simp: valid_state_def invs_def) apply (erule cte_wp_at_weakenE, simp add: is_derived_use_interrupt) apply fastforce @@ -282,7 +279,7 @@ lemma invoke_irq_handler_corres: apply (rule corres_split [OF _ get_irq_slot_corres]) apply simp apply (rule cap_delete_one_corres) - apply wp + apply wp+ apply simp+ done @@ -329,12 +326,13 @@ lemma invoke_irq_handler_invs'[wp]: apply (clarsimp simp add: invs'_def valid_state'_def valid_irq_masks'_def valid_machine_state'_def ct_not_inQ_def ct_in_current_domain_ksMachineState) - apply (wp cteInsert_invs) + apply (wp cteInsert_invs)+ apply (strengthen ntfn_badge_derived_enough_strg isnt_irq_handler_strg) - apply (wp cteDeleteOne_other_cap cteDeleteOne_other_cap[unfolded o_def])[1] + apply (wp cteDeleteOne_other_cap cteDeleteOne_other_cap[unfolded o_def]) apply (rename_tac word1 cap word2) apply (simp add: getInterruptState_def getIRQSlot_def locateSlot_conv) apply wp + apply (rename_tac word1 cap word2 s) apply (clarsimp simp: ucast_nat_def) apply (drule_tac irq=word1 in valid_globals_ex_cte_cap_irq) apply clarsimp+ @@ -504,9 +502,9 @@ lemma timerTick_corres: apply (rule corres_split[OF _ domain_time_corres]) apply (rule corres_when,simp) apply (rule rescheduleRequired_corres) - apply (wp hoare_drop_imp) + apply (wp hoare_drop_imp)+ apply (simp add:dec_domain_time_def) - apply wp + apply wp+ apply (simp add:decDomainTime_def) apply wp apply (rule corres_if[where Q = \ and Q' = \]) @@ -531,12 +529,10 @@ lemma timerTick_corres: apply (simp add: sch_act_wf_weak etcb_relation_def time_slice_def timeSlice_def pred_conj_def)+ apply (wp threadSet_timeslice_invs threadSet_valid_queues - threadSet_valid_queues' - threadSet_pred_tcb_at_state) + threadSet_valid_queues' threadSet_pred_tcb_at_state)+ apply (simp add:etcb_relation_def) apply (wp threadSet_timeslice_invs threadSet_valid_queues - threadSet_valid_queues' - threadSet_pred_tcb_at_state) + threadSet_valid_queues' threadSet_pred_tcb_at_state) apply simp apply (wp|wpc|unfold Let_def|simp)+ apply (wp static_imp_wp threadSet_timeslice_invs threadSet_valid_queues threadSet_valid_queues' @@ -548,13 +544,13 @@ lemma timerTick_corres: apply simp apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+ - apply (wp threadGet_wp gts_wp gts_wp') + apply (wp threadGet_wp gts_wp gts_wp')+ apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def) apply (subgoal_tac "is_etcb_at thread s \ tcb_at thread s \ valid_etcbs s \ weak_valid_sched_action s") prefer 2 apply assumption apply clarsimp - apply (wp gts_wp') + apply (wp gts_wp')+ apply (clarsimp simp add:cur_tcb_def valid_sched_def valid_sched_action_def valid_etcbs_def is_tcb_def is_etcb_at_def st_tcb_at_def obj_at_def @@ -605,7 +601,7 @@ apply (rule corres_split) where R="\rv. einvs and valid_cap rv" and R'="\rv. invs' and valid_cap' (cteCap rv)"]) apply (rule corres_split'[where r'=dc]) - apply (case_tac xb, simp_all add: when_False doMachineOp_return )[1] + apply (case_tac xb, simp_all add: doMachineOp_return)[1] apply (clarsimp simp add: when_def doMachineOp_return) apply (rule corres_guard_imp, rule send_signal_corres) apply (clarsimp simp: valid_cap_def valid_cap'_def do_machine_op_bind doMachineOp_bind)+ @@ -614,9 +610,6 @@ apply (rule corres_split) apply ((wp |simp)+) apply clarsimp apply fastforce - - - apply (rule corres_guard_imp) apply (rule corres_split) apply simp @@ -624,17 +617,14 @@ apply (rule corres_split) apply (rule corres_eq_trivial, simp+) apply (rule corres_machine_op) apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+) - apply wp + apply wp+ apply clarsimp apply clarsimp - done lemma invs_ChooseNewThread: "invs' s \ invs' (s\ksSchedulerAction := ChooseNewThread\)" - by (auto simp add: invs'_def valid_state'_def valid_queues'_def - valid_queues_def valid_irq_node'_def cur_tcb'_def - ct_not_inQ_def bitmapQ_defs valid_queues_no_bitmap_def) + by (rule invs'_update_cnt) lemma ksDomainTime_invs[simp]: "invs' (a\ksDomainTime := t\) = invs' a" @@ -705,8 +695,7 @@ lemma updateTimeSlice_sym_refs[wp]: apply (rule ext) apply (subst option.sel) apply (subst fst_conv)+ - apply (clarsimp simp:projectKO_eq option.sel - projectKO_opt_tcb split:Structures_H.kernel_object.splits) + apply (clarsimp simp:projectKO_eq projectKO_opt_tcb split:Structures_H.kernel_object.splits) apply (simp add:objBits_simps) apply (frule_tac s' = s and v' = "(KOTCB (tcbTimeSlice_update (\_. ts') obj))" in ps_clear_updE) @@ -756,7 +745,7 @@ lemma updateTimeSlice_if_unsafe_then_cap'[wp]: threadSet (tcbTimeSlice_update (\_. ts')) thread \\r s. if_unsafe_then_cap' s\" apply (wp threadSet_ifunsafe'T) - apply (simp add:tcb_cte_cases_def) + apply (simp add:tcb_cte_cases_def)+ done lemma updateTimeSlice_valid_idle'[wp]: @@ -851,7 +840,7 @@ lemma timerTick_invs'[wp]: threadSet_valid_objs' threadSet_timeslice_invs | simp)+ apply (wp threadGet_wp) - apply (wp gts_wp') + apply (wp gts_wp')+ apply (clarsimp simp:invs'_def st_tcb_at'_def obj_at'_def valid_state'_def numDomains_def) done diff --git a/proof/refine/Invariants_H.thy b/proof/refine/Invariants_H.thy index 2451811b1..5d66a3d09 100644 --- a/proof/refine/Invariants_H.thy +++ b/proof/refine/Invariants_H.thy @@ -2628,11 +2628,15 @@ lemma typ_at_lift_valid_untyped': apply (drule_tac p = ptr' in koType_obj_range') apply (clarsimp split:if_splits) done -declare capability.splits[split del] -print_attributes + +lemma typ_at_lift_asid_at': + "(\T p. \typ_at' T p\ f \\_. typ_at' T p\) \ \asid_pool_at' p\ f \\_. asid_pool_at' p\" + by assumption + lemma typ_at_lift_valid_cap': assumes P: "\P T p. \\s. P (typ_at' T p s)\ f \\rv s. P (typ_at' T p s)\" shows "\\s. valid_cap' cap s\ f \\rv s. valid_cap' cap s\" + including no_pre apply (simp add: valid_cap'_def) apply wp apply (case_tac cap; @@ -2642,21 +2646,16 @@ lemma typ_at_lift_valid_cap': hoare_vcg_conj_lift [OF typ_at_lift_cte_at']) apply (rename_tac zombie_type nat) apply (case_tac zombie_type; simp) - apply (wp typ_at_lift_tcb' P hoare_vcg_all_lift typ_at_lift_cte') + apply (wp typ_at_lift_tcb' P hoare_vcg_all_lift typ_at_lift_cte')+ apply (rename_tac arch_capability) apply (case_tac arch_capability, simp_all add: P [where P=id, simplified] page_table_at'_def hoare_vcg_prop page_directory_at'_def All_less_Ball split del: if_splits) - apply (wp hoare_vcg_const_Ball_lift P) - apply (wp typ_at_lift_valid_untyped' [OF P]) - apply (wp hoare_vcg_all_lift typ_at_lift_cte' P) + apply (wp hoare_vcg_const_Ball_lift P typ_at_lift_valid_untyped' + hoare_vcg_all_lift typ_at_lift_cte')+ done -lemma typ_at_lift_asid_at': - "(\T p. \typ_at' T p\ f \\_. typ_at' T p\) \ - \asid_pool_at' p\ f \\_. asid_pool_at' p\" - by simp lemma typ_at_lift_valid_irq_node': assumes P: "\P T p. \\s. P (typ_at' T p s)\ f \\rv s. P (typ_at' T p s)\" @@ -3633,3 +3632,4 @@ add_upd_simps "invs' (gsUntypedZeroRanges_update f s) (obj_at'_real_def) declare upd_simps[simp] end + \ No newline at end of file diff --git a/proof/refine/IpcCancel_R.thy b/proof/refine/IpcCancel_R.thy index 29896a6f4..578a77bcf 100644 --- a/proof/refine/IpcCancel_R.thy +++ b/proof/refine/IpcCancel_R.thy @@ -191,7 +191,7 @@ lemma blocked_cancel_ipc_corres: apply simp apply (simp add: ep_relation_def) apply (simp add: valid_tcb_state_def pred_conj_def) - apply (wp weak_sch_act_wf_lift) + apply (wp weak_sch_act_wf_lift)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) @@ -213,7 +213,7 @@ lemma blocked_cancel_ipc_corres: apply (rule sts_corres) apply simp apply (simp add: ep_relation_def) - apply (wp) + apply (wp)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) @@ -239,7 +239,7 @@ lemma blocked_cancel_ipc_corres: apply simp apply (simp add: ep_relation_def) apply (simp add: valid_tcb_state_def pred_conj_def) - apply (wp weak_sch_act_wf_lift) + apply (wp weak_sch_act_wf_lift)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) @@ -261,7 +261,7 @@ lemma blocked_cancel_ipc_corres: apply (rule sts_corres) apply simp apply (simp add: ep_relation_def) - apply (wp) + apply (wp)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) @@ -277,7 +277,7 @@ lemma blocked_cancel_ipc_corres: apply (simp add: projectKOs) apply (auto simp add: valid_obj'_def valid_tcb'_def valid_tcb_state'_def)[1] - apply (wp getEndpoint_wp) + apply (wp getEndpoint_wp)+ apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) apply fastforce @@ -316,15 +316,15 @@ lemma ac_corres: apply (rule sts_corres) apply simp apply (simp add: ntfn_relation_def) - apply (wp) + apply (wp)+ apply (simp add: list_case_If del: dc_simp) apply (rule corres_split [OF _ set_ntfn_corres]) apply (rule sts_corres) apply simp apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv) - apply (wp) + apply (wp)+ apply (simp add: isWaitingNtfn_def ntfn_relation_def) - apply (wp getNotification_wp) + apply (wp getNotification_wp)+ apply (clarsimp simp: conj_comms st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) apply (erule pspace_valid_objsE) @@ -578,7 +578,7 @@ lemma (in delete_one) reply_cancel_ipc_corres: elim: valid_dlistEn dest: invs_mdb') apply (simp add: exs_valid_def gets_def get_def return_def bind_def del: split_paired_Ex split_paired_All) - apply (rule no_fail_pre, wp) + apply (wp) done qed @@ -609,7 +609,7 @@ lemma (in delete_one) cancel_ipc_corres: apply (clarsimp elim!: st_tcb_weakenE) apply (clarsimp elim!: pred_tcb'_weakenE) apply (rule corres_guard_imp [OF ac_corres], simp+) - apply (wp gts_sp[where P="\",simplified]) + apply (wp gts_sp[where P="\",simplified])+ apply (rule hoare_strengthen_post) apply (rule gts_sp'[where P="\"]) apply (clarsimp elim!: pred_tcb'_weakenE) @@ -676,8 +676,10 @@ lemma cancelSignal_invs': setThreadState_ct_not_inQ NTFNSN hoare_vcg_all_lift setNotification_ksQ | simp add: valid_tcb_state'_def list_case_If split del: if_split)+ + prefer 2 + apply assumption apply (rule hoare_strengthen_post) - apply (rule get_ntfn_sp') + apply (rule get_ntfn_sp') apply (clarsimp simp: pred_tcb_at') apply (frule NIQ) apply (clarsimp simp: pred_tcb_at'_def obj_at'_def) @@ -744,9 +746,9 @@ lemma ep_redux_simps3: lemma setEndpoint_pde_mappings'[wp]: "\valid_pde_mappings'\ setEndpoint ptr val \\rv. valid_pde_mappings'\" apply (wp valid_pde_mappings_lift') - apply (simp add: setEndpoint_def) - apply (rule obj_at_setObject2) - apply (clarsimp dest!: updateObject_default_result) + apply (simp add: setEndpoint_def) + apply (rule obj_at_setObject2) + apply (clarsimp dest!: updateObject_default_result)+ done declare setEndpoint_ksMachine [wp] @@ -835,6 +837,8 @@ proof - hoare_vcg_all_lift setNotification_ksQ | simp add: valid_tcb_state'_def split del: if_split | wpc)+ + prefer 2 + apply assumption apply (rule hoare_strengthen_post [OF get_ep_sp']) apply (clarsimp simp: pred_tcb_at' fun_upd_def[symmetric] conj_comms split del: if_split cong: if_cong) @@ -966,28 +970,18 @@ crunch sch_act_not[wp]: cancelSignal, setBoundNotification "sch_act_not t" lemma cancelSignal_tcb_at_runnable': "t \ t' \ \st_tcb_at' runnable' t'\ cancelSignal t ntfnptr \\_. st_tcb_at' runnable' t'\" - (is "_ \ \?PRE\ _ \_\") - apply (simp add: cancelSignal_def) - apply (wp sts_pred_tcb_neq' | wpc | simp)+ - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, fastforce) - apply (wp) - done + unfolding cancelSignal_def + by (wpsimp wp: sts_pred_tcb_neq' hoare_drop_imp) lemma cancelAllIPC_tcb_at_runnable': "\st_tcb_at' runnable' t\ cancelAllIPC epptr \\_. st_tcb_at' runnable' t\" - apply (clarsimp simp add: cancelAllIPC_def) - apply (wp mapM_x_wp [OF _ subset_refl] sts_st_tcb' | wpc | simp)+ - apply (rule_tac Q="\_. st_tcb_at' runnable' t" in hoare_post_imp, simp) - apply (wp) - done + unfolding cancelAllIPC_def + by (wpsimp wp: mapM_x_wp' sts_st_tcb' hoare_drop_imp) lemma cancelAllSignals_tcb_at_runnable': "\st_tcb_at' runnable' t\ cancelAllSignals ntfnptr \\_. st_tcb_at' runnable' t\" - apply (clarsimp simp add: cancelAllSignals_def) - apply (wp mapM_x_wp [OF _ subset_refl] sts_st_tcb' | wpc | simp)+ - apply (rule_tac Q="\_. st_tcb_at' runnable' t" in hoare_post_imp, simp) - apply (wp) - done + unfolding cancelAllSignals_def + by (wpsimp wp: mapM_x_wp' sts_st_tcb' hoare_drop_imp) crunch st_tcb_at'[wp]: unbindNotification, bindNotification, unbindMaybeNotification "st_tcb_at' P p" (wp: threadSet_pred_tcb_no_state ignore: threadSet) @@ -1020,21 +1014,20 @@ lemma (in delete_one_conc_pre) cancelIPC_tcb_at_runnable': apply (case_tac "t'=t") apply (rule_tac B="\st. st_tcb_at' runnable' t and K (runnable' st)" in hoare_seq_ext) - apply(case_tac x) - apply (clarsimp | wp)+ - apply (wpc) - apply (wp sts_pred_tcb_neq' | simp | wpc)+ - apply (clarsimp) - apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) - apply (wp cteDeleteOne_tcb_at_runnable' + apply(case_tac x; wpsimp) + apply (wp sts_pred_tcb_neq' | simp | wpc)+ + apply (clarsimp) + apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) + apply (wp cteDeleteOne_tcb_at_runnable' threadSet_pred_tcb_no_state cancelSignal_tcb_at_runnable' sts_pred_tcb_neq' - | wpc | simp)+ - apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) - apply (wp) - apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) - apply (wp) + | wpc | simp)+ + apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) + apply wp+ + apply (rule_tac Q="\rv. ?PRE" in hoare_post_imp, fastforce) + apply wp + apply assumption done crunch ksCurDomain[wp]: cancelSignal "\s. P (ksCurDomain s)" @@ -1143,7 +1136,7 @@ lemma (in delete_one_conc_pre) cancelIPC_weak_sch_act_wf: cancelIPC t \\rv s. weak_sch_act_wf (ksSchedulerAction s) s\" apply (rule weak_sch_act_wf_lift_linear) - apply (wp cancelIPC_sch_act_not cancelIPC_tcb_in_cur_domain' cancelIPC_tcb_at_runnable') + apply (wp cancelIPC_sch_act_not cancelIPC_tcb_in_cur_domain' cancelIPC_tcb_at_runnable')+ done text {* The suspend operation, significant as called from delete *} @@ -1159,10 +1152,10 @@ lemma sts_weak_sch_act_wf[wp]: \ (ksSchedulerAction s = SwitchToThread t \ runnable' st)\ setThreadState st t \\_ s. weak_sch_act_wf (ksSchedulerAction s) s\" + including no_pre apply (simp add: setThreadState_def) apply (wp rescheduleRequired_weak_sch_act_wf) - apply (rule_tac Q="\_ s. weak_sch_act_wf (ksSchedulerAction s) s" - in hoare_post_imp, simp) + apply (rule_tac Q="\_ s. weak_sch_act_wf (ksSchedulerAction s) s" in hoare_post_imp, simp) apply (simp add: weak_sch_act_wf_def) apply (wp hoare_vcg_all_lift) apply (wps threadSet_nosch) @@ -1210,14 +1203,12 @@ lemma setNotification_weak_sch_act_wf[wp]: "\\s. weak_sch_act_wf (ksSchedulerAction s) s\ setNotification ntfnptr ntfn \\_ s. weak_sch_act_wf (ksSchedulerAction s) s\" -apply (wp hoare_vcg_all_lift hoare_convert_imp - hoare_vcg_conj_lift - | simp add: setNotification_def weak_sch_act_wf_def st_tcb_at'_def - tcb_in_cur_domain'_def)+ -apply (rule hoare_pre) -apply (wps setObject_ntfn_cur_domain) -apply (wp setObject_ntfn_obj_at'_tcb | simp)+ -done + apply (wp hoare_vcg_all_lift hoare_convert_imp hoare_vcg_conj_lift + | simp add: setNotification_def weak_sch_act_wf_def st_tcb_at'_def tcb_in_cur_domain'_def)+ + apply (rule hoare_pre) + apply (wps setObject_ntfn_cur_domain) + apply (wp setObject_ntfn_obj_at'_tcb | simp add: o_def)+ + done lemmas ipccancel_weak_sch_act_wfs = weak_sch_act_wf_lift[OF _ setCTE_pred_tcb_at'] @@ -1228,12 +1219,12 @@ lemma tcbSchedDequeue_corres': apply (rule corres_symb_exec_r[OF _ _ threadGet_inv, where Q'="\rv. tcb_at' t and valid_inQ_queues and obj_at' (\obj. tcbQueued obj = rv) t"]) defer apply (wp threadGet_obj_at', simp, simp) - apply (rule no_fail_pre, wp, simp) + apply (wp, simp) apply (case_tac queued) defer apply (simp add: unless_def when_def) apply (rule corres_no_failI) - apply (rule no_fail_pre, wp) + apply (wp) apply (clarsimp simp: in_monad ethread_get_def get_etcb_def set_tcb_queue_def is_etcb_at_def state_relation_def gets_the_def gets_def get_def return_def bind_def assert_opt_def get_tcb_queue_def modify_def put_def) apply (subgoal_tac "t \ set (ready_queues a (tcb_domain y) (tcb_priority y))") prefer 2 @@ -1464,12 +1455,12 @@ lemma tcbSchedDequeue_notksQ: \\_ s. t' \ set(ksReadyQueues s p)\" apply (simp add: tcbSchedDequeue_def removeFromBitmap_conceal_def[symmetric]) apply wp - apply (rule hoare_pre_post, assumption) - apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) - apply wp - apply clarsimp - apply (rule_tac Q="\_ s. t' \ set(ksReadyQueues s p)" in hoare_post_imp) - apply (wp | clarsimp)+ + apply (rule hoare_pre_post, assumption) + apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) + apply wp+ + apply clarsimp + apply (rule_tac Q="\_ s. t' \ set(ksReadyQueues s p)" in hoare_post_imp) + apply (wp | clarsimp)+ done lemma rescheduleRequired_oa_queued: @@ -1480,6 +1471,7 @@ lemma rescheduleRequired_oa_queued: apply (simp add: rescheduleRequired_def sch_act_simple_def) apply (rule_tac B="\rv s. (rv = ResumeCurrentThread \ rv = ChooseNewThread) \ ?OAQ t' p s" in hoare_seq_ext) + including no_pre apply (wp | clarsimp)+ apply (case_tac x) apply (wp | clarsimp)+ @@ -1526,11 +1518,11 @@ lemma tcbSchedDequeue_ksQ_distinct[wp]: \\_ s. distinct (ksReadyQueues s p)\" apply (simp add: tcbSchedDequeue_def removeFromBitmap_conceal_def[symmetric]) apply wp - apply (rule hoare_pre_post, assumption) - apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) - apply wp - apply (rule_tac Q="\_ s. distinct (ksReadyQueues s p)" in hoare_post_imp) - apply (clarsimp | wp)+ + apply (rule hoare_pre_post, assumption) + apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) + apply wp+ + apply (rule_tac Q="\_ s. distinct (ksReadyQueues s p)" in hoare_post_imp) + apply (clarsimp | wp)+ done lemma sts_valid_queues_partial: @@ -1555,6 +1547,7 @@ lemma sts_valid_queues_partial: pred_tcb_at'_def obj_at'_def inQ_def) apply (rule hoare_vcg_all_lift)+ apply (rule hoare_convert_imp) + including no_pre apply (wp sts_ksQ setThreadState_oa_queued hoare_impI sts_pred_tcb_neq' | clarsimp)+ apply (rule_tac Q="\s. \d p. ?DISTINCT d p s \ sch_act_simple s" in hoare_pre_imp) @@ -1575,9 +1568,9 @@ lemma tcbSchedDequeue_t_notksQ: apply (wp tcbSchedDequeue_notksQ)[1] apply (simp add: tcbSchedDequeue_def removeFromBitmap_conceal_def[symmetric]) apply wp - apply (rule hoare_pre_post, assumption) - apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) - apply (wp threadGet_wp) + apply (rule hoare_pre_post, assumption) + apply (clarsimp simp: bitmap_fun_defs removeFromBitmap_conceal_def, wp, clarsimp) + apply (wp threadGet_wp)+ apply (auto simp: obj_at'_real_def ko_wp_at'_def) done @@ -1604,6 +1597,7 @@ lemma tcbSchedDequeue_valid_queues_partial: in hoare_post_imp) apply (fastforce simp: Invariants_H.valid_queues_def valid_queues_no_bitmap_def pred_tcb_at'_def obj_at'_def inQ_def) + including no_pre apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift) apply (case_tac "t'=t") apply (clarsimp) @@ -1617,7 +1611,7 @@ lemma tcbSchedDequeue_valid_queues_partial: apply (wp threadGet_wp)+ apply (rule hoare_pre_post, assumption) apply (clarsimp simp: removeFromBitmap_conceal_def bitmap_fun_defs, wp, clarsimp) - apply (wp threadGet_wp) + apply (wp threadGet_wp)+ apply (fastforce simp: obj_at'_real_def ko_wp_at'_def) done qed @@ -1750,11 +1744,10 @@ lemma tcbSchedDequeue_invs'_no_valid_queues: tcbSchedDequeue t \\_. invs' \" apply (simp add: invs'_def valid_state'_def) - apply (rule hoare_pre) - apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift - valid_irq_node_lift valid_irq_handlers_lift' - tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift - untyped_ranges_zero_lift + apply (wp tcbSchedDequeue_valid_queues_weak valid_irq_handlers_lift + valid_irq_node_lift valid_irq_handlers_lift' + tcbSchedDequeue_irq_states irqs_masked_lift cur_tcb_lift + untyped_ranges_zero_lift | clarsimp simp add: cteCaps_of_def valid_queues_def o_def)+ apply (rule conjI) apply (fastforce simp: obj_at'_def inQ_def st_tcb_at'_def valid_queues_no_bitmap_except_def) @@ -1845,13 +1838,13 @@ lemma cancelSignal_queues[wp]: cancelSignal t ae \\_. Invariants_H.valid_queues \" apply (simp add: cancelSignal_def) apply (wp sts_valid_queues) - apply (rule_tac Q="\_ s. \p. t \ set (ksReadyQueues s p)" in hoare_post_imp, simp) - apply (wp hoare_vcg_all_lift) - apply (wpc) - apply (wp) - apply (rule_tac Q="\_ s. Invariants_H.valid_queues s \ (\p. t \ set (ksReadyQueues s p))" in hoare_post_imp) - apply (clarsimp) - apply (wp) + apply (rule_tac Q="\_ s. \p. t \ set (ksReadyQueues s p)" in hoare_post_imp, simp) + apply (wp hoare_vcg_all_lift) + apply (wpc) + apply (wp)+ + apply (rule_tac Q="\_ s. Invariants_H.valid_queues s \ (\p. t \ set (ksReadyQueues s p))" in hoare_post_imp) + apply (clarsimp) + apply (wp) apply (clarsimp) done @@ -1957,11 +1950,9 @@ lemma tcbSchedEnqueue_ksQset_weak: lemma sts_ksQset_weak: "\\s. t' \ set (ksReadyQueues s p)\ setThreadState st t - \\_ s. t' \ set (ksReadyQueues s p)\" (is "\?PRE\ _ \_\") + \\_ s. t' \ set (ksReadyQueues s p)\" apply (simp add: setThreadState_def rescheduleRequired_def) - apply (wp tcbSchedEnqueue_ksQset_weak | wpc | clarsimp)+ - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply (wp) + apply (wpsimp wp: tcbSchedEnqueue_ksQset_weak hoare_drop_imp) done lemma tcbSchedEnqueue_sch_act_not_ct[wp]: @@ -1998,7 +1989,7 @@ lemma ep_cancel_corres_helper: apply simp apply (simp add: valid_tcb_state_def) apply simp - apply (wp sts_valid_queues) + apply (wp sts_valid_queues)+ apply (force simp: tcb_at_is_etcb_at) apply (fastforce elim: obj_at'_weakenE) apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1] @@ -2143,10 +2134,11 @@ proof - by (rule hoare_strengthen_post [OF rescheduleRequired_notresume], simp) show ?thesis apply (simp add: setThreadState_def) - apply (wp hoare_vcg_imp_lift [OF nrct]) - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp) - apply (clarsimp) - apply (rule hoare_convert_imp [OF threadSet_no_sa threadSet_ksCurThread]) + apply (wpsimp wp: hoare_vcg_imp_lift [OF nrct]) + apply (rule_tac Q="\_. ?PRE" in hoare_post_imp) + apply (clarsimp) + apply (rule hoare_convert_imp [OF threadSet_no_sa threadSet_ct]) + apply assumption done qed @@ -2346,6 +2338,8 @@ lemma cancelAllIPC_invs'[wp]: valid_irq_node_lift ssa_invs' sts_sch_act' irqs_masked_lift | simp only: sch_act_wf.simps forM_x_def | simp)+ + prefer 2 + apply assumption apply (rule hoare_strengthen_post [OF get_ep_sp']) apply (clarsimp simp: invs'_def valid_state'_def valid_ep'_def) apply (frule obj_at_valid_objs', fastforce) @@ -2436,8 +2430,7 @@ lemma cancelAllSignals_valid_objs'[wp]: sts_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift | simp)+ apply (simp add: valid_tcb_state'_def) - apply (rule hoare_pre, - wp set_ntfn_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift) + apply (wp set_ntfn_valid_objs' hoare_vcg_all_lift hoare_vcg_const_imp_lift) apply clarsimp apply (frule(1) ko_at_valid_objs') apply (simp add: projectKOs) @@ -2577,11 +2570,12 @@ lemma cancelAllSignals_unlive: apply (fastforce simp: obj_at'_real_def projectKOs dest: obj_at_conj' elim: ko_wp_at'_weakenE) + including no_pre apply (wp rescheduleRequired_unlive) apply (wp cancelAll_unlive_helper) - apply (wp mapM_x_wp' setObject_ko_wp_at' hoare_vcg_const_Ball_lift, + apply ((wp mapM_x_wp' setObject_ko_wp_at' hoare_vcg_const_Ball_lift)+, simp_all add: objBits_simps, simp_all) - apply (fold setNotification_def, wp) + apply (fold setNotification_def, wp) apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs) apply (simp add: projectKOs projectKO_opt_tcb) apply (fastforce simp: ko_wp_at'_def valid_obj'_def valid_ntfn'_def @@ -2708,7 +2702,7 @@ lemma cancel_badged_sends_corres: apply (rule corres_split [OF rescheduleRequired_corres]) apply (rule set_ep_corres) apply (simp split: list.split add: ep_relation_def) - apply (wp weak_sch_act_wf_lift_linear) + apply (wp weak_sch_act_wf_lift_linear)+ apply (rule_tac S="op =" and Q="\xs s. (\x \ set xs. (epptr, TCBBlockedSend) \ state_refs_of s x) \ distinct xs \ valid_etcbs s" and Q'="\xs s. (\x \ set xs. tcb_at' x s) \ weak_sch_act_wf (ksSchedulerAction s) s \ Invariants_H.valid_queues s \ valid_queues' s \ valid_objs' s" @@ -2724,9 +2718,9 @@ lemma cancel_badged_sends_corres: apply (rule corres_split[OF _ tcbSchedEnqueue_corres]) apply (rule corres_trivial) apply simp - apply wp + apply wp+ apply simp - apply (wp sts_valid_queues gts_st_tcb_at) + apply (wp sts_valid_queues gts_st_tcb_at)+ apply (clarsimp simp: valid_tcb_state_def tcb_at_def st_tcb_def2 st_tcb_at_refs_of_rev dest!: state_refs_of_elemD elim!: tcb_at_is_etcb_at[rotated]) @@ -2760,10 +2754,11 @@ lemma suspend_unqueued: "\\\ suspend t \\rv. obj_at' (Not \ tcbQueued) t\" apply (simp add: suspend_def unless_def tcbSchedDequeue_def) apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift) - apply (simp add: threadGet_def| wp getObject_tcb_wp)+ - apply (rule hoare_strengthen_post, rule hoare_post_taut) - apply (fastforce simp: obj_at'_def projectKOs) - apply (rule hoare_post_taut) + apply (simp add: threadGet_def| wp getObject_tcb_wp)+ + apply (rule hoare_strengthen_post, rule hoare_post_taut) + apply (fastforce simp: obj_at'_def projectKOs) + apply (rule hoare_post_taut) + apply (rule TrueI) done end diff --git a/proof/refine/Ipc_R.thy b/proof/refine/Ipc_R.thy index 94bc5c6d3..f908e3a86 100644 --- a/proof/refine/Ipc_R.thy +++ b/proof/refine/Ipc_R.thy @@ -57,11 +57,10 @@ lemma lsfco_cte_at': apply (rule conjI) prefer 2 apply clarsimp - apply (rule hoare_pre, wp) + apply (wp) apply (clarsimp simp: split_def unlessE_def split del: if_split) - apply (rule hoare_pre, wp hoare_drop_imps throwE_R) - apply simp + apply (wp hoare_drop_imps throwE_R) done declare unifyFailure_wp [wp] @@ -129,7 +128,7 @@ lemma load_ct_corres: apply (rule corres_split [OF _ load_word_corres]) apply (rule_tac P=\ and P'=\ in corres_inst) apply (clarsimp simp: ct_relation_def) - apply (wp no_irq_loadWord) + apply (wp no_irq_loadWord)+ apply simp apply (simp add: conj_comms) apply safe @@ -195,7 +194,7 @@ lemma get_rs_cte_at'[wp]: apply simp apply (rule getCTE_wp) apply (simp add: cte_wp_at_ctes_of cong: conj_cong) - apply wp + apply wp+ apply simp done @@ -212,7 +211,7 @@ lemma get_rs_real_cte_at'[wp]: apply simp apply (wp hoare_drop_imps)[1] apply simp - apply (wp lookup_cap_valid') + apply (wp lookup_cap_valid')+ apply simp done @@ -248,7 +247,7 @@ lemma get_extra_cptrs_corres: apply (simp add: word_size_def word_size field_simps msg_max_length_def msgMaxLength_def wordSize_def wordBits_def msgLengthBits_def max_ipc_words word_less_nat_alt) - apply wp + apply wp+ apply (simp add: map_Suc_upt[symmetric] upt_lhs_sub_map[where x=msg_max_length] upto_enum_step_def upto_enum_def unat_minus_one unat_gt_0 list_all2_map2 list_all2_map1 @@ -540,7 +539,7 @@ next apply (wp valid_case_option_post_wp hoare_vcg_const_Ball_lift cteInsert_valid_pspace | simp add: split_def)+ - apply (wp cteInsert_weak_cte_wp_at hoare_valid_ipc_buffer_ptr_typ_at') + apply (wp cteInsert_weak_cte_wp_at hoare_valid_ipc_buffer_ptr_typ_at')+ apply (wp hoare_vcg_const_Ball_lift cteInsert_cte_wp_at valid_case_option_post_wp | simp add:split_def)+ apply (rule corres_whenE) @@ -549,7 +548,7 @@ next apply (case_tac mi, simp) apply simp apply (unfold whenE_def) - apply wp + apply wp+ apply (clarsimp simp: conj_comms ball_conj_distrib split del: if_split) apply (rule_tac Q' ="\cap' s. (cap'\ cap.NullCap \ cte_wp_at (is_derived (cdt s) (a, b) cap') (a, b) s @@ -561,7 +560,7 @@ next apply (subst imp_conjR) apply (rule hoare_vcg_conj_liftE_R) apply (rule derive_cap_is_derived) - apply (wp derive_cap_is_derived_foo) + apply (wp derive_cap_is_derived_foo)+ apply (simp split del: if_split) apply (rule_tac Q' ="\cap' s. (cap'\ capability.NullCap \ cte_wp_at' (\c. is_derived' (ctes_of s) (cte_map (a, b)) cap' (cteCap c)) (cte_map (a, b)) s @@ -748,10 +747,10 @@ lemma transferCapsToSlots_presM: apply (rule cteInsert_assume_Null) apply (wp x hoare_vcg_const_Ball_lift cteInsert_cte_cap_to' static_imp_wp) apply (rule cteInsert_weak_cte_wp_at2,clarsimp) - apply (wp hoare_vcg_const_Ball_lift static_imp_wp) + apply (wp hoare_vcg_const_Ball_lift static_imp_wp)+ apply (rule cteInsert_weak_cte_wp_at2,clarsimp) apply (wp hoare_vcg_const_Ball_lift cteInsert_cte_wp_at static_imp_wp - deriveCap_derived_foo) + deriveCap_derived_foo)+ apply (thin_tac "\slots. PROP P slots" for P) apply (clarsimp simp: cte_wp_at_ctes_of remove_rights_def real_cte_tcb_valid if_apply_def2 @@ -899,6 +898,7 @@ lemma deriveCap_not_idle [wp]: deriveCap slot cap \\rv s. ksIdleThread s \ capRange rv\, -" unfolding deriveCap_def badge_derived'_def + including no_pre apply (cases cap, simp_all add: isCap_simps Let_def) defer 8 (* arch *) apply (wp ensureNoChildren_wp | clarsimp simp: capRange_def)+ @@ -940,7 +940,7 @@ crunch valid_arch_state' [wp]: setExtraBadge valid_arch_state' lemma transferCapsToSlots_valid_arch [wp]: "\valid_arch_state'\ transferCapsToSlots ep buffer n caps slots mi \\rv. valid_arch_state'\" - by (rule transferCapsToSlots_pres1) wp + by (rule transferCapsToSlots_pres1; wp) crunch valid_global_refs' [wp]: setExtraBadge valid_global_refs' @@ -995,8 +995,9 @@ crunch irq_state' [wp]: setExtraBadge "\s. P (ksInterruptState s)" lemma setExtraBadge_irq_states'[wp]: "\valid_irq_states'\ setExtraBadge buffer b n \\_. valid_irq_states'\" apply (wp valid_irq_states_lift') - apply (simp add: setExtraBadge_def storeWordUser_def) - apply (wp no_irq dmo_lift' no_irq_storeWord) + apply (simp add: setExtraBadge_def storeWordUser_def) + apply (wp no_irq dmo_lift' no_irq_storeWord) + apply assumption done lemma transferCapsToSlots_irq_states' [wp]: @@ -1114,9 +1115,8 @@ lemma transferCapsToSlots_invs[wp]: transferCapsToSlots ep buffer n caps slots mi \\rv. invs'\" apply (simp add: invs'_def valid_state'_def) - apply (rule hoare_pre) - apply (wp valid_irq_node_lift) - apply auto + apply (wp valid_irq_node_lift) + apply fastforce done lemma set_extra_badges_flags_eq: @@ -1370,11 +1370,12 @@ lemmas copyMRs_typ_at_lifts[wp] = typ_at_lifts [OF copyMRs_typ_at'] lemma copy_mrs_invs'[wp]: "\ invs' and tcb_at' s and tcb_at' r \ copyMRs s sb r rb n \\rv. invs' \" - apply (simp add: copyMRs_def) + including no_pre + apply (simp add: copyMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord| - simp add: split_def)+ + simp add: split_def) apply (case_tac sb, simp_all)[1] - apply wp + apply wp+ apply (case_tac rb, simp_all)[1] apply (wp mapM_wp dmo_invs' no_irq_mapM no_irq_storeWord no_irq_loadWord) apply blast @@ -1494,14 +1495,14 @@ lemma getMessageInfo_msgExtraCaps[wp]: "\\\ getMessageInfo t \\rv s. unat (msgExtraCaps rv) \ msgMaxExtraCaps\" apply (simp add: getMessageInfo_def) apply wp - apply (simp add: messageInfoFromWord_def Let_def msgMaxExtraCaps_def - shiftL_nat) - apply (subst nat_le_Suc_less_imp) - apply (rule unat_less_power) - apply (simp add: word_bits_def msgExtraCapBits_def) - apply (rule and_mask_less'[unfolded mask_2pm1]) - apply (simp add: msgExtraCapBits_def) - apply wp + apply (simp add: messageInfoFromWord_def Let_def msgMaxExtraCaps_def + shiftL_nat) + apply (subst nat_le_Suc_less_imp) + apply (rule unat_less_power) + apply (simp add: word_bits_def msgExtraCapBits_def) + apply (rule and_mask_less'[unfolded mask_2pm1]) + apply (simp add: msgExtraCapBits_def) + apply wp+ done lemma lcs_corres: @@ -1518,7 +1519,7 @@ lemma lcs_corres: apply (rule corres_split[OF _ getSlotCap_corres]) apply (rule corres_returnOkTT, simp) apply simp - apply wp + apply wp+ apply (rule corres_rel_imp, rule lookup_slot_corres) apply (simp add: split_def) apply (wp | simp add: liftE_bindE[symmetric])+ @@ -1624,7 +1625,7 @@ lemma do_normal_transfer_corres: apply (rule corres_split_catch) apply (rule corres_trivial, simp) apply (rule lec_corres, simp+) - apply wp + apply wp+ apply (rule corres_trivial, simp) apply simp apply (rule corres_split_eqr [OF _ copy_mrs_corres]) @@ -1730,7 +1731,7 @@ lemma make_arch_fault_msg_corres: apply (rule corres_guard_imp) apply (rule corres_split_eqr[OF _ getRestartPCs_corres]) apply (rule corres_trivial, simp add: arch_fault_map_def) - apply (wp, auto) + apply (wp+, auto) done lemma mk_ft_msg_corres: @@ -1999,12 +2000,9 @@ crunch irqs_masked'[wp]: doIPCTransfer "irqs_masked'" lemma doIPCTransfer_invs[wp]: "\invs' and tcb_at' s and tcb_at' r\ doIPCTransfer s ep bg grt r - \\rv. invs'\" (is "valid ?P _ _") + \\rv. invs'\" apply (simp add: doIPCTransfer_def) - apply (wp |wpc)+ - apply (rule_tac Q="\_. ?P" in hoare_strengthen_post, wp) - apply simp - apply wp + apply (wpsimp wp: hoare_drop_imp) done crunch nosch[wp]: doIPCTransfer "\s. P (ksSchedulerAction s)" @@ -2384,12 +2382,12 @@ lemma do_reply_transfer_corres: apply (erule cte_wp_at_weakenE) apply (fastforce) apply (clarsimp simp:is_cap_simps) - apply (wp weak_valid_sched_action_lift) + apply (wp weak_valid_sched_action_lift)+ apply (rule_tac Q="\_. valid_queues' and valid_objs' and cur_tcb' and tcb_at' receiver and (\s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp, simp add: sch_act_wf_weak) apply (wp tcb_in_cur_domain'_lift) defer apply (simp) - apply (wp) + apply (wp)+ apply (clarsimp) apply (rule conjI, erule invs_valid_objs) apply (rule conjI, clarsimp)+ @@ -2511,13 +2509,13 @@ lemma setup_caller_corres: apply (rule_tac Q="\rv. cte_at' (receiver + 2 ^ cte_level_bits * tcbCallerSlot)" in valid_prove_more) - apply (wp, wp getSlotCap_wp) + apply (wp, (wp getSlotCap_wp)+) apply blast apply (rule no_fail_pre, wp) apply (clarsimp simp: cte_wp_at'_def cte_at'_def) apply (rule_tac Q="\rv. cte_at' (sender + 2 ^ cte_level_bits * tcbReplySlot)" in valid_prove_more) - apply (wp, wp getCTE_wp') + apply (wp, (wp getCTE_wp')+) apply blast apply (rule no_fail_pre, wp) apply (clarsimp simp: cte_wp_at_ctes_of) @@ -2653,7 +2651,7 @@ proof - apply (rule set_ep_corres) apply (simp add: ep_relation_def) apply (simp add: fault_rel_optionation_def) - apply wp + apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def) apply clarsimp -- "concludes IdleEP if bl branch" @@ -2663,7 +2661,7 @@ proof - apply (rule set_ep_corres) apply (simp add: ep_relation_def) apply (simp add: fault_rel_optionation_def) - apply wp + apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def) apply clarsimp -- "concludes SendEP if bl branch" @@ -2715,19 +2713,19 @@ proof - apply (strengthen weak_sch_act_wf) apply (simp add: valid_tcb_state'_def) apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift hoare_drop_imps)[1] - apply (wp gts_st_tcb_at) + apply (wp gts_st_tcb_at)+ apply (simp add: ep_relation_def split: list.split) apply (simp add: pred_conj_def cong: conj_cong) apply (wp hoare_post_taut) apply (simp) - apply (wp weak_sch_act_wf_lift_linear set_ep_valid_objs' setEndpoint_valid_mdb') + apply (wp weak_sch_act_wf_lift_linear set_ep_valid_objs' setEndpoint_valid_mdb')+ apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def ep_redux_simps ep_redux_simps' st_tcb_at_tcb_at valid_ep_def cong: list.case_cong) apply (drule(1) sym_refs_obj_atD[where P="\ob. ob = e" for e]) apply (clarsimp simp: st_tcb_at_refs_of_rev st_tcb_at_reply_cap_valid st_tcb_at_caller_cap_null) apply (fastforce simp: st_tcb_def2 valid_sched_def valid_sched_action_def) subgoal by (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split) - apply wp + apply wp+ apply (clarsimp)+ apply (rule corres_guard_imp) apply (rule corres_split [OF _ get_ep_corres, @@ -2778,24 +2776,24 @@ proof - apply (rule corres_if2, simp) apply (rule setup_caller_corres) apply (rule sts_corres, simp) - apply wp + apply wp+ apply (simp add: if_apply_def2) - apply (wp hoare_drop_imps)[1] + apply (wp hoare_drop_imps) apply (simp add: if_apply_def2) - apply (wp hoare_drop_imps)[1] + apply (wp hoare_drop_imps) apply simp apply ((wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases | simp add: if_apply_def2 split del: if_split)+)[1] apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf - sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases)[1] + sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases) apply (simp add: valid_tcb_state_def pred_conj_def) apply (strengthen reply_cap_doesnt_exist_strg disjI2_strg) apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift | clarsimp simp:is_cap_simps)+)[1] apply (simp add: valid_tcb_state'_def pred_conj_def) apply (strengthen weak_sch_act_wf) - apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps)[1] - apply (wp gts_st_tcb_at) + apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps) + apply (wp gts_st_tcb_at)+ apply (simp add: ep_relation_def split: list.split) apply (simp add: pred_conj_def cong: conj_cong) apply (wp hoare_post_taut) @@ -2813,7 +2811,7 @@ proof - subgoal by (auto simp: valid_ep'_def split: list.split; clarsimp simp: invs'_def valid_state'_def) - apply wp + apply wp+ apply (clarsimp)+ done qed @@ -2859,7 +2857,7 @@ lemma send_signal_corres: R' = "\rv'. invs' and ntfn_at' ep and valid_ntfn' rv' and ko_at' rv' ep"]) defer - apply (wp get_ntfn_ko get_ntfn_ko') + apply (wp get_ntfn_ko get_ntfn_ko')+ apply (simp add: invs_valid_objs)+ apply (case_tac "ntfn_obj ntfn") -- "IdleNtfn" @@ -3054,7 +3052,7 @@ lemma possibleSwitchTo_iflive[wp]: apply (simp add: possibleSwitchTo_def curDomain_def) apply (wp | wpc | simp)+ apply (simp only: imp_conv_disj, wp hoare_vcg_all_lift hoare_vcg_disj_lift) - apply (wp threadGet_wp) + apply (wp threadGet_wp)+ apply (auto simp: obj_at'_def projectKOs) done @@ -3231,9 +3229,10 @@ lemma setThreadState_not_rct[wp]: \\_ s. ksSchedulerAction s \ ResumeCurrentThread \" apply (simp add: setThreadState_def) apply (wp) - apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp) - apply (simp) - apply (wp) + apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp) + apply (simp) + apply (wp)+ + apply simp done lemma cancelAllIPC_not_rct[wp]: @@ -3243,13 +3242,13 @@ lemma cancelAllIPC_not_rct[wp]: apply (simp add: cancelAllIPC_def) apply (wp | wpc)+ apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp) - apply (simp add: forM_x_def) + apply simp apply (rule mapM_x_wp_inv) - apply (wp) + apply (wp)+ apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp) - apply (simp add: forM_x_def) + apply simp apply (rule mapM_x_wp_inv) - apply (wp) + apply (wp)+ apply (wp hoare_vcg_all_lift hoare_drop_imp) apply (simp_all) done @@ -3261,9 +3260,9 @@ lemma cancelAllSignals_not_rct[wp]: apply (simp add: cancelAllSignals_def) apply (wp | wpc)+ apply (rule hoare_post_imp [OF _ rescheduleRequired_notresume], simp) - apply (simp add: forM_x_def) + apply simp apply (rule mapM_x_wp_inv) - apply (wp) + apply (wp)+ apply (wp hoare_vcg_all_lift hoare_drop_imp) apply (simp_all) done @@ -3285,14 +3284,15 @@ proof - \\_ s. ksSchedulerAction s = ResumeCurrentThread \ ksCurThread s \ t'\" apply (simp add: cancelSignal_def) apply (wp)[1] - apply (wp hoare_convert_imp) - apply (rule_tac P="\s. ksSchedulerAction s \ ResumeCurrentThread" - in hoare_weaken_pre) - apply (wpc) - apply (wp | simp)+ - apply (wpc, wp) - apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) - apply (wp) + apply (wp hoare_convert_imp)+ + apply (rule_tac P="\s. ksSchedulerAction s \ ResumeCurrentThread" + in hoare_weaken_pre) + apply (wpc) + apply (wp | simp)+ + apply (wpc, wp+) + apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) + apply (wp) + apply simp done have cdo: "\t t' slot. \\s. ksSchedulerAction s = ResumeCurrentThread \ ksCurThread s \ t'\ @@ -3309,23 +3309,24 @@ proof - apply (simp add: cancelIPC_def Let_def) apply (wp, wpc) prefer 4 -- "state = Running" - apply wp[1] + apply wp prefer 7 -- "state = Restart" - apply wp[1] - apply (wp) + apply wp + apply (wp)+ apply (wp hoare_convert_imp)[1] - apply (wpc, wp) + apply (wpc, wp+) apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) - apply (wp cdo) + apply (wp cdo)+ apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) - apply (wp aipc hoare_convert_imp)[6] - apply (wp) - apply (wp hoare_convert_imp)[1] - apply (wpc, wp) + apply ((wp aipc hoare_convert_imp)+)[6] + apply (wp) + apply (wp hoare_convert_imp)[1] + apply (wpc, wp+) + apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) + apply (wp) apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) apply (wp) - apply (rule_tac Q="\_. ?PRE t'" in hoare_post_imp, clarsimp) - apply (wp) + apply simp done qed @@ -3339,6 +3340,7 @@ lemma sai_invs'[wp]: "\invs' and ex_nonz_cap_to' ntfnptr\ sendSignal ntfnptr badge \\y. invs'\" unfolding sendSignal_def + including no_pre apply (rule hoare_seq_ext[OF _ get_ntfn_sp']) apply (case_tac "ntfnObj nTFN", simp_all) prefer 3 @@ -3347,7 +3349,7 @@ lemma sai_invs'[wp]: simp_all split del: if_split add: setMessageInfo_def)[1] apply (wp hoare_convert_imp [OF asUser_nosch] - hoare_convert_imp [OF setMRs_nosch]) + hoare_convert_imp [OF setMRs_nosch])+ apply (clarsimp simp:conj_comms) apply (simp add: invs'_def valid_state'_def) apply (wp valid_irq_node_lift sts_valid_objs' setThreadState_ct_not_inQ @@ -3444,7 +3446,7 @@ lemma ncof_corres: apply (rule corres_split_catch) apply (rule corres_trivial, simp) apply (rule lc_corres) - apply wp + apply wp+ apply fastforce apply fastforce done @@ -3546,7 +3548,7 @@ lemma receive_ipc_corres: apply (rule set_ep_corres) apply (simp add: ep_relation_def) apply simp - apply wp + apply wp+ apply (rule corres_guard_imp, rule do_nbrecv_failed_transfer_corres, simp) apply simp apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def @@ -3629,7 +3631,7 @@ lemma receive_ipc_corres: apply (rule set_ep_corres) apply (simp add: ep_relation_def) apply simp - apply wp + apply wp+ apply (rule corres_guard_imp, rule do_nbrecv_failed_transfer_corres, simp) apply simp apply (clarsimp simp: valid_tcb_state_def) @@ -3679,7 +3681,7 @@ lemma receive_signal_corres: apply (rule set_ntfn_corres) apply (simp add: ntfn_relation_def) apply simp - apply wp + apply wp+ apply (rule corres_guard_imp, rule do_nbrecv_failed_transfer_corres, simp+) -- "WaitingNtfn" apply (simp add: ntfn_relation_def) @@ -3689,7 +3691,7 @@ lemma receive_signal_corres: apply (rule set_ntfn_corres) apply (simp add: ntfn_relation_def) apply simp - apply wp + apply wp+ apply (rule corres_guard_imp) apply (rule do_nbrecv_failed_transfer_corres, simp+) -- "ActiveNtfn" @@ -3699,17 +3701,18 @@ lemma receive_signal_corres: apply (rule corres_split [OF _ user_setreg_corres]) apply (rule set_ntfn_corres) apply (simp add: ntfn_relation_def) - apply wp + apply wp+ apply (fastforce simp: invs_def valid_state_def valid_pspace_def elim!: st_tcb_weakenE) apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) - apply wp + apply wp+ apply (clarsimp simp add: valid_cap_def st_tcb_at_tcb_at) apply (clarsimp simp add: valid_cap'_def) done lemma tg_sp': "\P\ threadGet f p \\t. obj_at' (\t'. f t' = t) p and P\" + including no_pre apply (simp add: threadGet_def) apply wp apply (rule hoare_strengthen_post) @@ -3763,10 +3766,10 @@ lemma send_fault_ipc_corres: apply (clarsimp simp: valid_cap'_def inQ_def) apply auto[1] apply (clarsimp simp: lookup_failure_map_def) - apply wp + apply wp+ apply (rule threadget_corres) apply (simp add: tcb_relation_def) - apply wp + apply wp+ apply (fastforce elim: st_tcb_at_tcb_at) apply fastforce done @@ -3795,7 +3798,7 @@ lemma hdf_corres: apply wp apply (rule asUser_inv) apply (rule getRestartPC_inv) - apply (wp no_fail_getRestartPC) + apply (wp no_fail_getRestartPC)+ apply (wp|simp)+ done @@ -3842,7 +3845,7 @@ lemma setupCallerCap_valid_objs[wp]: getThreadReplySlot_def) apply (rule hoare_pre) apply wp - apply (wp sts_valid_objs' hoare_drop_imps hoare_vcg_all_lift) + apply (wp sts_valid_objs' hoare_drop_imps hoare_vcg_all_lift)+ apply (clarsimp simp: valid_cap'_def valid_tcb_state'_def) apply (drule obj_at_aligned') apply (simp add: objBits_simps capAligned_def word_bits_conv isCap_simps)+ @@ -3902,9 +3905,8 @@ lemma unique_master_reply_cap': lemma getSlotCap_cte_wp_at: "\\\ getSlotCap sl \\rv. cte_wp_at' (\c. cteCap c = rv) sl\" apply (simp add: getSlotCap_def) - apply wp - apply (rule hoare_strengthen_post [OF getCTE_cte_wp_at]) - apply (clarsimp elim!: cte_wp_at_weakenE') + apply (wp getCTE_wp) + apply (clarsimp simp: cte_wp_at_ctes_of) done crunch no_0_obj'[wp]: setThreadState no_0_obj' @@ -4130,7 +4132,7 @@ lemma setupCallerCap_urz[wp]: apply (rule_tac Q="\_. untyped_ranges_zero' and valid_mdb' and valid_objs'" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def untyped_derived_eq_def isCap_simps) - apply (rule hoare_pre, wp sts_valid_pspace_hangers) + apply (wp sts_valid_pspace_hangers) apply (clarsimp simp: valid_tcb_state'_def) done @@ -4412,7 +4414,7 @@ lemma cteInsert_invs_bits[wp]: cteInsert a b c \\rv s. P (state_refs_of' s)\" apply (wp sch_act_wf_lift valid_queues_lift - cur_tcb_lift tcb_in_cur_domain'_lift) + cur_tcb_lift tcb_in_cur_domain'_lift)+ done crunch cap_to'[wp]: attemptSwitchTo "ex_nonz_cap_to' p" @@ -4430,7 +4432,7 @@ lemma setupCallerCap_cap_to' [wp]: and cte_wp_at' (\c. (cteCap c) = rv) callerSlot" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_ctes_of) - apply (wp getSlotCap_cte_wp_at hoare_drop_imps) + apply (wp getSlotCap_cte_wp_at hoare_drop_imps)+ apply simp done @@ -4623,11 +4625,11 @@ lemma hf_corres: apply (rule_tac F="valid_fault f" in corres_gen_asm) apply (rule send_fault_ipc_corres, assumption) apply simp - apply wp + apply wp+ apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1] apply clarsimp apply (simp add: tcb_at_def) - apply wp + apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def valid_state_def valid_idle_def) apply auto @@ -4675,8 +4677,8 @@ lemma hf_invs' [wp]: apply (simp add: handleFault_def) apply wp apply (simp add: handleDoubleFault_def) - apply (wp sts_invs_minor'' dmo_invs') - apply (rule hoare_pre, rule hoare_post_impErr, rule sfi_invs_plus', + apply (wp sts_invs_minor'' dmo_invs')+ + apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all) apply (strengthen no_refs_simple_strg') apply clarsimp @@ -4790,6 +4792,7 @@ lemma ri_makes_runnable_simple': "\st_tcb_at' P t' and K (t \ t') and K (P = runnable' \ P = simple')\ receiveIPC t cap isBlocking \\rv. st_tcb_at' P t'\" + including no_pre apply (rule hoare_gen_asm)+ apply (simp add: receiveIPC_def) apply (case_tac cap, simp_all add: isEndpointCap_def) @@ -4808,9 +4811,9 @@ lemma ri_makes_runnable_simple': apply (rule_tac Q="\_. st_tcb_at' P t' and K (a \ t')" in hoare_post_imp) apply (clarsimp simp: pred_tcb_at'_def obj_at'_def) - apply (wp threadGet_inv static_imp_wp) + apply (wp threadGet_inv static_imp_wp)+ apply (simp, simp only: imp_conv_disj) - apply (wp hoare_vcg_disj_lift) + apply (wp hoare_vcg_disj_lift)+ apply clarsimp apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs) apply (fastforce simp: pred_tcb_at'_def obj_at'_def isSend_def diff --git a/proof/refine/KHeap_R.thy b/proof/refine/KHeap_R.thy index 3433353d8..922c0fd53 100644 --- a/proof/refine/KHeap_R.thy +++ b/proof/refine/KHeap_R.thy @@ -1201,27 +1201,23 @@ lemma setObject_ko_wp_at: lemma typ_at'_valid_obj'_lift: assumes P: "\P T p. \\s. P (typ_at' T p s)\ f \\rv s. P (typ_at' T p s)\" + notes [wp] = hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_const_Ball_lift typ_at_lifts [OF P] shows "\\s. valid_obj' obj s\ f \\rv s. valid_obj' obj s\" - apply (cases obj, simp_all add: valid_obj'_def) - apply (rename_tac endpoint) - apply (case_tac endpoint; simp add: valid_ep'_def) - apply (wp hoare_vcg_const_Ball_lift typ_at_lifts [OF P]) - apply (rename_tac notification) - apply (case_tac "ntfnObj notification"; simp add: valid_ntfn'_def valid_bound_tcb'_def) - prefer 3 - apply (wp hoare_vcg_const_Ball_lift typ_at_lifts [OF P]) - apply ((case_tac "ntfnBoundTCB notification", simp_all, wp typ_at_lifts[OF P])+)[3] - apply wp - apply (rename_tac tcb) + apply (cases obj; simp add: valid_obj'_def hoare_TrueI) + apply (rename_tac endpoint) + apply (case_tac endpoint; simp add: valid_ep'_def, wp) + apply (rename_tac notification) + apply (case_tac "ntfnObj notification"; + simp add: valid_ntfn'_def valid_bound_tcb'_def split: option.splits, + (wpsimp|rule conjI)+) + apply (rename_tac tcb) apply (case_tac "tcbState tcb"; - simp add: valid_tcb'_def valid_tcb_state'_def split_def valid_bound_ntfn'_def) - apply ((wp hoare_vcg_const_Ball_lift typ_at_lifts [OF P] - | case_tac "tcbBoundNotification tcb"; simp)+)[8] - apply (simp add: valid_cte'_def) - apply (wp typ_at_lifts[OF P]) + simp add: valid_tcb'_def valid_tcb_state'_def split_def valid_bound_ntfn'_def + split: option.splits, + wpsimp) + apply (wpsimp simp: valid_cte'_def) apply (rename_tac arch_kernel_object) - apply (case_tac arch_kernel_object; simp) - apply (wp typ_at_lifts[OF P]) + apply (case_tac arch_kernel_object; wpsimp) done lemmas setObject_valid_obj = typ_at'_valid_obj'_lift [OF setObject_typ_at'] @@ -1480,10 +1476,10 @@ lemma set_ep_valid_pspace'[wp]: \\r. valid_pspace'\" apply (simp add: valid_pspace'_def) apply (wp set_ep_aligned' [simplified] set_ep_valid_objs') - apply (wp hoare_vcg_conj_lift) - apply (simp add: setEndpoint_def) - apply (wp setEndpoint_valid_mdb') - apply auto + apply (wp hoare_vcg_conj_lift) + apply (simp add: setEndpoint_def) + apply (wp setEndpoint_valid_mdb')+ + apply auto done lemma set_ep_valid_bitmapQ[wp]: @@ -1513,8 +1509,7 @@ lemma set_ep_bitmapQ_no_L2_orphans[wp]: lemma set_ep_valid_queues[wp]: "\Invariants_H.valid_queues\ setEndpoint epptr ep \\rv. Invariants_H.valid_queues\" apply (simp add: Invariants_H.valid_queues_def) - apply (rule hoare_pre) - apply (wp hoare_vcg_conj_lift) + apply (wp hoare_vcg_conj_lift) apply (simp add: setEndpoint_def valid_queues_no_bitmap_def) apply (wp hoare_Ball_helper hoare_vcg_all_lift) apply (rule obj_at_setObject2) @@ -1528,8 +1523,7 @@ lemma set_ep_valid_queues'[wp]: apply (unfold setEndpoint_def) apply (simp only: valid_queues'_def imp_conv_disj obj_at'_real_def) - apply (rule hoare_pre) - apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift) + apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift) apply (rule setObject_ko_wp_at) apply simp apply (simp add: objBits_simps) @@ -1560,10 +1554,10 @@ lemma sch_act_wf_lift: apply (clarsimp simp: valid_def) apply (frule (1) use_valid [OF _ ksA]) apply (case_tac "ksSchedulerAction b", simp_all) - apply (drule (2) use_valid [OF _ ct_in_state_thread_state_lift' [OF kCT tcb]]) + apply (drule (2) use_valid [OF _ ct_in_state_thread_state_lift' [OF kCT tcb]]) apply (clarsimp) apply (rule conjI) - apply (drule (2) use_valid [OF _ tcb]) + apply (drule (2) use_valid [OF _ tcb]) apply (drule (2) use_valid [OF _ tcb_cd]) done @@ -1573,7 +1567,7 @@ lemma tcb_in_cur_domain'_lift: shows "\ tcb_in_cur_domain' t \ f \ \_. tcb_in_cur_domain' t \" apply (simp add: tcb_in_cur_domain'_def) apply (rule_tac f="ksCurDomain" in hoare_lift_Pf) - apply (rule b) + apply (rule b) apply (rule a) done @@ -1588,15 +1582,15 @@ lemma ct_idle_or_in_cur_domain'_lift: shows "\ ct_idle_or_in_cur_domain' \ f \ \_. ct_idle_or_in_cur_domain' \" apply (simp add: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) apply (rule_tac f="ksCurThread" in hoare_lift_Pf) - apply (rule_tac f="ksIdleThread" in hoare_lift_Pf) - apply (rule_tac f="ksSchedulerAction" in hoare_lift_Pf) - apply (rule_tac f="ksCurDomain" in hoare_lift_Pf) - apply (wp hoare_vcg_imp_lift) - apply (rule e) - apply simp - apply (rule a) - apply (rule b) - apply (rule c) + apply (rule_tac f="ksIdleThread" in hoare_lift_Pf) + apply (rule_tac f="ksSchedulerAction" in hoare_lift_Pf) + apply (rule_tac f="ksCurDomain" in hoare_lift_Pf) + apply (wp hoare_vcg_imp_lift) + apply (rule e) + apply simp + apply (rule a) + apply (rule b) + apply (rule c) apply (rule d) done @@ -1616,22 +1610,20 @@ lemma setObject_ep_cur_domain[wp]: lemma setEndpoint_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t\ setEndpoint epptr ep \\_. tcb_in_cur_domain' t\" apply (clarsimp simp: setEndpoint_def) - apply (rule tcb_in_cur_domain'_lift) - apply wp + apply (rule tcb_in_cur_domain'_lift; wp) done lemma setEndpoint_obj_at'_tcb[wp]: "\obj_at' (P :: tcb \ bool) t \ setEndpoint ptr (e::endpoint) \\_. obj_at' (P :: tcb \ bool) t\" - apply (clarsimp simp: setEndpoint_def, wp) - done + by (clarsimp simp: setEndpoint_def, wp) lemma set_ep_sch_act_wf[wp]: "\\s. sch_act_wf (ksSchedulerAction s) s\ setEndpoint epptr ep \\rv s. sch_act_wf (ksSchedulerAction s) s\" apply (wp sch_act_wf_lift) - apply (simp add: setEndpoint_def split_def setObject_def - | wp updateObject_default_inv)+ + apply (simp add: setEndpoint_def split_def setObject_def + | wp updateObject_default_inv)+ done lemma setObject_state_refs_of': @@ -1805,8 +1797,7 @@ lemma setNotification_ksCurDomain[wp]: lemma setNotification_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t\ setNotification epptr ep \\_. tcb_in_cur_domain' t\" apply (clarsimp simp: setNotification_def) - apply (rule tcb_in_cur_domain'_lift) - apply wp + apply (rule tcb_in_cur_domain'_lift; wp) done lemma set_ntfn_sch_act_wf[wp]: @@ -1957,7 +1948,7 @@ lemma valid_global_refs_lift': apply (rule hoare_lift_Pf [where f="ksIdleThread"]) apply (rule hoare_lift_Pf [where f="irq_node'"]) apply (rule hoare_lift_Pf [where f="gsMaxObjectSize"]) - apply (wp ctes hoare_vcg_const_Ball_lift arch idle irqn maxObj) + apply (wp ctes hoare_vcg_const_Ball_lift arch idle irqn maxObj)+ done lemma valid_arch_state_lift': @@ -1969,16 +1960,16 @@ lemma valid_arch_state_lift': page_table_at'_def All_less_Ball) apply (rule hoare_lift_Pf [where f="ksArchState"]) - apply (wp typs hoare_vcg_const_Ball_lift arch typ_at_lifts) + apply (wp typs hoare_vcg_const_Ball_lift arch typ_at_lifts)+ done lemma set_ep_global_refs'[wp]: "\valid_global_refs'\ setEndpoint ptr val \\_. valid_global_refs'\" - by (rule valid_global_refs_lift') wp + by (rule valid_global_refs_lift'; wp) lemma set_ep_valid_arch' [wp]: "\valid_arch_state'\ setEndpoint ptr val \\_. valid_arch_state'\" - by (rule valid_arch_state_lift') wp + by (rule valid_arch_state_lift'; wp) lemma setObject_ep_ct: "\\s. P (ksCurThread s)\ setObject p (e::endpoint) \\_ s. P (ksCurThread s)\" @@ -2071,13 +2062,13 @@ lemma set_ntfn_maxObj [wp]: lemma set_ntfn_global_refs' [wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" - by (rule valid_global_refs_lift') wp + by (rule valid_global_refs_lift'; wp) crunch typ_at' [wp]: setNotification "\s. P (typ_at' T p s)" lemma set_ntfn_valid_arch' [wp]: "\valid_arch_state'\ setNotification ptr val \\_. valid_arch_state'\" - by (rule valid_arch_state_lift') wp + by (rule valid_arch_state_lift'; wp) lemmas valid_irq_node_lift = hoare_use_eq_irq_node' [OF _ typ_at_lift_valid_irq_node'] @@ -2289,7 +2280,7 @@ lemma dmo_inv': shows "\P\ doMachineOp f \\_. P\" apply (simp add: doMachineOp_def split_def) apply (wp select_wp) - apply (clarsimp simp del: ) + apply clarsimp apply (drule in_inv_by_hoareD [OF R]) apply simp done diff --git a/proof/refine/Orphanage.thy b/proof/refine/Orphanage.thy index 0aae99680..0113d68cd 100644 --- a/proof/refine/Orphanage.thy +++ b/proof/refine/Orphanage.thy @@ -114,16 +114,16 @@ lemma no_orphans_lift: apply (unfold no_orphans_disj all_active_tcb_ptrs_def all_queued_tcb_ptrs_def) - apply (wp hoare_vcg_all_lift - hoare_vcg_disj_lift) - apply (rule ksCurThread_is_lifted) - apply (wp hoare_vcg_disj_lift) - apply (rule ksReadyQueues_is_lifted) - apply (wp hoare_vcg_disj_lift) - apply (rule typ_at'_is_lifted) - apply (wp hoare_vcg_disj_lift) - apply (rule st_tcb_at'_is_lifted) - apply (rule ksSchedulerAction_is_lifted) + apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift) + apply (rule ksCurThread_is_lifted) + apply (wp hoare_vcg_disj_lift) + apply (rule ksReadyQueues_is_lifted) + apply (wp hoare_vcg_disj_lift) + apply (rule typ_at'_is_lifted) + apply (wp hoare_vcg_disj_lift) + apply (rule st_tcb_at'_is_lifted) + apply (rule ksSchedulerAction_is_lifted) + apply simp done lemma st_tcb_at'_is_active_tcb_ptr_lift: @@ -229,7 +229,7 @@ lemma setCTE_no_orphans [wp]: setCTE p cte \ \rv s. no_orphans s \" apply (rule no_orphans_lift) - apply (wp setCTE_typ_at' setCTE_pred_tcb_at') + apply (wp setCTE_typ_at' setCTE_pred_tcb_at')+ done lemma setCTE_almost_no_orphans [wp]: @@ -623,7 +623,7 @@ lemma tcbSchedDequeue_all_queued_tcb_ptrs: apply (clarsimp simp: tcbSchedDequeue_def all_queued_tcb_ptrs_def) apply (rule hoare_pre) apply (wp, clarsimp) - apply (wp hoare_ex_wp) + apply (wp hoare_ex_wp)+ apply (rename_tac d p) apply (rule_tac Q="\_ s. x \ set (ksReadyQueues s (d, p))" in hoare_post_imp, clarsimp) @@ -665,12 +665,12 @@ lemma ThreadDecls_H_switchToThread_no_orphans: unfolding Thread_H.switchToThread_def apply (wp setCurThread_almost_no_orphans tcbSchedDequeue_almost_no_orphans) - apply (wps tcbSchedDequeue_ct') - apply (wp tcbSchedDequeue_all_queued_tcb_ptrs hoare_convert_imp) + apply (wps tcbSchedDequeue_ct') + apply (wp tcbSchedDequeue_all_queued_tcb_ptrs hoare_convert_imp)+ apply (wps) - apply (wp) - apply (wps) - apply (wp) + apply (wp)+ + apply (wps) + apply (wp) apply (clarsimp) done @@ -701,13 +701,10 @@ lemma tcbSchedEnqueue_inQueue_eq: lemma findM_on_success: "\ \x. \ P x \ f x \ \rv s. rv \; \x y. \ P x \ f y \ \rv. P x \ \ \ \ \s. \x \ set xs. P x s \ findM f xs \ \rv s. \ y. rv = Some y \" - apply (induct xs) - apply clarsimp - apply clarsimp - apply wp - apply assumption + apply (induct xs; clarsimp) + apply wp+ apply (clarsimp simp: imp_conv_disj Bex_def) - apply (wp hoare_vcg_disj_lift hoare_ex_wp | clarsimp)+ + apply (wp hoare_vcg_disj_lift hoare_ex_wp | clarsimp | assumption)+ done crunch st_tcb' [wp]: switchToThread "\s. P' (st_tcb_at' P t s)" @@ -739,7 +736,7 @@ lemma tcbSchedDequeue_not_empty: apply wp apply clarsimp apply clarsimp - apply (wp setQueue_deq_not_empty) + apply (wp setQueue_deq_not_empty)+ apply (rule_tac Q="\rv s. \ st_tcb_at' P thread s" in hoare_post_imp) apply fastforce apply (wp weak_if_wp | clarsimp)+ @@ -866,7 +863,7 @@ lemma schedule_no_orphans [wp]: apply (wps tcbSchedEnqueue_ct') apply clarsimp apply (wp tcbSchedEnqueue_in_ksQ)[1] - apply (wp) + apply (wp)+ apply (case_tac "ksSchedulerAction s") apply (clarsimp) apply (clarsimp simp: pred_tcb_at'_def is_active_tcb_ptr_def) @@ -1070,7 +1067,7 @@ lemma sendIPC_valid_queues' [wp]: unfolding sendIPC_def apply (wp hoare_drop_imps | wpc | clarsimp)+ apply (wp_once sts_st_tcb', clarsimp) - apply (wp) + apply (wp)+ apply (rule_tac Q="\rv. valid_queues' and valid_objs' and ko_at' rv epptr and (\s. sch_act_wf (ksSchedulerAction s) s)" in hoare_post_imp) apply (clarsimp) @@ -1182,6 +1179,7 @@ lemma createObject_no_orphans: K (range_cover ptr sz (APIType_capBits tp us) (Suc 0)) and no_orphans\ RetypeDecls_H.createObject tp ptr us d \\xa. no_orphans\" + including no_pre apply (case_tac tp) apply (simp_all add: createObject_def ARM_H.createObject_def split del: if_split) apply (rename_tac apiobject_type) @@ -1327,7 +1325,7 @@ lemma invokeUntyped_no_orphans [wp]: \ \reply s. no_orphans s \" apply (rule hoare_pre, rule hoare_strengthen_post) apply (rule invokeUntyped_invs''[where Q=no_orphans]) - apply (wp createNewCaps_no_orphans) + apply (wp createNewCaps_no_orphans)+ apply (clarsimp simp: valid_pspace'_def) apply (intro conjI, simp_all)[1] apply (wp | simp)+ @@ -1486,7 +1484,7 @@ lemma suspend_no_orphans [wp]: "\ \s. no_orphans s \ invs' s \ sch_act_simple s \ tcb_at' t s \ suspend t \ \rv s. no_orphans s \" - unfolding suspend_def + unfolding suspend_def including no_pre apply (wp | clarsimp simp: unless_def | rule conjI)+ apply (clarsimp simp: is_active_tcb_ptr_def is_active_thread_state_def st_tcb_at_neg2) apply (wp setThreadState_not_active_no_orphans hoare_disjI1 setThreadState_st_tcb @@ -1726,7 +1724,7 @@ lemma restart_no_orphans [wp]: "\ \s. no_orphans s \ invs' s \ sch_act_simple s \ tcb_at' t s \ restart t \ \rv s. no_orphans s \" - unfolding restart_def isBlocked_def2 + unfolding restart_def isBlocked_def2 including no_pre apply (wp tcbSchedEnqueue_almost_no_orphans sts_st_tcb' | clarsimp | strengthen no_orphans_strg_almost | strengthen invs_valid_queues')+ @@ -1770,7 +1768,7 @@ lemma setPriority_no_orphans [wp]: \ \rv s. no_orphans s \" unfolding setPriority_def apply (wp hoare_drop_imps | clarsimp)+ - apply (wp hoare_drop_imps tcbSchedEnqueue_almost_no_orphans) + apply (wp hoare_drop_imps tcbSchedEnqueue_almost_no_orphans)+ apply (rule_tac Q="\rv s. almost_no_orphans tptr s \ valid_queues' s" in hoare_post_imp) apply (fastforce simp: is_active_tcb_ptr_runnable' pred_tcb_at'_def obj_at'_def almost_no_orphans_no_orphans) @@ -1951,7 +1949,7 @@ lemma performASIDControlInvocation_no_orphans [wp]: apply (clarsimp simp: no_orphans_def all_active_tcb_ptrs_def is_active_tcb_ptr_def all_queued_tcb_ptrs_def) apply (wp | clarsimp simp:placeNewObject_def2)+ - apply (wp createObjects'_wp_subst) + apply (wp createObjects'_wp_subst)+ apply (wp static_imp_wp updateFreeIndex_pspace_no_overlap'[where sz= pageBits] getSlotCap_wp | simp)+ apply (strengthen invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace') apply (clarsimp simp:conj_comms) @@ -2093,8 +2091,7 @@ lemma deleteCallerCap_no_orphans [wp]: deleteCallerCap receiver \ \rv s. no_orphans s \" unfolding deleteCallerCap_def - apply (wp | clarsimp)+ - done + by wpsimp auto lemma remove_neg_strg: "(A \ B) \ ((x \ A) \ (\ x \ B))" @@ -2164,7 +2161,7 @@ theorem callKernel_no_orphans [wp]: ksSchedulerAction s = ResumeCurrentThread \ no_orphans s \ callKernel e \ \rv s. no_orphans s \" - unfolding callKernel_def + unfolding callKernel_def including no_pre apply (wp | clarsimp)+ apply (rule_tac Q="\rv s. invs' s" in hoare_post_imp) apply (wp weak_if_wp schedule_invs' | clarsimp)+ diff --git a/proof/refine/PageTableDuplicates.thy b/proof/refine/PageTableDuplicates.thy index cf51cac1f..c6b32893f 100644 --- a/proof/refine/PageTableDuplicates.thy +++ b/proof/refine/PageTableDuplicates.thy @@ -148,7 +148,7 @@ lemma transferCapsToSlots_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ transferCapsToSlots ep buffer n caps slots mi \\rv s. vs_valid_duplicates' (ksPSpace s)\" - by (rule transferCapsToSlots_pres1,wp) + by (rule transferCapsToSlots_pres1; wp) crunch valid_duplicates'[wp]: transferCaps "\s. vs_valid_duplicates' (ksPSpace s)" (ignore: getObject setObject sequenceE simp:unless_def @@ -1256,7 +1256,7 @@ lemma createObject_valid_duplicates'[wp]: apply (drule(2) valid_duplicates'_update) prefer 3 apply (fastforce simp: vs_entry_align_def)+ apply (clarsimp simp:ARM_H.toAPIType_def word_bits_def - ARM_H.toAPIType_def split:ARM_H.object_type.splits) + split:ARM_H.object_type.splits) apply (cut_tac ptr = ptr in new_cap_addrs_fold'[where n = "2^us" and ko = "(KOCTE makeObject)",simplified]) apply (rule word_1_le_power) @@ -1301,7 +1301,6 @@ lemma createNewObjects_valid_duplicates'[wp]: apply (subst createNewObjects_Cons) apply (simp add: word_bits_def) apply wp - apply (rule hoare_pre) apply (wp snoc.hyps) apply (rule hoare_vcg_conj_lift) apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]]) @@ -1558,7 +1557,7 @@ lemma storePDE_no_duplicates': \\ya s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:storePDE_def setObject_def split_def | wp | wpc)+ apply (simp add:updateObject_default_def) - apply wp + apply wp+ apply clarsimp apply (subst vs_valid_duplicates'_def) apply clarsimp @@ -1591,7 +1590,7 @@ lemma storePTE_no_duplicates': \\ya s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:storePTE_def setObject_def split_def | wp | wpc)+ apply (simp add:updateObject_default_def) - apply wp + apply wp+ apply clarsimp apply (subst vs_valid_duplicates'_def) apply clarsimp @@ -1708,43 +1707,41 @@ lemma unmapPage_valid_duplicates'[wp]: unmapPage vmpage_size asiv vptr word \\r s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:unmapPage_def) (* make sure checkMappingPPtr_SmallPage is first tried before checkMappingPPtr_inv *) - apply (wp storePTE_no_duplicates' mapM_x_mapM_valid + apply ((wp storePTE_no_duplicates' mapM_x_mapM_valid storePDE_no_duplicates' checkMappingPPtr_Section mapM_x_storePDE_update_helper[where sz = 6] lookupPTSlot_page_table_at' - checkMappingPPtr_SmallPage | wpc + checkMappingPPtr_SmallPage)+ | wpc | simp add:split_def conj_comms | wp_once checkMappingPPtr_inv)+ apply (rule_tac ptr = "p && ~~ mask ptBits" and word = p in mapM_x_storePTE_update_helper[where sz = 6]) apply simp - apply (wp mapM_x_mapM_valid) + apply (wp mapM_x_mapM_valid)+ apply (rule_tac ptr = "p && ~~ mask ptBits" and word = p in mapM_x_storePTE_update_helper[where sz = 6]) apply simp - apply wp + apply wp+ apply clarsimp - apply (wp checkMappingPPtr_inv lookupPTSlot_page_table_at') + apply (wp checkMappingPPtr_inv lookupPTSlot_page_table_at')+ apply (rule hoare_post_imp_R[OF lookupPTSlot_aligned[where sz= vmpage_size]]) apply (simp add:pageBitsForSize_def) apply (drule upto_enum_step_shift[where n = 6 and m = 2,simplified]) apply (clarsimp simp:mask_def add.commute upto_enum_step_def) - apply wp - apply (wp storePTE_no_duplicates' mapM_x_mapM_valid + apply wp+ + apply ((wp storePTE_no_duplicates' mapM_x_mapM_valid storePDE_no_duplicates' checkMappingPPtr_Section - checkMappingPPtr_SmallPage | wpc + checkMappingPPtr_SmallPage)+ | wpc | simp add:split_def conj_comms | wp_once checkMappingPPtr_inv)+ apply (rule_tac ptr = "p && ~~ mask pdBits" and word = p in mapM_x_storePDE_update_helper[where sz = 6]) - apply (wp mapM_x_mapM_valid) + apply (wp mapM_x_mapM_valid)+ apply (rule_tac ptr = "p && ~~ mask pdBits" and word = p in mapM_x_storePDE_update_helper[where sz = 6]) - apply wp + apply wp+ apply (clarsimp simp:conj_comms) - apply (wp checkMappingPPtr_inv static_imp_wp) - apply (clarsimp simp:conj_comms) - apply (rule hoare_pre) - apply (wp) - apply (rule hoare_post_imp_R[where Q'= "\r. pspace_aligned' and + apply (wp checkMappingPPtr_inv static_imp_wp)+ + apply (clarsimp simp:conj_comms) + apply (rule hoare_post_imp_R[where Q'= "\r. pspace_aligned' and (\s. vs_valid_duplicates' (ksPSpace s)) and K(vmsz_aligned' vptr vmpage_size \ is_aligned r pdBits) and page_directory_at' (lookup_pd_slot r vptr && ~~ mask pdBits)"]) @@ -1775,8 +1772,7 @@ lemma setVMRoot_vs_entry_align[wp]: apply (wp whenE_inv hoare_drop_imp |wpc|simp add: armv_contextSwitch_def)+ apply (rule hoare_post_imp[where Q = "\r. ko_wp_at' (\a. P (vs_entry_align a)) p"]) apply (simp) - apply (wp|simp)+ - apply (simp add:getThreadVSpaceRoot_def locateSlot_conv) + apply (wpsimp simp: getThreadVSpaceRoot_def locateSlot_conv)+ done crunch ko_wp_at'[wp]: @@ -1797,7 +1793,7 @@ lemma unmapPageTable_valid_duplicates'[wp]: apply (rule hoare_pre) apply (simp add:unmapPageTable_def) apply (wp|wpc|simp)+ - apply (wp storePDE_no_duplicates') + apply (wp storePDE_no_duplicates')+ apply simp apply (simp add:pageTableMapped_def) apply (wp getPDE_wp |wpc|simp)+ @@ -2038,7 +2034,6 @@ lemma invokeCNode_valid_duplicates'[wp]: \\_ s. vs_valid_duplicates' (ksPSpace s)\" apply (case_tac cinv) apply (clarsimp simp add:invokeCNode_def | wp | intro conjI)+ - apply (rule hoare_pre) apply (rule valid_validE) apply (rule hoare_post_imp[OF _ cteRevoke_valid_duplicates']) apply simp @@ -2055,7 +2050,6 @@ lemma invokeCNode_valid_duplicates'[wp]: |simp add:locateSlot_conv getThreadCallerSlot_def whenE_def split_def |wpc)+ - apply (rule hoare_pre) apply (rule valid_validE) apply (rule hoare_post_imp[OF _ finaliseSlot_valid_duplicates']) apply simp @@ -2079,13 +2073,14 @@ lemma performPageInvocation_valid_duplicates'[wp]: and (\s. vs_valid_duplicates' (ksPSpace s))\ performPageInvocation page_invocation \\y a. vs_valid_duplicates' (ksPSpace a)\" + including no_pre apply (rule hoare_name_pre_state) apply (case_tac page_invocation) -- "PageFlush" apply (simp_all add:performPageInvocation_def pteCheckIfMapped_def pdeCheckIfMapped_def) apply (wp|simp|wpc)+ -- "PageRemap" - apply (rename_tac word sum) + apply (rename_tac word sum) apply (case_tac sum) apply (case_tac a) apply (case_tac aa) @@ -2098,9 +2093,8 @@ lemma performPageInvocation_valid_duplicates'[wp]: apply simp apply (rule hoare_seq_ext[OF _ getObject_pte_sp]) apply (wp|simp)+ - apply (clarsimp simp:valid_arch_inv'_def - valid_page_inv'_def valid_slots'_def - valid_slots_duplicated'_def) + apply (clarsimp simp:valid_arch_inv'_def valid_page_inv'_def valid_slots'_def + valid_slots_duplicated'_def) apply (rule hoare_pre) apply (rule_tac sz = 6 and ptr = "p && ~~ mask ptBits" and word = p in mapM_x_storePTE_update_helper) @@ -2155,8 +2149,7 @@ lemma performPageInvocation_valid_duplicates'[wp]: apply (case_tac a) apply (case_tac aa) apply (clarsimp simp: pteCheckIfMapped_def) - apply (wp mapM_x_mapM_valid |wpc - | simp)+ + apply (wp mapM_x_mapM_valid | wpc | simp)+ apply (clarsimp simp:valid_slots_duplicated'_def mapM_x_singleton)+ apply (rule PageTableDuplicates.storePTE_no_duplicates', rule getPTE_wp) apply (wp hoare_vcg_all_lift hoare_drop_imps) @@ -2165,7 +2158,7 @@ lemma performPageInvocation_valid_duplicates'[wp]: apply (wp mapM_x_mapM_valid | simp)+ apply (rule_tac sz = 6 and ptr = "p && ~~ mask ptBits" and word = p in mapM_x_storePTE_update_helper) - apply (wp getPTE_wp hoare_vcg_all_lift hoare_drop_imps) + apply (wp getPTE_wp hoare_vcg_all_lift hoare_drop_imps)+ apply (simp add:ptBits_def pageBits_def)+ apply (simp add:invs_pspace_aligned') apply simp @@ -2195,7 +2188,7 @@ lemma performPageInvocation_valid_duplicates'[wp]: apply (wp mapM_x_mapM_valid | simp)+ apply (rule_tac sz = 6 and ptr = "p && ~~ mask pdBits" and word = p in mapM_x_storePDE_update_helper) - apply wp + apply wp+ apply (simp add:pageBits_def pdBits_def ptBits_def)+ apply (simp add:invs_pspace_aligned')+ apply clarsimp @@ -2297,11 +2290,10 @@ lemma performArchInvocation_valid_duplicates': apply (rename_tac page_directory_invocation) apply (case_tac page_directory_invocation, simp_all add:performPageDirectoryInvocation_def)[] - apply (wp, simp) - apply (wp) - apply (simp, rule doMachineOp_valid_duplicates') - apply (wp) - apply (simp) + apply (wp+, simp) + apply (wp)+ + apply simp + apply simp apply(wp, simp) apply (rename_tac asidcontrol_invocation) apply (case_tac asidcontrol_invocation) @@ -2311,15 +2303,14 @@ lemma performArchInvocation_valid_duplicates': apply (clarsimp simp:cte_wp_at_ctes_of) apply (case_tac ctea,clarsimp) apply (frule(1) ctes_of_valid_cap'[OF _ invs_valid_objs']) - apply (rule hoare_pre) - apply (wp static_imp_wp|simp)+ + apply (wp static_imp_wp|simp)+ apply (simp add:placeNewObject_def) apply (wp |simp add:alignError_def unless_def|wpc)+ apply (wp updateFreeIndex_pspace_no_overlap' hoare_drop_imp getSlotCap_cte_wp_at deleteObject_no_overlap deleteObjects_invs_derivatives[where p="makePoolParent (case ai of InvokeASIDControl i \ i)"] deleteObject_no_overlap - deleteObjects_cte_wp_at') + deleteObjects_cte_wp_at')+ apply (clarsimp simp:cte_wp_at_ctes_of) apply (strengthen refl ctes_of_valid_cap'[mk_strg I E]) apply (clarsimp simp: conj_comms valid_cap_simps' capAligned_def @@ -2561,7 +2552,7 @@ lemma handleRecv_valid_duplicates'[wp]: apply (clarsimp simp: isCap_simps sch_act_sane_not) apply assumption - apply (wp deleteCallerCap_nonz_cap) + apply (wp deleteCallerCap_nonz_cap)+ apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' simp: ct_in_state'_def sch_act_sane_def) @@ -2592,7 +2583,6 @@ lemma callKernel_valid_duplicates': apply (wp activate_invs' activate_sch_act schedule_sch schedule_sch_act_simple he_invs' | simp add: no_irq_getActiveIRQ)+ - apply (rule hoare_post_impErr) apply (rule valid_validE) prefer 2 diff --git a/proof/refine/Refine.thy b/proof/refine/Refine.thy index a8713e9ea..a7d3b6e28 100644 --- a/proof/refine/Refine.thy +++ b/proof/refine/Refine.thy @@ -234,10 +234,10 @@ lemma set_thread_state_sched_act: in hoare_strengthen_post) apply wp apply force - apply (wp gts_st_tcb_at) + apply (wp gts_st_tcb_at)+ apply (rule_tac Q="\rv. st_tcb_at (op = state) thread and (\s. runnable state) and (\s. P (scheduler_action s))" in hoare_strengthen_post) apply (simp add: st_tcb_at_def) - apply (wp obj_set_prop_at) + apply (wp obj_set_prop_at)+ apply (force simp: st_tcb_at_def obj_at_def) apply wp apply clarsimp @@ -247,7 +247,8 @@ lemma activate_thread_sched_act: "\ct_in_state activatable and (\s. P (scheduler_action s))\ activate_thread \\rs s. P (scheduler_action (s::det_state))\" - by (simp add: activate_thread_def set_thread_state_def arch_activate_idle_thread_def | wp set_thread_state_sched_act gts_wp | wpc)+ + by (simp add: activate_thread_def set_thread_state_def arch_activate_idle_thread_def + | (wp set_thread_state_sched_act gts_wp)+ | wpc)+ lemma schedule_sched_act_rct[wp]: "\\\ Schedule_A.schedule @@ -553,10 +554,10 @@ lemma doUserOp_invs': (\s. 0 < ksDomainTime s) and valid_domain_list'\" apply (simp add: doUserOp_def split_def ex_abs_def) apply (wp device_update_invs') - apply (wp dmo_invs' doMachineOp_ct_running') - apply (clarsimp simp add: no_irq_modify device_memory_update_def - user_memory_update_def) - apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp) + apply (wp dmo_invs' doMachineOp_ct_running')+ + apply (clarsimp simp add: no_irq_modify device_memory_update_def + user_memory_update_def) + apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)+ apply (clarsimp simp: user_memory_update_def simpler_modify_def restrict_map_def split: option.splits) @@ -609,7 +610,7 @@ lemma kernel_corres: apply simp apply (wp doMachineOp_getActiveIRQ_IRQ_active handle_event_valid_sched | simp)+ apply (rule_tac Q="\_. \" and E="\_. invs'" in hoare_post_impErr) - apply wp + apply wp+ apply (simp add: invs'_def valid_state'_def) apply (rule corres_split [OF _ schedule_corres]) apply (rule activate_corres) @@ -659,8 +660,7 @@ lemma entry_corres: apply (rule threadget_corres) apply (simp add: tcb_relation_def arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) - apply wp - + apply wp+ apply (rule hoare_strengthen_post, rule akernel_invs_det_ext, simp add: invs_def cur_tcb_def) apply (rule hoare_strengthen_post, rule ckernel_invs, simp add: invs'_def cur_tcb'_def) apply (wp thread_set_invs_trivial thread_set_ct_running diff --git a/proof/refine/Retype_R.thy b/proof/refine/Retype_R.thy index 6db1f8258..f0864abac 100644 --- a/proof/refine/Retype_R.thy +++ b/proof/refine/Retype_R.thy @@ -105,7 +105,7 @@ where text {* makeObject etc. lemmas *} -lemma NullCap_valid' [simp]: "s \' capability.NullCap" +lemma NullCap_valid' [iff]: "s \' capability.NullCap" unfolding valid_cap'_def by simp lemma valid_obj_makeObject_cte [simp]: @@ -1640,9 +1640,7 @@ crunch (empty_fail) empty_fail[wp]: retype_region2_ext end interpretation retype_region2_ext_extended: is_extended "retype_region2_ext ptrs type" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) context begin interpretation Arch . (*FIXME: arch_split*) @@ -1659,9 +1657,7 @@ crunch (empty_fail) empty_fail[wp]: retype_region2_extra_ext (wp: mapM_x_wp) end interpretation retype_region2_extra_ext_extended: is_extended "retype_region2_extra_ext ptrs type" - apply (unfold_locales) - apply wp - done + by (unfold_locales; wp) context begin interpretation Arch . (*FIXME: arch_split*) @@ -1995,17 +1991,17 @@ proof - apply (erule retype_state_relation[OF _ _ _ _ _ _ _ _ _ cover _ _ orr], simp_all add: ko not_zero obj_bits_api bound[simplified obj_bits_api ko])[1] - apply wp + apply wp+ apply (clarsimp split: option.splits) apply (intro conjI impI) apply (clarsimp|wp)+ apply (clarsimp split: option.splits) - apply (clarsimp|wp)+ + apply wpsimp apply (clarsimp split: option.splits) apply (intro conjI impI) - apply (rule no_fail_pre, wp)[1] + apply wp apply (clarsimp simp:lookupAround2_char1) - apply (rule no_fail_pre,wp) + apply wp apply (clarsimp simp: obj_bits_api ko) apply (drule(1) pspace_no_overlap_disjoint') apply (rule_tac x1 = a in ccontr[OF in_empty_interE]) @@ -2393,7 +2389,9 @@ proof - show ?thesis proof(cases "Types_H.toAPIType ty") - case None thus ?thesis using not_0 + case None thus ?thesis + including no_pre + using not_0 apply (clarsimp simp: createNewCaps_def Arch_createNewCaps_def) apply wp using cover @@ -2503,6 +2501,7 @@ proof - done next case TCBObject with Some cover ct show ?thesis + including no_pre apply (clarsimp simp: Arch_createNewCaps_def createNewCaps_def) apply (simp_all add: ARM_H.toAPIType_def fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def curDomain_def @@ -2520,6 +2519,7 @@ proof - done next case EndpointObject with Some cover ct show ?thesis + including no_pre apply (clarsimp simp: Arch_createNewCaps_def createNewCaps_def) apply (simp_all add: ARM_H.toAPIType_def fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def @@ -2537,6 +2537,7 @@ proof - done next case NotificationObject with Some cover ct show ?thesis + including no_pre apply (clarsimp simp: Arch_createNewCaps_def createNewCaps_def) apply (simp_all add: ARM_H.toAPIType_def fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def @@ -2559,32 +2560,33 @@ proof - fromIntegral_def toInteger_nat fromInteger_nat APIType_capBits_def split: ARM_H.object_type.splits) apply wp - apply (clarsimp simp: ARM_H.toAPIType_def APIType_capBits_def objBits_simps - split: ARM_H.object_type.split object_type.splits) - apply (rule hoare_chain) - apply (rule hoare_vcg_conj_lift) + apply (clarsimp simp: ARM_H.toAPIType_def APIType_capBits_def objBits_simps + split: ARM_H.object_type.split object_type.splits) + apply (rule hoare_strengthen_post) + apply (rule hoare_vcg_conj_lift) apply (rule createObjects_aligned [OF _ _ not_0 ]) - apply ((clarsimp simp:objBits_simps range_cover_def range_cover.range_cover_n_less[where 'a=32, unfolded word_bits_len_of, OF cover])+)[3] - apply (simp add: word_bits_def) - apply (rule hoare_vcg_conj_lift) - apply (rule createObjects_ret [OF range_cover.range_cover_n_less(1)[where 'a=32, unfolded word_bits_len_of, OF cover] not_0]) - apply (rule createObjects_obj_at [where 'a=cte, OF _ not_0]) - apply (simp add: objBits_simps APIType_capBits_def) - apply (simp add: projectKOs) - apply simp - apply (clarsimp simp: valid_cap'_def capAligned_def objBits_simps - dest!: less_two_pow_divD) - apply (thin_tac "\x\S. is_aligned (p x) n" for S p n) - apply (intro conjI) - apply ((simp add:range_cover_def word_bits_def)+)[2] - apply (clarsimp simp: power_sub) - apply (drule bspec, simp) - apply (drule_tac x = "addr && mask us" in spec) - apply (drule mp) - apply simp - apply (rule and_mask_less') - apply (simp add: range_cover_def word_bits_def) - apply (clarsimp simp add: shiftl_t2n) + apply ((clarsimp simp:objBits_simps range_cover_def range_cover.range_cover_n_less[where 'a=32, unfolded word_bits_len_of, OF cover])+)[3] + apply (simp add: word_bits_def) + apply (rule hoare_vcg_conj_lift) + apply (rule createObjects_ret [OF range_cover.range_cover_n_less(1)[where 'a=32, unfolded word_bits_len_of, OF cover] not_0]) + apply (rule createObjects_obj_at [where 'a=cte, OF _ not_0]) + apply (simp add: objBits_simps APIType_capBits_def) + apply (simp add: projectKOs) + apply simp + apply (clarsimp simp: valid_cap'_def capAligned_def objBits_simps + dest!: less_two_pow_divD) + apply (thin_tac "\x\S. is_aligned (p x) n" for S p n) + apply (intro conjI) + apply ((simp add:range_cover_def word_bits_def)+)[2] + apply (clarsimp simp: power_sub) + apply (drule bspec, simp) + apply (drule_tac x = "addr && mask us" in spec) + apply (drule mp) + apply simp + apply (rule and_mask_less') + apply (simp add: range_cover_def word_bits_def) + apply (clarsimp simp add: shiftl_t2n) + apply simp done qed qed @@ -2755,7 +2757,7 @@ lemma copy_global_corres: apply (wp hoare_vcg_const_Ball_lift | simp)+ apply (simp add: kernel_base_def ARM.kernelBase_def kernelBase_def list_all2_refl) apply (rule corres_trivial, clarsimp simp: state_relation_def arch_state_relation_def) - apply wp + apply wp+ apply (clarsimp simp: valid_arch_state_def) apply (auto elim: page_directory_pde_atI is_aligned_weaken[OF pd_aligned])[1] apply (clarsimp simp: valid_arch_state'_def) @@ -2778,18 +2780,11 @@ lemma copyGlobalMappings_obj_at': \\ya. obj_at' P p\" apply (simp add: copyGlobalMappings_def) apply (wp mapM_x_wp') - apply (simp add: storePDE_def) - apply (wp obj_at_setObject2) - apply (clarsimp simp: updateObject_default_def in_monad) - apply wp - done - -lemma setObject_ksPSpace_only: - assumes x: "\ko x y n. \P\ updateObject obj ko x y n \\rv. P\" - assumes y: "\f s. P (ksPSpace_update f s) = P s" - shows "\P\ setObject p obj \\rv. P\" - apply (simp add: setObject_def split_def) - apply (wp x | simp add: y)+ + apply (simp add: storePDE_def) + apply (wp obj_at_setObject2) + apply (clarsimp simp: updateObject_default_def in_monad) + apply wp+ + apply simp done crunch ct[wp]: copyGlobalMappings "\s. P (ksCurThread s)" @@ -3732,26 +3727,15 @@ lemma createObjects_orig_cte_wp_at2': apply (rule handy_prop_divs) apply (wp createObjects_orig_obj_at2'[where sz = sz], simp) apply (simp add: tcb_cte_cases_def) + including no_pre apply (wp handy_prop_divs createObjects_orig_obj_at2'[where sz = sz] | simp add: o_def cong: option.case_cong)+ done lemma threadSet_cte_wp_at2'T: - assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. - getF (F tcb) = getF tcb" + assumes "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. P (cte_wp_at' P' p s)\ threadSet F t \\rv s. P (cte_wp_at' P' p s)\" - apply (simp add: threadSet_def) - apply (rule hoare_seq_ext [where B="\rv s. obj_at' (op = rv) t s \ P (cte_wp_at' P' p s)"]) - apply (subst conj_commute) - apply (rule setObject_cte_wp_at2') - apply (clarsimp simp: updateObject_default_def projectKOs in_monad objBits_simps - obj_at'_def in_magnitude_check prod_eq_iff) - apply (case_tac tcba, clarsimp simp: bspec_split [OF spec [OF x]]) - apply (clarsimp simp: updateObject_default_def in_monad bind_def - projectKOs) - apply (wp getObject_tcb_wp) - apply (clarsimp simp: obj_at'_def) - done + using assms by (rule threadSet_cte_wp_at'T) lemmas threadSet_cte_wp_at2' = threadSet_cte_wp_at2'T [OF all_tcbI, OF ball_tcb_cte_casesI] @@ -3764,6 +3748,7 @@ lemma createNewCaps_cte_wp_at2: \ pspace_no_overlap' ptr sz s\ createNewCaps ty ptr n objsz dev \\rv s. P (cte_wp_at' P' p s)\" + including no_pre apply (simp add: createNewCaps_def createObjects_def ARM_H.toAPIType_def split del: if_split) apply (case_tac ty; simp add: createNewCaps_def createObjects_def Arch_createNewCaps_def @@ -3771,8 +3756,8 @@ lemma createNewCaps_cte_wp_at2: apply (rename_tac apiobject_type) apply (case_tac apiobject_type; simp split del: if_split) apply (rule hoare_pre, wp, simp add:createObjects_def) - apply (wp createObjects_orig_cte_wp_at2'[where sz = sz] - mapM_x_wp' threadSet_cte_wp_at2' + apply ((wp createObjects_orig_cte_wp_at2'[where sz = sz] + mapM_x_wp' threadSet_cte_wp_at2')+ | assumption | clarsimp simp: APIType_capBits_def projectKOs projectKO_opts_defs @@ -4112,30 +4097,11 @@ crunch ksReadyQueuesL1[wp]: copyGlobalMappings "\s. P (ksReadyQueuesL1Bi crunch ksReadyQueuesL2[wp]: copyGlobalMappings "\s. P (ksReadyQueuesL2Bitmap s)" (ignore: getObject setObject wp: updateObject_default_inv crunch_wps) -lemma storePDE_valid_idle'[wp]: - "\valid_idle'\ storePDE ptr pde \\rv. valid_idle'\" - unfolding storePDE_def - apply (wp setObject_idle' updateObject_default_inv - | simp add: objBits_simps archObjSize_def)+ - apply (auto simp: valid_idle'_def projectKOs) - done - crunch valid_idle'[wp]: copyGlobalMappings "valid_idle'" (ignore: getObject setObject simp: objBits_simps archObjSize_def wp: updateObject_default_inv crunch_wps setObject_idle' refl) -lemma storePDE_iflive'[wp]: - "\if_live_then_nonz_cap'\ storePDE ptr val \\rv. if_live_then_nonz_cap'\" - unfolding storePDE_def - apply (wp setObject_iflive'[where n=2 and P="\"] - | simp add: objBits_simps archObjSize_def)+ - apply (clarsimp simp: updateObject_default_def in_monad projectKOs) - apply (rule ccontr, erule nonemptyE) - apply (clarsimp simp: updateObject_default_def projectKOs in_monad) - apply simp - done - crunch iflive'[wp]: copyGlobalMappings "if_live_then_nonz_cap'" (ignore: getObject wp: crunch_wps) @@ -4173,10 +4139,9 @@ lemma createNewCaps_iflive'[wp]: lemma createObjects_pspace_only: "\ \f s. P (ksPSpace_update f s) = P s \ \ \P\ createObjects' ptr n val gbits \\rv. P\" - apply (simp add: createObjects_def createObjects'_def - unless_def alignError_def - split_def lookupAround2_pspace_no) - apply (wp | wpc | simp)+ + apply (simp add: createObjects_def createObjects'_def unless_def alignError_def + split_def lookupAround2_pspace_no) + apply wpsimp done lemma createObjects'_qs[wp]: @@ -4347,6 +4312,7 @@ lemma createNewCaps_ko_wp_atQ': \ P' v \ P True)\ createNewCaps ty ptr n us d \\rv s. P (ko_wp_at' P' p s)\" + including no_pre apply (rule hoare_name_pre_state) apply (clarsimp simp: createNewCaps_def ARM_H.toAPIType_def split del: if_split) @@ -4480,7 +4446,6 @@ lemma createObjects_idle': apply (rule hoare_pre) apply (clarsimp simp add: valid_idle'_def pred_tcb_at'_def) apply (rule hoare_as_subst [OF createObjects'_it]) - apply (wp createObjects_orig_obj_at' createObjects_orig_cte_wp_at2' hoare_vcg_all_lift | simp)+ @@ -4502,7 +4467,8 @@ lemma createNewCaps_idle'[wp]: split del: if_split) apply (rename_tac apiobject_type) apply (case_tac apiobject_type, simp_all split del: if_split)[1] - apply (rule hoare_pre, wp, simp) + apply (wp, simp) + including no_pre apply (wp mapM_x_wp' createObjects_idle' copyGlobalMappings_obj_at' @@ -5110,7 +5076,7 @@ lemma createNewCaps_urz: apply (simp add: untyped_ranges_zero_inv_null_filter_cteCaps_of) apply (rule hoare_pre) apply (rule untyped_ranges_zero_lift) - apply (wp createNewCaps_null_filter') + apply (wp createNewCaps_null_filter')+ apply (auto simp: o_def) done @@ -5315,8 +5281,8 @@ lemma createObjects_queues: \\rv. valid_queues\" apply (wp valid_queues_lift_asm [unfolded pred_conj_def, OF createObjects_orig_obj_at3] createObjects_pred_tcb_at' [unfolded pred_conj_def]) - apply fastforce - apply (wp) + apply fastforce + apply wp+ apply fastforce done @@ -5812,7 +5778,8 @@ lemma corres_retype_region_createNewCaps: objBits_simps APIType_map2_def) apply (simp add: APIType_map2_def) apply (rule retype_region2_extra_ext_mapM_x_corres) - apply wp[2] + apply wp + apply wp apply (rule corres_retype[where 'a = tcb], simp_all add: obj_bits_api_def objBits_simps pageBits_def APIType_map2_def makeObjectKO_def @@ -5983,7 +5950,7 @@ lemma corres_retype_region_createNewCaps: apply (simp add: list_all2_same) apply (rule corres_return[where P =\ and P'=\,THEN iffD2]) apply simp - apply wp + apply wp+ apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde , simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj], simp_all add: APIType_map2_def obj_bits_api_def diff --git a/proof/refine/Schedule_R.thy b/proof/refine/Schedule_R.thy index 9b15d84a0..ce77c5b14 100644 --- a/proof/refine/Schedule_R.thy +++ b/proof/refine/Schedule_R.thy @@ -23,7 +23,7 @@ declare static_imp_wp[wp_split del] lemma corres_gets_pre_lhs: "(\x. corres r (P x) P' (g x) g') \ corres r (\s. P (f s) s) P' (gets f >>= (\x. g x)) g'" - by (simp add: corres_underlying_gets_pre_lhs) + by (rule corres_underlying_gets_pre_lhs) (* FIXME: move *) lemma corres_if_lhs: @@ -71,18 +71,18 @@ lemma findM_awesome': assumes x: "\x xs. suffix (x # xs) xs' \ corres (\a b. if b then (\a'. a = Some a' \ r a' (Some x)) else a = None) P (P' (x # xs)) - ((f >>= (\x. return (Some x))) OR (return None)) (g x)" + ((f >>= (\x. return (Some x))) \ (return None)) (g x)" assumes y: "corres r P (P' []) f (return None)" assumes z: "\x xs. suffix (x # xs) xs' \ \P' (x # xs)\ g x \\rv s. \ rv \ P' xs s\" assumes p: "suffix xs xs'" shows "corres r P (P' xs) f (findM g xs)" proof - - have P: "f = do x \ (do x \ f; return (Some x) od) OR return None; if x \ None then return (the x) else f od" + have P: "f = do x \ (do x \ f; return (Some x) od) \ return None; if x \ None then return (the x) else f od" apply (rule ext) apply (auto simp add: bind_def alternative_def return_def split_def prod_eq_iff) done - have Q: "\P\ (do x \ f; return (Some x) od) OR return None \\rv. if rv \ None then \ else P\" + have Q: "\P\ (do x \ f; return (Some x) od) \ return None \\rv. if rv \ None then \ else P\" by (wp alternative_wp | simp)+ show ?thesis using p apply (induct xs) @@ -115,16 +115,16 @@ lemma corres_rhs_disj_division: lemma findM_alternative_awesome: assumes x: "\x. corres (\a b. if b then (\a'. a = Some a') else a = None) - P (P' and (\s. x \ fn s)) ((f >>= (\x. return (Some x))) OR (return None)) (g x)" + P (P' and (\s. x \ fn s)) ((f >>= (\x. return (Some x))) \ (return None)) (g x)" assumes z: "\x xs. \\s. P' s \ x \ fn s \ set xs \ fn s\ g x \\rv s. \ rv \ P' s \ set xs \ fn s\" assumes on_none: "corres dc P P' f g'" shows "corres dc P (P' and (\s. set xs \ fn s)) f (findM g xs >>= (\x. when (x = None) g'))" proof - - have P: "f = do x \ (do x \ f; return (Some x) od) OR return None; if x \ None then return (the x) else f od" + have P: "f = do x \ (do x \ f; return (Some x) od) \ return None; if x \ None then return (the x) else f od" apply (rule ext) apply (auto simp add: bind_def alternative_def return_def split_def prod_eq_iff) done - have Q: "\P\ (do x \ f; return (Some x) od) OR return None \\rv. if rv \ None then \ else P\" + have Q: "\P\ (do x \ f; return (Some x) od) \ return None \\rv. if rv \ None then \ else P\" by (wp alternative_wp | simp)+ have R: "\P x g xs. (do x \ if P then return (Some x) else findM g xs; when (x = None) g' @@ -152,7 +152,7 @@ qed lemma awesome_case1: assumes x: "corres op = P P' (return False) (g x)" shows "corres (\a b. if b then (\a'. a = Some a' \ r a' (Some x)) else a = None) - P P' ((f >>= (\x. return (Some x))) OR (return None)) (g x)" + P P' ((f >>= (\x. return (Some x))) \ (return None)) (g x)" proof - have P: "return None = liftM (\x. None) (return False)" by (simp add: liftM_def) @@ -169,7 +169,7 @@ qed lemma awesome_case2: assumes x: "corres (\a b. r a (Some x) \ b) P P' f (g x)" shows "corres (\a b. if b then (\a'. a = Some a' \ r a' (Some x)) else a = None) - P P' ((f >>= (\x. return (Some x))) OR (return None)) (g x)" + P P' ((f >>= (\x. return (Some x))) \ (return None)) (g x)" apply (rule corres_alternate1) apply (fold liftM_def) apply (simp add: o_def) @@ -247,7 +247,7 @@ lemma tcbSchedAppend_corres: apply (case_tac queued) apply (simp add: unless_def when_def) apply (rule corres_no_failI) - apply (rule no_fail_pre, wp) + apply wp+ apply (clarsimp simp: in_monad ethread_get_def gets_the_def bind_assoc assert_opt_def exec_gets is_etcb_at_def get_etcb_def get_tcb_queue_def set_tcb_queue_def simpler_modify_def) @@ -270,7 +270,7 @@ lemma tcbSchedAppend_corres: apply (rule corres_split_noop_rhs2) apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1] apply (rule addToBitmap_if_null_corres_noop) - apply wp + apply wp+ apply (simp add: tcb_sched_append_def) apply (intro conjI impI) apply (rule corres_guard_imp) @@ -426,14 +426,13 @@ lemma tcbSchedDequeue_valid_queues_weak: \\_. Invariants_H.valid_queues\" proof - show ?thesis - unfolding tcbSchedDequeue_def null_def valid_queues_def - apply (rule hoare_pre) - apply wp (* stops on threadSet *) + unfolding tcbSchedDequeue_def null_def valid_queues_def + apply wp (* stops on threadSet *) apply (rule hoare_post_eq[OF _ threadSet_valid_queues_dequeue_wp], simp add: valid_queues_def) - apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift) + apply (wp hoare_vcg_if_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+ apply (wp hoare_vcg_imp_lift setQueue_valid_queues_no_bitmap_except_dequeue_wp - setQueue_valid_bitmapQ threadGet_const_tcb_at) + setQueue_valid_bitmapQ threadGet_const_tcb_at)+ (* wp done *) apply (normalise_obj_at') apply (clarsimp simp: correct_queue_def) @@ -534,7 +533,7 @@ lemma tcbSchedDequeue_valid_queues'[wp]: apply (wp | clarsimp simp: bitmap_fun_defs)+ apply (wp hoare_vcg_all_lift setQueue_ksReadyQueues_lift) apply clarsimp - apply (wp threadGet_obj_at' threadGet_const_tcb_at) + apply (wp threadGet_obj_at' threadGet_const_tcb_at)+ apply clarsimp apply (rule context_conjI, clarsimp simp: obj_at'_def) apply (clarsimp simp: valid_queues'_def obj_at'_def projectKOs inQ_def|wp)+ @@ -660,9 +659,7 @@ lemma tcbSchedEnqueue_tcb_in_cur_domain'[wp]: apply (rule tcb_in_cur_domain'_lift) apply wp apply (clarsimp simp: tcbSchedEnqueue_def) - apply wp - apply (case_tac queued, simp_all add: unless_def when_def) - apply (wp | simp)+ + apply (wpsimp simp: unless_def)+ done lemma ct_idle_or_in_cur_domain'_lift2: @@ -674,7 +671,8 @@ lemma ct_idle_or_in_cur_domain'_lift2: apply (unfold ct_idle_or_in_cur_domain'_def) apply (rule hoare_lift_Pf2[where f=ksCurThread]) apply (rule hoare_lift_Pf2[where f=ksSchedulerAction]) - apply (wp static_imp_wp hoare_vcg_disj_lift ) + including no_pre + apply (wp static_imp_wp hoare_vcg_disj_lift) apply simp+ done @@ -709,15 +707,16 @@ lemma tcbSchedEnqueue_in_ksQ: obj_at' (\tcb. tcbDomain tcb = d) t s" in hoare_pre_imp) apply (clarsimp simp: tcb_at'_has_tcbPriority tcb_at'_has_tcbDomain) + including no_pre apply (wp hoare_vcg_ex_lift) apply (simp add: tcbSchedEnqueue_def unless_def) - apply (wp) + apply wp apply clarsimp - apply wp + apply wp+ apply (rule_tac Q="\rv s. tdom = d \ rv = p \ obj_at' (\tcb. tcbPriority tcb = p) t s \ obj_at' (\tcb. tcbDomain tcb = d) t s" in hoare_post_imp, clarsimp) - apply (wp, wp threadGet_const) + apply (wp, (wp threadGet_const)+) apply (rule_tac Q="\rv s. obj_at' (\tcb. tcbPriority tcb = p) t s \ obj_at' (\tcb. tcbDomain tcb = d) t s \ @@ -765,8 +764,8 @@ lemma tcbSchedAppend_ct_not_inQ: show ?thesis apply (simp add: tcbSchedAppend_def unless_def) apply (wp ts sq | clarsimp)+ - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply (wp) + apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) + apply (wpsimp)+ done qed @@ -784,9 +783,7 @@ lemma tcbSchedAppend_tcbDomain[wp]: tcbSchedAppend t \ \_. obj_at' (\tcb. P (tcbDomain tcb)) t' \" apply (clarsimp simp: tcbSchedAppend_def) - apply wp - apply (case_tac queued, simp_all add: unless_def when_def) - apply (wp | simp)+ + apply (wpsimp simp: unless_def)+ done lemma tcbSchedAppend_tcbPriority[wp]: @@ -794,15 +791,13 @@ lemma tcbSchedAppend_tcbPriority[wp]: tcbSchedAppend t \ \_. obj_at' (\tcb. P (tcbPriority tcb)) t' \" apply (clarsimp simp: tcbSchedAppend_def) - apply wp - apply (case_tac queued, simp_all add: unless_def when_def) - apply (wp | simp)+ + apply (wpsimp simp: unless_def)+ done lemma tcbSchedAppend_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t'\ tcbSchedAppend t \\_. tcb_in_cur_domain' t' \" apply (rule tcb_in_cur_domain'_lift) - apply wp + apply wp+ done @@ -987,7 +982,7 @@ proof - show ?thesis apply - - apply (simp add: switch_to_thread_def Thread_H.switchToThread_def K_bind_def) + apply (simp add: switch_to_thread_def Thread_H.switchToThread_def) apply (rule corres_symb_exec_l [where Q = "\ s rv. (?PA and op = rv) s", OF corres_symb_exec_l [OF mainpart]]) apply (auto intro: no_fail_pre [OF no_fail_assert] @@ -1028,7 +1023,7 @@ lemma switch_idle_thread_corres: apply (unfold setCurThread_def) apply (rule corres_trivial, rule corres_modify) apply (simp add: state_relation_def cdt_relation_def) - apply (wp, simp+) + apply (wp+, simp+) apply (simp add: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def valid_pspace'_def) done @@ -1283,7 +1278,7 @@ lemma Arch_swichToThread_tcbPriority_triv[wp]: lemma Arch_switchToThread_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t'\ Arch.switchToThread t \\_. tcb_in_cur_domain' t' \" apply (rule tcb_in_cur_domain'_lift) - apply wp + apply wp+ done lemma tcbSchedDequeue_not_tcbQueued: @@ -1425,11 +1420,10 @@ lemma tcbSchedDequeue_invs_no_cicd'[wp]: tcbSchedDequeue t \\_. invs_no_cicd'\" unfolding all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def - apply (rule hoare_pre) - apply (wp tcbSchedDequeue_ct_not_inQ sch_act_wf_lift valid_irq_node_lift irqs_masked_lift - valid_irq_handlers_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift2 - tcbSchedDequeue_valid_queues_weak - untyped_ranges_zero_lift + apply (wp tcbSchedDequeue_ct_not_inQ sch_act_wf_lift valid_irq_node_lift irqs_masked_lift + valid_irq_handlers_lift' cur_tcb_lift ct_idle_or_in_cur_domain'_lift2 + tcbSchedDequeue_valid_queues_weak + untyped_ranges_zero_lift | simp add: cteCaps_of_def o_def)+ apply clarsimp apply (fastforce simp: valid_pspace'_def valid_queues_def @@ -1438,11 +1432,10 @@ lemma tcbSchedDequeue_invs_no_cicd'[wp]: lemma switchToThread_invs_no_cicd': "\invs_no_cicd' and st_tcb_at' runnable' t and tcb_in_cur_domain' t \ ThreadDecls_H.switchToThread t \\rv. invs' \" - apply (simp add: Thread_H.switchToThread_def ) - apply (wp setCurThread_invs_no_cicd' - Arch_switchToThread_invs_no_cicd' Arch_switchToThread_pred_tcb' - tcbSchedDequeue_not_tcbQueued) - apply (clarsimp elim!: pred_tcb'_weakenE)+ + apply (simp add: Thread_H.switchToThread_def) + apply (wp setCurThread_invs_no_cicd' tcbSchedDequeue_not_tcbQueued + Arch_switchToThread_invs_no_cicd' Arch_switchToThread_pred_tcb') + apply (auto elim!: pred_tcb'_weakenE) done lemma switchToThread_invs[wp]: @@ -1451,7 +1444,7 @@ lemma switchToThread_invs[wp]: apply (wp threadSet_timeslice_invs setCurThread_invs Arch_switchToThread_invs dmo_invs' doMachineOp_obj_at tcbSchedDequeue_not_tcbQueued) - by (clarsimp elim!: pred_tcb'_weakenE)+ + by (auto elim!: pred_tcb'_weakenE) lemma setCurThread_ct_in_state: "\obj_at' (P \ tcbState) t\ setCurThread t \\rv. ct_in_state' P\" @@ -1503,7 +1496,7 @@ lemma sct_cap_to'[wp]: "\ex_nonz_cap_to' p\ setCurThread t \\rv. ex_nonz_cap_to' p\" apply (simp add: setCurThread_def) apply (wp ex_nonz_cap_to_pres') - apply (clarsimp elim!: cte_wp_at'_pspaceI) + apply (clarsimp elim!: cte_wp_at'_pspaceI)+ done @@ -2405,7 +2398,7 @@ lemma guarded_switch_to_chooseThread_fragment_corres: apply (rule corres_assert_assume_l) apply (rule corres_assert_assume_r) apply (rule switch_thread_corres) - apply (wp gts_st_tcb_at) + apply (wp gts_st_tcb_at)+ apply (clarsimp simp: st_tcb_at_tcb_at invs_def valid_state_def valid_pspace_def valid_sched_def invs_valid_vs_lookup invs_unique_refs) apply (auto elim!: pred_tcb'_weakenE split: thread_state.splits @@ -2621,13 +2614,13 @@ lemma schedule_ChooseNewThread_fragment_corres: apply (subst bind_dummy_ret_val) apply (subst bind_dummy_ret_val) apply (rule corres_guard_imp) - apply (rule corres_split[OF _ corres_when]) - apply (simp add: K_bind_def) - apply (rule chooseThread_corres) - apply simp - apply (rule next_domain_corres) - apply (wp nextDomain_invs_no_cicd') - apply (clarsimp simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def)+ + apply (rule corres_split[OF _ corres_when]) + apply simp + apply (rule chooseThread_corres) + apply simp + apply (rule next_domain_corres) + apply (wp nextDomain_invs_no_cicd')+ + apply (clarsimp simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def)+ done lemma schedule_corres: @@ -2918,9 +2911,9 @@ lemma schedule_ChooseNewThread_fragment_invs': obj_at' (Not \ tcbQueued) (ksCurThread s) s \ (ksCurThread s = ksIdleThread s \ tcb_in_cur_domain' (ksCurThread s) s) \" apply (rule hoare_seq_ext) - apply (wp chooseThread_ct_not_queued_2 chooseThread_activatable_2 chooseThread_invs_no_cicd') - apply (wp chooseThread_in_cur_domain' nextDomain_invs_no_cicd') - apply (simp add:nextDomain_def) + apply (wp chooseThread_ct_not_queued_2 chooseThread_activatable_2 chooseThread_invs_no_cicd') + apply (wp chooseThread_in_cur_domain' nextDomain_invs_no_cicd')+ + apply (simp add:nextDomain_def) apply (clarsimp simp: invs'_def all_invs_but_ct_idle_or_in_cur_domain'_def Let_def valid_state'_def) done @@ -2932,12 +2925,12 @@ lemma schedule_invs': "\invs'\ ThreadDecls_H.schedule \\ apply (wp)[1] -- "action = ChooseNewThread" apply (rule_tac hoare_seq_ext, rename_tac r) - apply (rule hoare_seq_ext, simp add: K_bind_def) + apply (rule hoare_seq_ext, simp) apply (rule hoare_seq_ext) apply (rule seq_ext[OF schedule_ChooseNewThread_fragment_invs' _, simplified bind_assoc]) apply (wp ssa_invs' chooseThread_invs_no_cicd') apply clarsimp - apply (wp)[3] + apply (wp+)[3] -- "action = SwitchToThread" apply (rename_tac word) apply (rule_tac hoare_seq_ext, rename_tac r) @@ -2948,12 +2941,12 @@ lemma schedule_invs': "\invs'\ ThreadDecls_H.schedule \\ and (\s. obj_at' (Not \ tcbQueued) (ksCurThread s) s)" in hoare_post_imp) apply simp - apply (wp switchToThread_tcb_in_cur_domain' switchToThread_ct_not_queued) + apply (wp switchToThread_tcb_in_cur_domain' switchToThread_ct_not_queued)+ apply (rule_tac Q="\_. (\s. st_tcb_at' activatable' word s) and invs' and (\s. tcb_in_cur_domain' word s)" in hoare_post_imp) apply (clarsimp simp:st_tcb_at'_def valid_state'_def obj_at'_def) - apply (wp) + apply (wp)+ apply (frule invs_sch_act_wf') apply (auto elim!: obj_at'_weakenE simp: pred_tcb_at'_def) done @@ -3030,9 +3023,9 @@ lemma schedule_ct_activatable'[wp]: "\invs'\ ThreadDecls_H.sched apply (rule hoare_seq_ext, simp) apply (rule hoare_seq_ext) apply (rule seq_ext[OF schedule_ChooseNewThread_fragment_invs' _, simplified bind_assoc]) - apply (wp ssa_invs') + apply (wp ssa_invs')+ apply (clarsimp simp: ct_in_state'_def, simp) - apply (wp)[3] + apply (wp+)[3] -- "action = SwitchToThread" apply (rename_tac word) apply (rule_tac hoare_seq_ext, rename_tac r) @@ -3043,7 +3036,7 @@ lemma schedule_ct_activatable'[wp]: "\invs'\ ThreadDecls_H.sched in hoare_post_imp) apply (fastforce simp: st_tcb_at'_def elim!: obj_at'_weakenE) apply (clarsimp simp: ) - apply (wp) + apply (wp)+ apply (frule invs_sch_act_wf') apply (auto elim!: obj_at'_weakenE simp: st_tcb_at'_def ) done @@ -3065,6 +3058,7 @@ lemma tcbSchedDequeue_sch_act_sane[wp]: lemma sts_sch_act_sane: "\sch_act_sane\ setThreadState st t \\_. sch_act_sane\" apply (simp add: setThreadState_def) + including no_pre apply (wp hoare_drop_imps | simp add: threadSet_sch_act_sane sane_update)+ done diff --git a/proof/refine/SubMonad_R.thy b/proof/refine/SubMonad_R.thy index d4d29603e..51d7dbc48 100644 --- a/proof/refine/SubMonad_R.thy +++ b/proof/refine/SubMonad_R.thy @@ -72,9 +72,9 @@ lemma threadGet_stateAssert_gets_asUser: apply (clarsimp simp: threadGet_def liftM_def, wp) apply (simp add: threadGet_def liftM_def, wp getObject_tcb_at') apply (simp add: threadGet_def liftM_def, wp) - apply (rule hoare_strengthen_post, wp getObject_obj_at') + apply (rule hoare_strengthen_post, wp getObject_obj_at') apply (simp add: objBits_def objBitsKO_def)+ - apply (clarsimp simp: obj_at'_def asUser_fetch_def projectKOs atcbContextGet_def) + apply (clarsimp simp: obj_at'_def asUser_fetch_def projectKOs atcbContextGet_def)+ done lemma threadSet_modify_asUser: diff --git a/proof/refine/Syscall_R.thy b/proof/refine/Syscall_R.thy index 961e9e909..8f6573a6c 100644 --- a/proof/refine/Syscall_R.thy +++ b/proof/refine/Syscall_R.thy @@ -349,10 +349,10 @@ lemma threadSet_tcbDomain_update_ct_not_inQ: "\ct_not_inQ \ threadSet (tcbDomain_update (\_. domain)) t \\_. ct_not_inQ\" apply (simp add: threadSet_def ct_not_inQ_def) apply (wp) - apply (rule hoare_convert_imp [OF setObject_nosch]) - apply (rule updateObject_tcb_inv) - apply (wps setObject_ct_inv) - apply (wp setObject_tcb_strongest getObject_tcb_wp) + apply (rule hoare_convert_imp [OF setObject_nosch]) + apply (rule updateObject_tcb_inv) + apply (wps setObject_ct_inv) + apply (wp setObject_tcb_strongest getObject_tcb_wp)+ apply (case_tac "t = ksCurThread s") apply (clarsimp simp: obj_at'_def)+ done @@ -390,21 +390,18 @@ lemma threadSet_tcbDomain_update_sch_act_wf[wp]: \\_ s. sch_act_wf (ksSchedulerAction s) s\" apply (simp add: sch_act_wf_cases split: scheduler_action.split) apply (wp hoare_vcg_conj_lift) - apply (simp add: threadSet_def) - apply wp - apply (wps setObject_sa_unchanged) - apply (wp static_imp_wp getObject_tcb_wp)+ - apply (clarsimp simp: obj_at'_def) - apply (rule hoare_vcg_all_lift) - apply (rename_tac word) - apply (rule_tac Q="\_ s. ksSchedulerAction s = SwitchToThread word \ st_tcb_at' runnable' word s \ tcb_in_cur_domain' word s \ word \ t" - in hoare_strengthen_post) - apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_imp_lift_something)+ apply (simp add: threadSet_def) - apply (wp_trace getObject_tcb_wp ) - apply (clarsimp simp: obj_at'_def) - apply (wp threadSet_tcbDomain_triv') - apply (auto) + apply wp + apply (wps setObject_sa_unchanged) + apply (wp static_imp_wp getObject_tcb_wp hoare_vcg_all_lift)+ + apply (rename_tac word) + apply (rule_tac Q="\_ s. ksSchedulerAction s = SwitchToThread word \ + st_tcb_at' runnable' word s \ tcb_in_cur_domain' word s \ word \ t" + in hoare_strengthen_post) + apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+ + apply (simp add: threadSet_def) + apply (wp_trace getObject_tcb_wp threadSet_tcbDomain_triv')+ + apply (auto simp: obj_at'_def) done lemma threadSet_tcbDomain_update_invs': @@ -478,7 +475,7 @@ lemma set_domain_setDomain_corres: apply (drule(1) bspec) apply (clarsimp simp:tcb_cte_cases_def) apply fastforce - apply (wp hoare_vcg_all_lift Tcb_R.tcbSchedDequeue_not_in_queue) + apply (wp hoare_vcg_all_lift Tcb_R.tcbSchedDequeue_not_in_queue)+ apply clarsimp apply (frule tcb_at_is_etcb_at) apply simp+ @@ -505,7 +502,7 @@ lemma pinv_corres: apply (rule corres_rel_imp, rule inv_untyped_corres) apply simp apply (case_tac x, simp_all)[1] - apply wp + apply wp+ apply simp+ apply (rule corres_guard_imp) apply (rule corres_split [OF _ gct_corres]) @@ -514,7 +511,7 @@ lemma pinv_corres: apply (rule corres_trivial) apply simp apply simp - apply wp + apply wp+ apply (clarsimp simp: ct_in_state_def) apply (fastforce elim: st_tcb_ex_cap) apply (clarsimp simp: pred_conj_def invs'_def cur_tcb'_def simple_sane_strg @@ -524,14 +521,14 @@ lemma pinv_corres: apply (rule corres_split [OF _ send_signal_corres]) apply (rule corres_trivial) apply (simp add: returnOk_def) - apply wp + apply wp+ apply (simp+)[2] apply simp apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ gct_corres]) apply (rule corres_split_nor [OF _ do_reply_transfer_corres]) apply (rule corres_trivial, simp) - apply wp + apply wp+ apply (clarsimp simp: tcb_at_invs) apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) apply (clarsimp simp: tcb_at_invs') @@ -545,7 +542,7 @@ lemma pinv_corres: apply (rule corres_guard_imp) apply (rule corres_split [OF _ set_domain_setDomain_corres]) apply (rule corres_trivial, simp) - apply (wp) + apply (wp)+ apply (clarsimp+)[2] -- "CNodes" apply clarsimp @@ -553,7 +550,7 @@ lemma pinv_corres: apply (rule corres_splitEE [OF _ inv_cnode_corres]) apply (rule corres_trivial, simp add: returnOk_def) apply assumption - apply wp + apply wp+ apply (clarsimp+)[2] apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric]) apply (rule corres_guard_imp, rule invoke_irq_control_corres, simp+) @@ -688,7 +685,7 @@ lemma sts_valid_inv'[wp]: sts_cap_to' sts_cte_cap_to' setThreadState_typ_ats split: option.splits)[1] - apply (wp sts_bound_tcb_at' hoare_vcg_all_lift hoare_vcg_const_imp_lift) + apply (wp sts_bound_tcb_at' hoare_vcg_all_lift hoare_vcg_const_imp_lift)+ done (* FIXME: move to TCB *) @@ -910,86 +907,86 @@ lemma doReply_invs[wp]: apply (rule hoare_seq_ext [OF _ assert_sp]) apply (rule hoare_seq_ext [OF _ getCTE_sp]) apply (wp, wpc) - apply (wp) - apply (wp_once sts_invs_minor'') - apply (simp) - apply (wp_once sts_st_tcb') - apply (wp)[1] - apply (rule_tac Q="\rv s. invs' s + apply (wp) + apply (wp_once sts_invs_minor'') + apply (simp) + apply (wp_once sts_st_tcb') + apply (wp)[1] + apply (rule_tac Q="\rv s. invs' s \ t \ ksIdleThread s \ st_tcb_at' awaiting_reply' t s" in hoare_post_imp) - apply (clarsimp) - apply (frule_tac t=t in invs'_not_runnable_not_queued) - apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) - apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) - apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) - apply (clarsimp | drule(1) obj_at_conj')+ - apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) - apply (drule(1) pred_tcb_at_conj') - apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") apply (clarsimp) - apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" + apply (frule_tac t=t in invs'_not_runnable_not_queued) + apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) + apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) + apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) + apply (clarsimp | drule(1) obj_at_conj')+ + apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) + apply (drule(1) pred_tcb_at_conj') + apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") + apply (clarsimp) + apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" in pred_tcb'_weakenE) - apply (case_tac st, clarsimp+) - apply (wp cteDeleteOne_reply_pred_tcb_at) - apply (clarsimp) - apply (rule_tac Q="\_. (\s. t \ ksIdleThread s) + apply (case_tac st, clarsimp+) + apply (wp cteDeleteOne_reply_pred_tcb_at)+ + apply (clarsimp) + apply (rule_tac Q="\_. (\s. t \ ksIdleThread s) and cte_wp_at' (\cte. cteCap cte = capability.ReplyCap t False) slot" in hoare_strengthen_post [rotated]) - apply clarsimp - apply (rule_tac x=t in exI, clarsimp) - apply (wp) - apply (rule hoare_strengthen_post [OF doIPCTransfer_non_null_cte_wp_at']) - apply (erule conjE) - apply assumption - apply (erule cte_wp_at_weakenE') - apply (fastforce) - apply (wp sts_invs_minor'' sts_st_tcb' static_imp_wp) - apply (rule_tac Q="\rv s. invs' s \ sch_act_simple s + apply clarsimp + apply (rule_tac x=t in exI, clarsimp) + apply (wp) + apply (rule hoare_strengthen_post [OF doIPCTransfer_non_null_cte_wp_at']) + apply (erule conjE) + apply assumption + apply (erule cte_wp_at_weakenE') + apply (fastforce) + apply (wp sts_invs_minor'' sts_st_tcb' static_imp_wp) + apply (rule_tac Q="\rv s. invs' s \ sch_act_simple s \ st_tcb_at' awaiting_reply' t s \ t \ ksIdleThread s" in hoare_post_imp) - apply (clarsimp) - apply (frule_tac t=t in invs'_not_runnable_not_queued) - apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) - apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) - apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) - apply (clarsimp | drule(1) obj_at_conj')+ - apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) - apply (drule(1) pred_tcb_at_conj') - apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") apply (clarsimp) - apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" + apply (frule_tac t=t in invs'_not_runnable_not_queued) + apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) + apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) + apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) + apply (clarsimp | drule(1) obj_at_conj')+ + apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) + apply (drule(1) pred_tcb_at_conj') + apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") + apply (clarsimp) + apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" in pred_tcb'_weakenE) - apply (case_tac st, clarsimp+) - apply (wp threadSet_invs_trivial threadSet_st_tcb_at2 static_imp_wp + apply (case_tac st, clarsimp+) + apply (wp threadSet_invs_trivial threadSet_st_tcb_at2 static_imp_wp | clarsimp simp add: inQ_def)+ - apply (rule_tac Q="\_. invs' and tcb_at' t + apply (rule_tac Q="\_. invs' and tcb_at' t and sch_act_simple and st_tcb_at' awaiting_reply' t" in hoare_strengthen_post [rotated]) - apply (clarsimp) - apply (rule conjI) - apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) + apply (clarsimp) + apply (rule conjI) + apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) + apply (rule conjI) + apply clarsimp + apply clarsimp + apply (drule idle_tcb_at'_split, clarsimp, drule (1) st_tcb_at'_eqD, simp) + apply clarsimp + apply (rule conjI) + apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) + apply (erule pred_tcb'_weakenE, clarsimp) + apply (rule conjI) + apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def + obj_at'_def) apply (rule conjI) apply clarsimp + apply (frule invs'_not_runnable_not_queued) + apply (erule pred_tcb'_weakenE, clarsimp) + apply (frule (1) not_tcbQueued_not_ksQ) + apply simp apply clarsimp - apply (drule idle_tcb_at'_split, clarsimp, drule (1) st_tcb_at'_eqD, simp) - apply clarsimp - apply (rule conjI) - apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) - apply (erule pred_tcb'_weakenE, clarsimp) - apply (rule conjI) - apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def - obj_at'_def) - apply (rule conjI) - apply clarsimp - apply (frule invs'_not_runnable_not_queued) - apply (erule pred_tcb'_weakenE, clarsimp) - apply (frule (1) not_tcbQueued_not_ksQ) - apply simp - apply clarsimp - apply (wp cteDeleteOne_reply_pred_tcb_at hoare_drop_imp hoare_allI) + apply (wp cteDeleteOne_reply_pred_tcb_at hoare_drop_imp hoare_allI)+ apply (clarsimp simp add: isReply_awaiting_reply' cte_wp_at_ctes_of) apply (auto dest!: st_tcb_idle'[rotated] simp:isCap_simps) done @@ -1132,28 +1129,27 @@ lemma setDomain_invs': apply (simp add:setDomain_def ) apply (wp_trace add: hoare_when_wp static_imp_wp static_imp_conj_wp rescheduleRequired_all_invs_but_extra tcbSchedEnqueue_valid_action hoare_vcg_if_lift2) - apply (rule_tac Q = "\r s. all_invs_but_sch_extra s \ curThread = ksCurThread s + apply (rule_tac Q = "\r s. all_invs_but_sch_extra s \ curThread = ksCurThread s \ (ptr \ curThread \ ct_not_inQ s \ sch_act_wf (ksSchedulerAction s) s \ ct_idle_or_in_cur_domain' s)" in hoare_strengthen_post[rotated]) - apply (clarsimp simp:invs'_def valid_state'_def st_tcb_at'_def[symmetric] - valid_pspace'_def) - apply (erule st_tcb_ex_cap'') - apply simp - apply (case_tac st,simp_all)[1] - apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift]) - apply (rule threadSet_all_invs_but_sch_extra) - prefer 2 - apply clarsimp - apply assumption - apply (wp static_imp_wp threadSet_pred_tcb_no_state threadSet_not_curthread_ct_domain - threadSet_tcbDomain_update_ct_not_inQ | simp)+ - apply (rule_tac Q = "\r s. invs' s \ curThread = ksCurThread s \ sch_act_simple s - \ domain \ maxDomain - \ (ptr \ curThread \ ct_not_inQ s \ sch_act_not ptr s)" + apply (clarsimp simp:invs'_def valid_state'_def st_tcb_at'_def[symmetric] valid_pspace'_def) + apply (erule st_tcb_ex_cap'') + apply simp + apply (case_tac st,simp_all)[1] + apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift]) + apply (rule threadSet_all_invs_but_sch_extra) + prefer 2 + apply clarsimp + apply assumption + apply (wp static_imp_wp threadSet_pred_tcb_no_state threadSet_not_curthread_ct_domain + threadSet_tcbDomain_update_ct_not_inQ | simp)+ + apply (rule_tac Q = "\r s. invs' s \ curThread = ksCurThread s \ sch_act_simple s + \ domain \ maxDomain + \ (ptr \ curThread \ ct_not_inQ s \ sch_act_not ptr s)" in hoare_strengthen_post[rotated]) - apply (clarsimp simp:invs'_def valid_state'_def) - apply (wp hoare_vcg_imp_lift) - apply (clarsimp simp:invs'_def valid_pspace'_def valid_state'_def)+ + apply (clarsimp simp:invs'_def valid_state'_def) + apply (wp hoare_vcg_imp_lift)+ + apply (clarsimp simp:invs'_def valid_pspace'_def valid_state'_def)+ done lemma performInv_invs'[wp]: @@ -1424,9 +1420,9 @@ lemma hinv_corres: apply (simp add: when_def) apply (rule conjI, rule impI) apply (rule reply_from_kernel_tcb_at) - apply (rule impI, wp) + apply (rule impI, wp+) apply (simp)+ - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (simp) apply (wp) apply (simp) @@ -1518,7 +1514,7 @@ lemma hinv_invs'[wp]: apply (fastforce elim!: pred_tcb'_weakenE st_tcb_ex_cap'') apply (clarsimp simp: valid_idle'_def valid_state'_def invs'_def pred_tcb_at'_def obj_at'_def) - apply wp + apply wp+ apply (rule_tac Q="\rv'. invs' and valid_invocation' rv and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. ksCurThread s = thread) @@ -1611,9 +1607,7 @@ lemma delete_caller_cap_corres: apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps) apply (auto simp: can_fast_finalise_def)[1] apply (clarsimp simp: cte_wp_at_ctes_of) - apply (wp getCTE_wp' | simp add: getSlotCap_def)+ - apply (rule no_fail_pre, wp) - apply clarsimp + apply ((wp getCTE_wp')+ | simp add: getSlotCap_def)+ apply clarsimp apply (frule tcb_at_cte_at[where ref="tcb_cnode_index 3"]) apply clarsimp @@ -1642,16 +1636,6 @@ lemma deleteCallerCap_simple[wp]: apply (wp cteDeleteOne_st_tcb_at hoare_drop_imps | simp)+ done -lemma cteDeleteOne_st_tcb_at[wp]: - assumes x[simp]: "\st. simple' st \ P st" shows - "\st_tcb_at' P t\ cteDeleteOne slot \\rv. st_tcb_at' P t\" - apply (subgoal_tac "\Q. P = (Q or simple')") - apply (clarsimp simp: pred_disj_def) - apply (rule cteDeleteOne_st_tcb_at_simplish) - apply (rule_tac x=P in exI) - apply (auto intro!: ext) - done - lemma valid_cap_tcb_at_thread_or_zomb': "\ s \' cap; t \ zobj_refs' cap; tcb_at' t s \ \ isThreadCap cap \ isZombie cap" @@ -1735,7 +1719,7 @@ lemma hw_corres': apply (rule corres_split_nor[OF _ delete_caller_cap_corres]) apply (rule receive_ipc_corres) apply (clarsimp)+ - apply (wp delete_caller_cap_nonz_cap delete_caller_cap_valid_ep_cap) + apply (wp delete_caller_cap_nonz_cap delete_caller_cap_valid_ep_cap)+ apply (clarsimp)+ apply (clarsimp simp: lookup_failure_map_def)+ apply (clarsimp simp: valid_cap'_def capAligned_def) @@ -1759,7 +1743,7 @@ lemma hw_corres': apply (simp add: lookup_cap_def lookup_slot_for_thread_def) apply wp apply (simp add: split_def) - apply (wp resolve_address_bits_valid_fault2) + apply (wp resolve_address_bits_valid_fault2)+ apply (wp getNotification_wp | wpcw | simp add: valid_fault_def whenE_def split del: if_split)+ apply (clarsimp simp add: ct_in_state_def ct_in_state'_def conj_comms invs_valid_tcb_ctable invs_valid_objs tcb_at_invs invs_psp_aligned invs_cur) @@ -1831,7 +1815,7 @@ lemma hw_invs'[wp]: apply (clarsimp simp: isCap_simps ct_in_state'_def pred_tcb_at' invs_valid_objs' sch_act_sane_not obj_at'_def projectKOs pred_tcb_at'_def) apply (assumption) - apply (wp) + apply (wp)+ apply (clarsimp) apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' @@ -1851,21 +1835,6 @@ lemma setSchedulerAction_obj_at'[wp]: crunch_ignore (add: null_cap_on_failure) -(* -lemma ct_idle_or_in_cur_domainD: - "\st_tcb_at' P (ksCurThread s) s; valid_idle' s; - \ P Structures_H.thread_state.IdleThreadState; - ct_idle_or_in_cur_domain' s;tcb_at' (ksCurThread s) s\ - \ obj_at' (\tcb. ksCurDomain s = tcbDomain tcb) (ksCurThread s) s" - apply (simp add:ct_idle_or_in_cur_domain'_def) - apply (erule disjE) - apply (clarsimp simp:valid_idle'_def st_tcb_at'_def obj_at'_def) - apply (simp add:tcb_in_cur_domain'_def) - done -*) - - - lemma hy_corres: "corres dc einvs (invs' and ct_active' and (\s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield" apply (clarsimp simp: handle_yield_def handleYield_def) @@ -1934,14 +1903,14 @@ lemma getIFSR_invs'[wp]: by (simp add: getIFSR_def doMachineOp_def split_def select_f_returns | wp)+ lemma hv_invs'[wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" - apply (simp add: handleVMFault_def ARM_H.handleVMFault_def + apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) apply (rule hoare_pre) apply (wp | wpcw | simp)+ done lemma hv_tcb'[wp]: "\tcb_at' t\ handleVMFault t' vptr \\r. tcb_at' t\" - apply (simp add: handleVMFault_def ARM_H.handleVMFault_def + apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) apply (rule hoare_pre) apply (wp | wpcw)+ @@ -1953,7 +1922,7 @@ crunch nosch[wp]: handleVMFault "\s. P (ksSchedulerAction s)" lemma hv_inv_ex': "\P\ handleVMFault t vp \\_ _. True\, \\_. P\" - apply (simp add: handleVMFault_def ARM_H.handleVMFault_def + apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) apply (rule hoare_pre) apply (wp dmo_inv' getDFSR_inv getFAR_inv getIFSR_inv getRestartPC_inv @@ -2213,7 +2182,7 @@ lemma handleReply_ct_not_ksQ: apply (simp add: handleReply_def del: split_paired_All) apply (subst haskell_assert_def) apply (wp | wpc)+ - apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv) + apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+ apply (rule_tac Q="\cap. (\s. \p. ksCurThread s \ set(ksReadyQueues s p)) and invs' @@ -2226,7 +2195,7 @@ lemma handleReply_ct_not_ksQ: apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def cte_wp_at_ctes_of valid_cap'_def dest!: ctes_of_valid') - apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv) + apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+ apply (clarsimp) done @@ -2239,7 +2208,7 @@ lemma hrw_corres: apply (rule corres_split_nor [OF _ hr_corres]) apply (rule hw_corres') apply (wp handle_reply_nonz_cap_to_ct handleReply_sane - handleReply_nonz_cap_to_ct handleReply_ct_not_ksQ handle_reply_valid_sched) + handleReply_nonz_cap_to_ct handleReply_ct_not_ksQ handle_reply_valid_sched)+ apply (fastforce simp: ct_in_state_def ct_in_state'_def simple_sane_strg elim!: st_tcb_weakenE st_tcb_ex_cap') apply (clarsimp simp: ct_in_state'_def) @@ -2352,7 +2321,7 @@ crunch ksit[wp]: handleVMFault "\s. P (ksIdleThread s)" lemma hv_inv': "\P\ handleVMFault p t \\_. P\" - apply (simp add: handleVMFault_def ARM_H.handleVMFault_def) + apply (simp add: ARM_H.handleVMFault_def) apply (rule hoare_pre) apply (wp dmo_inv' getDFSR_inv getFAR_inv getIFSR_inv getRestartPC_inv det_getRestartPC asUser_inv diff --git a/proof/refine/TcbAcc_R.thy b/proof/refine/TcbAcc_R.thy index b73261b5f..a3ec2c09e 100644 --- a/proof/refine/TcbAcc_R.thy +++ b/proof/refine/TcbAcc_R.thy @@ -198,8 +198,9 @@ lemma doMachineOp_getActiveIRQ_IRQ_active: \\rv s. \irq. rv = Some irq \ intStateIRQTable (ksInterruptState s) irq \ IRQInactive\" apply (rule hoare_lift_Pf3 [where f="ksInterruptState"]) prefer 2 - apply wp[1] - apply (simp add: irq_state_independent_H_def) + apply wp + apply (simp add: irq_state_independent_H_def) + apply assumption apply (rule dmo_lift') apply (rule getActiveIRQ_masked) done @@ -223,7 +224,7 @@ lemma preemptionPoint_irq [wp]: prefer 2 apply (rule doMachineOp_getActiveIRQ_IRQ_active) apply clarsimp - apply wp + apply wp+ apply clarsimp done @@ -338,7 +339,7 @@ lemma threadset_corresT: apply fastforce apply simp apply (rule e) - apply wp + apply wp+ apply (clarsimp simp add: tcb_at_def obj_at_def) apply (drule get_tcb_SomeD) apply fastforce @@ -390,7 +391,7 @@ proof - apply (rule corres_noop [where P=\ and P'=\]) apply simp apply (rule no_fail_pre, wp)[1] - apply wp + apply wp+ apply simp apply (erule pspace_relation_tcb_at[rotated]) apply clarsimp @@ -419,7 +420,7 @@ lemma threadSet_corres_noop_splitT: apply (simp add: x) apply (rule y) apply (rule e) - apply (wp w) + apply (wp w)+ apply simp apply simp done @@ -980,9 +981,7 @@ lemmas threadSet_valid_queues' lemma threadSet_cur: "\\s. cur_tcb' s\ threadSet f t \\rv s. cur_tcb' s\" apply (simp add: threadSet_def cur_tcb'_def) - apply wp - apply (rule hoare_lift_Pf, rule setObject_tcb_at') - apply (wp setObject_ct_inv) + apply (wp hoare_lift_Pf [OF setObject_tcb_at'] setObject_ct_inv) done lemma modifyReadyQueuesL1Bitmap_obj_at[wp]: @@ -1020,24 +1019,10 @@ crunch pde_mappings' [wp]: threadSet valid_pde_mappings' crunch pspace_domain_valid [wp]: threadSet "pspace_domain_valid" (ignore: getObject setObject) - -lemma valid_bitmapQ_ksReadyQueues_update: - "valid_bitmapQ (ksReadyQueues_update Qf s) \ valid_bitmapQ s" - oops - lemma bitmapQ_ksReadyQueues_update_id: "bitmapQ d p (ksReadyQueues_update Qf s) = bitmapQ d p s" by (clarsimp simp: bitmapQ_def) -lemma valid_queues_subset: - "\ Invariants_H.valid_queues (ksReadyQueues_update Qf s); - \d p. set (ksReadyQueues s (d, p)) \ set (Qf (ksReadyQueues s) (d, p)); - \d p. distinct (Qf (ksReadyQueues s) (d, p)) \ distinct (ksReadyQueues s (d, p)); - \d p. Qf (ksReadyQueues s) (d,p) = [] \ ksReadyQueues s (d,p) = [] - \ - \ Invariants_H.valid_queues s" - oops - lemma threadSet_obj_at'_really_strongest: "\\s. tcb_at' t s \ obj_at' (\obj. if t = t' then P (f obj) else P obj) t' s\ threadSet f t \\rv. obj_at' P t'\" @@ -1120,10 +1105,12 @@ lemma lift_neg_pred_tcb_at': apply (rule sttcb) apply (simp add: pred_tcb_at'_def not_obj_at') apply (wp hoare_convert_imp) - apply (rule typat) + apply (rule typat) + prefer 2 + apply assumption apply (rule hoare_chain [OF sttcb]) apply (fastforce simp: pred_tcb_at'_def comp_def) - apply (clarsimp simp: pred_tcb_at'_def elim!: obj_at'_weakenE) + apply (clarsimp simp: pred_tcb_at'_def elim!: obj_at'_weakenE) done lemma threadSet_obj_at'_strongish[wp]: @@ -1156,7 +1143,7 @@ proof - apply (clarsimp)+ apply (wp hoare_convert_imp) apply (simp add: typ_at_tcb' [symmetric]) - apply (wp pos) + apply (wp pos)+ apply (clarsimp simp: pred_tcb_at'_def not_obj_at' elim!: obj_at'_weakenE) done qed @@ -1247,7 +1234,7 @@ lemma threadSet_ksMachine[wp]: lemma threadSet_vms'[wp]: "\valid_machine_state'\ threadSet F t \\rv. valid_machine_state'\" apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def) - by (intro hoare_vcg_all_lift hoare_vcg_disj_lift, wp) + by (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp) lemma vms_ksReadyQueues_update[simp]: "valid_machine_state' (ksReadyQueues_update f s) = valid_machine_state' s" @@ -1264,10 +1251,10 @@ lemma threadSet_not_inQ: threadSet F t \\_. ct_not_inQ\" apply (simp add: threadSet_def ct_not_inQ_def) apply (wp) - apply (rule hoare_convert_imp [OF setObject_nosch]) - apply (rule updateObject_tcb_inv) - apply (wps setObject_ct_inv) - apply (wp setObject_tcb_strongest getObject_tcb_wp) + apply (rule hoare_convert_imp [OF setObject_nosch]) + apply (rule updateObject_tcb_inv) + apply (wps setObject_ct_inv) + apply (wp setObject_tcb_strongest getObject_tcb_wp)+ apply (case_tac "t = ksCurThread s") apply (clarsimp simp: obj_at'_def)+ done @@ -1279,9 +1266,9 @@ lemma threadSet_invs_trivial_helper[simp]: lemma threadSet_ct_idle_or_in_cur_domain': "(\tcb. tcbDomain (F tcb) = tcbDomain tcb) \ \ct_idle_or_in_cur_domain'\ threadSet F t \\_. ct_idle_or_in_cur_domain'\" -apply (rule ct_idle_or_in_cur_domain'_lift) -apply (wp hoare_vcg_disj_lift| simp)+ -done + apply (rule ct_idle_or_in_cur_domain'_lift) + apply (wp hoare_vcg_disj_lift| simp)+ + done crunch ksDomScheduleIdx[wp]: threadSet "\s. P (ksDomScheduleIdx s)" (wp: setObject_ksPSpace_only updateObject_default_inv @@ -1294,7 +1281,7 @@ lemma setObject_tcb_ksDomScheduleIdx [wp]: "\\s. P (ksDomScheduleIdx s) \ setObject t (v::tcb) \\_ s. P (ksDomScheduleIdx s)\" apply (simp add:setObject_def) apply (simp add: updateObject_default_def in_monad) - apply (wp|wpc)+ + apply (wp|wpc)+ apply (simp add: projectKOs) done @@ -1360,10 +1347,7 @@ lemmas threadSet_invs_trivial = lemma zobj_refs'_capRange: "s \' cap \ zobj_refs' cap \ capRange cap" -apply (cases cap) -apply (simp_all add: valid_cap'_def capAligned_def capRange_def - is_aligned_no_overflow) -done + by (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) lemma global'_no_ex_cap: "\valid_global_refs' s; valid_pspace' s\ \ \ ex_nonz_cap_to' (ksIdleThread s) s" @@ -1375,7 +1359,7 @@ lemma global'_no_ex_cap: lemma getObject_tcb_sp: "\P\ getObject r \\t::tcb. P and ko_at' t r\" - by (wp getObject_obj_at', simp) + by (wp getObject_obj_at'; simp) lemma threadSet_valid_objs': "\valid_objs' and (\s. \tcb. valid_tcb' tcb s \ valid_tcb' (f tcb) s)\ @@ -1383,10 +1367,12 @@ lemma threadSet_valid_objs': \\rv. valid_objs'\" apply (simp add: threadSet_def) apply wp + prefer 2 + apply (rule getObject_tcb_sp) + apply (rule hoare_weaken_pre) + apply (rule setObject_tcb_valid_objs) prefer 2 - apply (rule getObject_tcb_sp) - apply (rule hoare_weaken_pre) - apply (rule setObject_tcb_valid_objs) + apply assumption apply (clarsimp simp: valid_obj'_def) apply (frule (1) ko_at_valid_objs') apply (simp add: projectKOs) @@ -1447,7 +1433,7 @@ lemma corres_as_user': apply simp apply (wp select_f_inv | simp)+ apply (rule L1[simplified]) - apply wp + apply wp+ apply auto done qed @@ -1584,9 +1570,9 @@ lemma asUser_pred_tcb_at' [wp]: "\pred_tcb_at' proj P t\ asUser t' f \\_. pred_tcb_at' proj P t\" apply (simp add: asUser_def split_def) apply (wp threadSet_pred_tcb_no_state) - apply (case_tac tcb) - apply (simp add: tcb_to_itcb'_def) - apply (wp select_f_inv) + apply (case_tac tcb) + apply (simp add: tcb_to_itcb'_def) + apply (wpsimp wp: select_f_inv)+ done crunch ct[wp]: asUser "\s. P (ksCurThread s)" @@ -1598,12 +1584,12 @@ crunch cur_domain[wp]: asUser "\s. P (ksCurDomain s)" lemma asUser_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t'\ asUser t m \\_. tcb_in_cur_domain' t'\" -apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def) -apply (wp | wpc | simp)+ -apply (rule_tac f="ksCurDomain" in hoare_lift_Pf) -apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp)+ -apply (clarsimp simp: obj_at'_def) -done + apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def) + apply (wp | wpc | simp)+ + apply (rule_tac f="ksCurDomain" in hoare_lift_Pf) + apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | simp)+ + apply (clarsimp simp: obj_at'_def) + done crunch tcb_in_cur_domain'[wp]: asUser "\s. P (tcb_in_cur_domain' t)" (simp: crunch_simps wp: hoare_drop_imps getObject_inv_tcb setObject_ct_inv @@ -1633,15 +1619,13 @@ lemma asUser_ct_in_state [wp]: lemma asUser_idle'[wp]: "\valid_idle'\ asUser t m \\rv. valid_idle'\" apply (simp add: asUser_def split_def) - apply (wp threadSet_idle') - apply simp+ - apply (wp select_f_inv) + apply (wpsimp wp: threadSet_idle' select_f_inv) done lemma no_fail_asUser [wp]: "no_fail \ f \ no_fail (tcb_at' t) (asUser t f)" apply (simp add: asUser_def split_def) - apply (rule no_fail_pre, wp) + apply wp apply (simp add: no_fail_def) apply (wp hoare_drop_imps) apply simp @@ -1654,9 +1638,7 @@ lemma user_setreg_corres: (asUser t (setRegister r v))" apply (simp add: set_register_def setRegister_def) apply (rule corres_as_user') - apply (rule corres_modify') - apply simp - apply simp + apply (rule corres_modify'; simp) done lemma gts_corres: @@ -1672,23 +1654,22 @@ lemma gts_inv'[wp]: "\P\ getThreadState t \\rv. lemma gts_wf'[wp]: "\tcb_at' t and invs'\ getThreadState t \valid_tcb_state'\" apply (simp add: getThreadState_def threadGet_def liftM_def) - apply wp - apply (rule hoare_chain) - apply (rule getObject_valid_obj) - apply simp - apply (simp add: objBits_simps) - apply clarsimp - apply (simp add: valid_obj'_def valid_tcb'_def) + apply (wp getObject_tcb_wp) + apply clarsimp + apply (drule obj_at_ko_at', clarsimp) + apply (frule ko_at_valid_objs', fastforce, simp add: projectKOs) + apply (fastforce simp: valid_obj'_def valid_tcb'_def) done lemma gts_st_tcb_at'[wp]: "\st_tcb_at' P t\ getThreadState t \\rv s. P rv\" apply (simp add: getThreadState_def threadGet_def liftM_def) apply wp - apply (rule hoare_chain) - apply (rule obj_at_getObject) - apply (clarsimp simp: loadObject_default_def projectKOs in_monad) - apply (simp add: pred_tcb_at'_def) - apply simp + apply (rule hoare_chain) + apply (rule obj_at_getObject) + apply (clarsimp simp: loadObject_default_def projectKOs in_monad) + apply assumption + apply simp + apply (simp add: pred_tcb_at'_def) done lemma gbn_corres: @@ -1705,22 +1686,22 @@ lemma gbn_inv'[wp]: "\P\ getBoundNotification t \\tcb_at' t and invs'\ getBoundNotification t \valid_bound_ntfn'\" apply (simp add: getBoundNotification_def threadGet_def liftM_def) apply wp - apply (rule hoare_chain) + apply (rule hoare_strengthen_post) apply (rule getObject_valid_obj) apply simp apply (simp add: objBits_simps) - apply clarsimp - apply (simp add: valid_obj'_def valid_tcb'_def) + apply (simp add: valid_obj'_def valid_tcb'_def) + apply clarsimp done lemma gbn_bound_tcb_at'[wp]: "\bound_tcb_at' P t\ getBoundNotification t \\rv s. P rv\" apply (simp add: getBoundNotification_def threadGet_def liftM_def) apply wp - apply (rule hoare_chain) + apply (rule hoare_strengthen_post) apply (rule obj_at_getObject) apply (clarsimp simp: loadObject_default_def projectKOs in_monad) - apply (simp add: pred_tcb_at'_def) - apply simp + apply simp + apply (simp add: pred_tcb_at'_def) done lemma isBlocked_def2: @@ -1751,9 +1732,7 @@ lemma isRunnable_inv[wp]: lemma isRunnable_wp[wp]: "\\s. Q (st_tcb_at' (runnable') t s) s\ isRunnable t \Q\" apply (simp add: isRunnable_def2) - apply wp - apply (simp add: getThreadState_def threadGet_def) - apply wp + apply (wpsimp simp: getThreadState_def threadGet_def wp: getObject_tcb_wp) apply (clarsimp simp: getObject_def valid_def in_monad st_tcb_at'_def loadObject_default_def projectKOs obj_at'_def split_def objBits_simps in_magnitude_check) @@ -1841,8 +1820,7 @@ lemma threadGet_obj_at': lemma fun_if_triv[simp]: "(\x. if x = y then f y else f x) = f" - by (force intro: ext) - + by (force) lemma corres_get_etcb: "corres (etcb_relation) (is_etcb_at t) (tcb_at' t) @@ -1882,11 +1860,9 @@ lemma ethreadget_corres: lemma setQueue_corres: "corres dc \ \ (set_tcb_queue d p q) (setQueue d p q)" apply (rule corres_no_failI) - apply (rule no_fail_pre, wp) - apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def - simpler_modify_def) - apply (fastforce simp: state_relation_def ready_queues_relation_def - trans_state_update'[symmetric]) + apply wp + apply (clarsimp simp: setQueue_def in_monad set_tcb_queue_def return_def simpler_modify_def) + apply (fastforce simp: state_relation_def ready_queues_relation_def) done @@ -1915,7 +1891,7 @@ lemma getQueue_corres: "corres op = \ \ (get_tcb_queue qdom prio) (get lemma no_fail_return: "no_fail x (return y)" - by (rule no_fail_pre, wp) + by wp lemma addToBitmap_corres_noop: "corres dc \ \ (return ()) (addToBitmap d p)" @@ -1977,7 +1953,7 @@ proof - apply (rule corres_split_noop_rhs2) apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def exst_same_def) apply (fastforce intro: addToBitmap_corres_noop) - apply wp + apply wp+ apply (simp add: tcb_sched_enqueue_def split del: if_split) apply (rule_tac P=\ and Q="K (t \ set queuea)" in corres_assume_pre) apply (wp setQueue_corres[unfolded dc_def] | simp)+ @@ -2168,12 +2144,12 @@ lemma tcbSchedDequeue_corres: defer apply (simp add: when_def) apply (rule corres_no_failI) - apply (rule no_fail_pre, wp) + apply (wp) apply (clarsimp simp: in_monad ethread_get_def set_tcb_queue_def is_etcb_at_def state_relation_def) apply (subgoal_tac "t \ set (ready_queues a (tcb_domain y) (tcb_priority y))") prefer 2 subgoal by (force simp: tcb_sched_dequeue_def Invariants_H.valid_queues_def valid_queues_no_bitmap_def - ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject) + ready_queues_relation_def obj_at'_def inQ_def projectKO_eq project_inject) apply (subst gets_the_exec) apply (simp add: get_etcb_def) apply (subst gets_the_exec) @@ -2268,13 +2244,6 @@ crunch valid_objs'[wp]: rescheduleRequired valid_objs' crunch valid_objs'[wp]: removeFromBitmap valid_objs' (simp: unless_def valid_tcb_tcbQueued crunch_simps) -lemma removeFromBitmap_valid_objs'2: - "\valid_objs' and (\s. \tcb. valid_tcb' tcb s \ valid_tcb' (f tcb) s)\ - removeFromBitmap d p - \\rv. valid_objs' and (\s. \tcb. valid_tcb' tcb s \ valid_tcb' (f tcb) s)\" - unfolding removeFromBitmap_def modifyReadyQueuesL2Bitmap_def getReadyQueuesL2Bitmap_def -modifyReadyQueuesL1Bitmap_def getReadyQueuesL1Bitmap_def - oops lemma tcbSchedDequeue_valid_objs' [wp]: "\ valid_objs' \ tcbSchedDequeue t \\_. valid_objs' \" unfolding tcbSchedDequeue_def @@ -2409,19 +2378,6 @@ lemma setQueue_valid_queues': setQueue d p ts \\_. valid_queues'\" by (wp | simp add: valid_queues'_def setQueue_def)+ -lemma setQueue_valid_queues: - "\Invariants_H.valid_queues - and (\s. \t \ set ts. obj_at' (inQ d p and runnable' \ tcbState) t s) - and K (distinct ts) and K (d \ maxDomain \ p \ maxPriority)\ - setQueue d p ts - \\_. Invariants_H.valid_queues \" - unfolding Invariants_H.valid_queues_def - apply (wp setQueue_valid_queues_no_bitmap setQueue_valid_bitmapQ, simp_all add: valid_queues_def) - apply (clarsimp simp: valid_bitmapQ_def) - apply (cases ts) - apply simp - oops - lemma setQueue_cur: "\\s. cur_tcb' s\ setQueue d p ts \\rv s. cur_tcb' s\" unfolding setQueue_def cur_tcb'_def @@ -2600,18 +2556,19 @@ lemma threadSet_queued_sch_act_wf[wp]: "\\s. sch_act_wf (ksSchedulerAction s) s\ threadSet (tcbQueued_update f) t \\_ s. sch_act_wf (ksSchedulerAction s) s\" + including no_pre apply (simp add: sch_act_wf_cases - split: scheduler_action.split) + split: scheduler_action.split) apply (wp hoare_vcg_conj_lift) apply (simp add: threadSet_def) apply (wp static_imp_wp) - apply (wps setObject_sa_unchanged) - apply (wp static_imp_wp getObject_tcb_wp)+ + apply (wps setObject_sa_unchanged) + apply (wp static_imp_wp getObject_tcb_wp)+ + apply (clarsimp simp: obj_at'_def) + apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_convert_imp)+ + apply (simp add: threadSet_def) + apply (wp getObject_tcb_wp) apply (clarsimp simp: obj_at'_def) - apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_imp_lift_something)+ - apply (simp add: threadSet_def) - apply (wp getObject_tcb_wp) - apply (clarsimp simp: obj_at'_def) apply (wp tcb_in_cur_domain'_lift | simp add: obj_at'_def)+ done @@ -2635,6 +2592,8 @@ lemma sts_sch_act': setThreadState st t \\rv s. sch_act_wf (ksSchedulerAction s) s\" apply (simp add: setThreadState_def) apply (wp | simp)+ + prefer 2 + apply assumption apply (case_tac "runnable' st") apply ((wp threadSet_runnable_sch_act hoare_drop_imps | simp)+)[1] apply (rule_tac Q="\rv s. st_tcb_at' (Not \ runnable') t s \ @@ -2643,9 +2602,8 @@ lemma sts_sch_act': in hoare_post_imp) apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs) apply (simp only: imp_conv_disj) - apply (rule hoare_pre) - apply (wp threadSet_pred_tcb_at_state threadSet_sch_act_wf - hoare_vcg_disj_lift|simp)+ + apply (wp threadSet_pred_tcb_at_state threadSet_sch_act_wf + hoare_vcg_disj_lift|simp)+ done lemma sts_sch_act[wp]: @@ -2654,7 +2612,9 @@ lemma sts_sch_act[wp]: \\rv s. sch_act_wf (ksSchedulerAction s) s\" apply (simp add: setThreadState_def) apply wp - apply simp + apply simp + prefer 2 + apply assumption apply (case_tac "runnable' st") apply (rule_tac Q="\s. sch_act_wf (ksSchedulerAction s) s" in hoare_pre_imp, simp) @@ -2807,16 +2767,6 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_complement_bit_set: - "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" - using prioToL1Index_max[simplified wordRadix_def] - apply (subst word_ops_nth_size, simp_all add: wordRadix_def word_size) - apply (subst prioToL1Index_bit_set) - apply (subgoal_tac "unat p < 256") - apply (simp add: prioToL1Index_def) - apply (subgoal_tac "unat (p >> 5) < 32") - oops - lemma prioToL1Index_bit_not_set: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set) @@ -3130,9 +3080,9 @@ proof - apply (simp add: unless_def) apply (wp threadSet_valid_queues_could_run) apply (wp addToBitmap_could_run addToBitmap_valid_bitmapQ - addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans) + addToBitmap_valid_queues_no_bitmap_except addToBitmap_bitmapQ_no_L2_orphans)+ apply (wp setQueue_valid_queues_no_bitmap_except setQueue_could_run - setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ) + setQueue_valid_bitmapQ_except setQueue_sets_queue setQueue_valid_bitmapQ)+ apply (wp threadGet_const_tcb_at_imp_lift | simp add: if_apply_def2)+ apply clarsimp apply (frule pred_tcb_at') @@ -3200,11 +3150,11 @@ lemma rescheduleRequired_valid_bitmapQ_sch_act_simple: "\ valid_bitmapQ and sch_act_simple\ rescheduleRequired \\_. valid_bitmapQ \" + including no_pre apply (simp add: rescheduleRequired_def sch_act_simple_def) apply (rule_tac B="\rv s. valid_bitmapQ s \ (rv = ResumeCurrentThread \ rv = ChooseNewThread)" in hoare_seq_ext) - apply wp - apply simp + apply wpsimp apply (case_tac x; simp) apply (wp, fastforce) done @@ -3213,11 +3163,11 @@ lemma rescheduleRequired_bitmapQ_no_L1_orphans_sch_act_simple: "\ bitmapQ_no_L1_orphans and sch_act_simple\ rescheduleRequired \\_. bitmapQ_no_L1_orphans \" + including no_pre apply (simp add: rescheduleRequired_def sch_act_simple_def) apply (rule_tac B="\rv s. bitmapQ_no_L1_orphans s \ (rv = ResumeCurrentThread \ rv = ChooseNewThread)" in hoare_seq_ext) - apply wp - apply simp + apply wpsimp apply (case_tac x; simp) apply (wp, fastforce) done @@ -3226,11 +3176,11 @@ lemma rescheduleRequired_bitmapQ_no_L2_orphans_sch_act_simple: "\ bitmapQ_no_L2_orphans and sch_act_simple\ rescheduleRequired \\_. bitmapQ_no_L2_orphans \" + including no_pre apply (simp add: rescheduleRequired_def sch_act_simple_def) apply (rule_tac B="\rv s. bitmapQ_no_L2_orphans s \ (rv = ResumeCurrentThread \ rv = ChooseNewThread)" in hoare_seq_ext) - apply wp - apply simp + apply wpsimp apply (case_tac x; simp) apply (wp, fastforce) done @@ -3387,13 +3337,13 @@ lemma rescheduleRequired_ksQ: "\\s. sch_act_simple s \ P (ksReadyQueues s p)\ rescheduleRequired \\_ s. P (ksReadyQueues s p)\" + including no_pre apply (simp add: rescheduleRequired_def sch_act_simple_def) apply (rule_tac B="\rv s. (rv = ResumeCurrentThread \ rv = ChooseNewThread) \ P (ksReadyQueues s p)" in hoare_seq_ext) - apply (wp | clarsimp)+ - apply (case_tac "x") - apply (clarsimp)+ - apply (wp) + apply wpsimp + apply (case_tac x; simp) + apply wp done lemma setSchedulerAction_ksQ[wp]: @@ -3429,23 +3379,17 @@ lemma setQueue_ksQ[wp]: lemma tcbSchedEnqueue_ksQ: "\\s. t' \ set (ksReadyQueues s p) \ t' \ t \ tcbSchedEnqueue t \\_ s. t' \ set (ksReadyQueues s p)\" - (is "\?PRE\ _ \_\") apply (simp add: tcbSchedEnqueue_def unless_def) - apply (wp) - apply (clarsimp, wp) - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply (wp) - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply (wp) + apply (wpsimp wp: hoare_vcg_imp_lift threadGet_wp) + apply (drule obj_at_ko_at') + apply fastforce done lemma rescheduleRequired_ksQ': "\\s. t \ set (ksReadyQueues s p) \ sch_act_not t s \ rescheduleRequired \\_ s. t \ set (ksReadyQueues s p)\" - (is "\?PRE\ _ \_\") apply (simp add: rescheduleRequired_def) - apply (wp, wpc, wp tcbSchedEnqueue_ksQ) - apply (clarsimp) + apply (wpsimp wp: tcbSchedEnqueue_ksQ) done crunch ksQ[wp]: getCurThread "\s. P (ksReadyQueues s p)" @@ -3453,18 +3397,12 @@ crunch ksQ[wp]: getCurThread "\s. P (ksReadyQueues s p)" lemma threadSet_tcbState_st_tcb_at': "\\s. P st \ threadSet (tcbState_update (\_. st)) t \\_. st_tcb_at' P t\" apply (simp add: threadSet_def pred_tcb_at'_def) - apply (wp setObject_tcb_strongest) - apply (clarsimp) - apply (wp) + apply (wpsimp wp: setObject_tcb_strongest) done lemma isRunnable_const: "\st_tcb_at' runnable' t\ isRunnable t \\runnable _. runnable \" - apply (simp add: isRunnable_def) - apply (wp) - apply (erule pred_tcb'_weakenE) - apply (case_tac st, clarsimp+) - done + by (rule isRunnable_wp) lemma sts_ksQ': "\\s. (runnable' st \ ksCurThread s \ t) \ P (ksReadyQueues s p)\ @@ -3583,18 +3521,18 @@ lemma store_word_offs_corres: apply (rule no_fail_pre) apply (wp no_fail_storeWord) apply (erule_tac n=msg_align_bits in aligned_add_aligned) - apply (rule is_aligned_mult_triv2 [where n = 2, simplified]) - apply (simp add: word_bits_conv msg_align_bits)+ + apply (rule is_aligned_mult_triv2 [where n = 2, simplified]) + apply (simp add: word_bits_conv msg_align_bits)+ apply (simp add: stateAssert_def) apply (rule_tac r'=dc in corres_split) apply (rule corres_assert) apply (rule corres_trivial) apply simp - apply wp + apply wp+ apply (simp add: in_user_frame_eq[OF y]) apply simp apply (rule conjI) - apply (frule (1) valid_ipc_buffer_ptr'D [OF y]) + apply (frule (1) valid_ipc_buffer_ptr'D [OF y]) apply (simp add: valid_ipc_buffer_ptr'_def) done @@ -3664,9 +3602,9 @@ lemma get_mrs_corres: apply (case_tac mi, simp add: get_mrs_def getMRs_def split del: if_split) apply (case_tac buf) apply (rule corres_guard_imp) - apply (rule corres_split [where R = "\_. \" and R' = "\_. \", OF _ T]) + apply (rule corres_split [where R = "\_. \" and R' = "\_. \", OF _ T]) apply simp - apply wp + apply wp+ apply simp apply simp apply (rule corres_guard_imp) @@ -3681,14 +3619,14 @@ lemma get_mrs_corres: apply simp apply simp apply (simp add: word_size wordSize_def wordBits_def) - apply (rule load_word_offs_corres) + apply (rule load_word_offs_corres) apply simp - apply wp + apply wp+ apply simp - apply (unfold msg_registers_def msgRegisters_unfold)[1] + apply (unfold msgRegisters_unfold)[1] apply simp apply (clarsimp simp: set_zip) - apply (simp add: msg_registers_def msgRegisters_unfold max_ipc_words nth_append) + apply (simp add: msgRegisters_unfold max_ipc_words nth_append) apply (wp hoare_vcg_all_lift | simp add: valid_ipc_buffer_ptr'_def)+ done qed @@ -3799,12 +3737,12 @@ proof - apply (rule_tac S="{((x, y), (x', y')). y = y' \ x' = (a + (of_nat x * 4)) \ x < unat max_ipc_words}" in zipWithM_x_corres) apply (fastforce intro: store_word_offs_corres) - apply wp + apply wp+ apply (clarsimp simp add: S msgMaxLength_def msg_max_length_def set_zip) apply (simp add: wordSize_def wordBits_def word_size max_ipc_words upt_Suc_append[symmetric] upto_enum_word) apply simp - apply wp + apply wp+ apply (rule corres_modify') apply (simp only: msgRegisters_unfold cong: if_cong) apply (fastforce simp: fold_fun_upd[symmetric]) @@ -3859,7 +3797,7 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split_nor [OF _ as_user_bit]) apply (rule corres_trivial, simp) - apply wp + apply wp+ apply simp apply simp apply (cases rb) @@ -3867,7 +3805,7 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split_nor [OF _ as_user_bit]) apply (rule corres_trivial, simp) - apply wp + apply wp+ apply simp apply simp apply (simp add: R del: upt.simps) @@ -3975,8 +3913,7 @@ lemma lipcb_corres': (tcb_at' t and valid_objs' and pspace_aligned' and pspace_distinct' and no_0_obj') (lookup_ipc_buffer w t) (lookupIPCBuffer w t)" - apply (simp add: lookup_ipc_buffer_def lookupIPCBuffer_def - ARM_H.lookupIPCBuffer_def) + apply (simp add: lookup_ipc_buffer_def ARM_H.lookupIPCBuffer_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ threadget_corres]) apply (simp add: getThreadBufferSlot_def locateSlot_conv) @@ -4010,9 +3947,9 @@ lemma lipcb_corres': apply (clarsimp simp: valid_cap_def obj_at_def no_0_obj_kheap obj_relation_cuts_def3 no_0_obj'_def split:if_split_asm) apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def tcbIPCBufferSlot_def) - apply (wp get_cap_valid_ipc get_cap_aligned) + apply (wp get_cap_valid_ipc get_cap_aligned)+ apply (simp add: tcb_relation_def) - apply (wp thread_get_obj_at_eq) + apply (wp thread_get_obj_at_eq)+ apply (clarsimp elim!: tcb_at_cte_at) apply clarsimp done @@ -4042,7 +3979,7 @@ lemma setThreadState_st_tcb: apply simp apply (rule hoare_post_imp [OF _ setThreadState_st_tcb']) apply (erule pred_tcb'_weakenE, simp) - apply (simp add: hoare_pre_cont) + apply simp done lemma setBoundNotification_bound_tcb': @@ -4057,7 +3994,7 @@ lemma setBoundNotification_bound_tcb: apply simp apply (rule hoare_post_imp [OF _ setBoundNotification_bound_tcb']) apply (erule pred_tcb'_weakenE, simp) - apply (simp add: hoare_pre_cont) + apply simp done crunch ct'[wp]: rescheduleRequired "\s. P (ksCurThread s)" @@ -4227,10 +4164,6 @@ crunch distinct'[wp]: setThreadState, setBoundNotification pspace_distinct' crunch cte_wp_at'[wp]: setThreadState, setBoundNotification "cte_wp_at' P p" (wp: hoare_when_weak_wp simp: unless_def) -lemma state_refs_of'_queues[simp]: - "state_refs_of' (ksReadyQueues_update f s) = state_refs_of' s" - by (fastforce elim!: state_refs_of'_pspaceI intro!: ext) - crunch refs_of'[wp]: rescheduleRequired "\s. P (state_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_refs_of' ignore: threadSet) @@ -4239,10 +4172,9 @@ lemma setThreadState_state_refs_of'[wp]: \ {r \ state_refs_of' s t. snd r = TCBBound}))\ setThreadState st t \\rv s. P (state_refs_of' s)\" - by (simp add: setThreadState_def + by (simp add: setThreadState_def fun_upd_def | wp threadSet_state_refs_of')+ - lemma setBoundNotification_state_refs_of'[wp]: "\\s. P ((state_refs_of' s) (t := tcb_bound_refs' ntfn \ {r \ state_refs_of' s t. snd r \ TCBBound}))\ @@ -4251,27 +4183,13 @@ lemma setBoundNotification_state_refs_of'[wp]: by (simp add: setBoundNotification_def Un_commute fun_upd_def | wp threadSet_state_refs_of' )+ -lemma threadSet_ksCurThread[wp]: - "\\s. P (ksCurThread s)\ threadSet t f \\rv s. P (ksCurThread s)\" - by (clarsimp simp: threadSet_def valid_def in_monad - setObject_def split_def getObject_def - dest!: in_inv_by_hoareD [OF updateObject_default_inv] - in_inv_by_hoareD [OF loadObject_default_inv]) - lemma sts_cur_tcb'[wp]: "\cur_tcb'\ setThreadState st t \\rv. cur_tcb'\" - apply (wp cur_tcb_lift) - done + by (wp cur_tcb_lift) lemma sbn_cur_tcb'[wp]: "\cur_tcb'\ setBoundNotification ntfn t \\rv. cur_tcb'\" - apply (wp cur_tcb_lift) - done - -lemma iflive'_queues[simp]: - "if_live_then_nonz_cap' (ksReadyQueues_update f s) - = if_live_then_nonz_cap' s" - by (fastforce intro: if_live_then_nonz_cap'_pspaceI) + by (wp cur_tcb_lift) crunch iflive'[wp]: setQueue if_live_then_nonz_cap' crunch nonz_cap[wp]: setQueue "ex_nonz_cap_to' t" @@ -4387,11 +4305,11 @@ lemmas setBoundNotification_irq_handlers[wp] lemma sts_global_reds' [wp]: "\valid_global_refs'\ setThreadState st t \\_. valid_global_refs'\" - by (rule valid_global_refs_lift') wp + by (rule valid_global_refs_lift'; wp) lemma sbn_global_reds' [wp]: "\valid_global_refs'\ setBoundNotification ntfn t \\_. valid_global_refs'\" - by (rule valid_global_refs_lift') wp + by (rule valid_global_refs_lift'; wp) crunch irq_states' [wp]: setThreadState, setBoundNotification valid_irq_states' (simp: unless_def crunch_simps) @@ -4421,7 +4339,7 @@ crunch pspace_domain_valid[wp]: setThreadState, setBoundNotification "pspace_dom lemma setThreadState_vms'[wp]: "\valid_machine_state'\ setThreadState F t \\rv. valid_machine_state'\" apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def) - apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift, wp) + apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp) done lemma ct_not_inQ_addToBitmap[wp]: @@ -4438,7 +4356,7 @@ lemma ct_not_inQ_removeFromBitmap[wp]: lemma setBoundNotification_vms'[wp]: "\valid_machine_state'\ setBoundNotification ntfn t \\rv. valid_machine_state'\" apply (simp add: valid_machine_state'_def pointerInUserData_def pointerInDeviceData_def) - apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift, wp) + apply (intro hoare_vcg_all_lift hoare_vcg_disj_lift; wp) done lemma tcbSchedEnqueue_ct_not_inQ: @@ -4464,11 +4382,12 @@ lemma tcbSchedEnqueue_ct_not_inQ: done show ?thesis apply (simp add: tcbSchedEnqueue_def unless_def null_def) - apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct']) - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply (wp sq hoare_convert_imp [OF setQueue_no_sa setQueue_ct']) - apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) - apply wp + apply (wp ts sq hoare_convert_imp [OF addToBitmap_nosch addToBitmap_ct'])+ + apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) + apply (wp sq hoare_convert_imp [OF setQueue_no_sa setQueue_ct'])+ + apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) + apply wp + apply assumption done qed @@ -4540,13 +4459,15 @@ lemma threadSet_tcbState_update_ct_not_inQ[wp]: apply (rule hoare_convert_imp [OF threadSet_no_sa]) apply (simp add: threadSet_def) apply (wp) - apply (wps setObject_ct_inv) - apply (rule setObject_tcb_strongest) + apply (wps setObject_ct_inv) + apply (rule setObject_tcb_strongest) + prefer 2 + apply assumption apply (clarsimp) apply (rule hoare_conjI) apply (rule hoare_weaken_pre) apply (wps, wp static_imp_wp) - apply (wp OMG_getObject_tcb) + apply (wp OMG_getObject_tcb)+ apply (clarsimp simp: comp_def) apply (wp hoare_drop_imp) done @@ -4557,8 +4478,10 @@ lemma threadSet_tcbBoundNotification_update_ct_not_inQ[wp]: apply (rule hoare_convert_imp [OF threadSet_no_sa]) apply (simp add: threadSet_def) apply (wp) - apply (wps setObject_ct_inv) - apply (rule setObject_tcb_strongest) + apply (wps setObject_ct_inv) + apply (rule setObject_tcb_strongest) + prefer 2 + apply assumption apply (clarsimp) apply (rule hoare_conjI) apply (rule hoare_weaken_pre) @@ -4572,6 +4495,7 @@ lemma threadSet_tcbBoundNotification_update_ct_not_inQ[wp]: lemma setThreadState_ct_not_inQ: "\ct_not_inQ\ setThreadState st t \\_. ct_not_inQ\" (is "\?PRE\ _ \_\") + including no_pre apply (simp add: setThreadState_def) apply (wp rescheduleRequired_ct_not_inQ) apply (rule_tac Q="\_. ?PRE" in hoare_post_imp, clarsimp) @@ -4595,8 +4519,8 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]: apply (wp hoare_convert_imp [OF threadSet_no_sa]) apply (simp add: threadSet_def) apply (wp) - apply (wps setObject_ct_inv) - apply (wp setObject_tcb_strongest getObject_tcb_wp) + apply (wps setObject_ct_inv) + apply (wp setObject_tcb_strongest getObject_tcb_wp)+ apply (case_tac "t = ksCurThread s") apply (clarsimp simp: obj_at'_def)+ done @@ -4609,25 +4533,25 @@ lemma tcbSchedDequeue_ct_not_inQ[wp]: lemma tcbSchedEnqueue_not_st: "(\tcb st qd. P (tcb\tcbState := st, tcbQueued := qd\) \ P tcb) \ \obj_at' P t'\ tcbSchedEnqueue t \\_. obj_at' P t'\" -apply (simp add: tcbSchedEnqueue_def unless_def) -apply (wp threadGet_wp | simp)+ -apply (clarsimp simp: obj_at'_def) -apply (case_tac obja) -apply fastforce -done + apply (simp add: tcbSchedEnqueue_def unless_def) + apply (wp threadGet_wp | simp)+ + apply (clarsimp simp: obj_at'_def) + apply (case_tac obja) + apply fastforce + done lemma setThreadState_not_st: "(\tcb st qd. P (tcb\tcbState := st, tcbQueued := qd\) \ P tcb) \ \obj_at' P t'\ setThreadState st t \\_. obj_at' P t'\" -apply (simp add: setThreadState_def rescheduleRequired_def) -apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st - | wpc - | rule hoare_drop_imps - | simp)+ -apply (clarsimp simp: obj_at'_def) -apply (case_tac obj) -apply fastforce -done + apply (simp add: setThreadState_def rescheduleRequired_def) + apply (wp hoare_vcg_conj_lift tcbSchedEnqueue_not_st + | wpc + | rule hoare_drop_imps + | simp)+ + apply (clarsimp simp: obj_at'_def) + apply (case_tac obj) + apply fastforce + done crunch ct_idle_or_in_cur_domain'[wp]: setQueue ct_idle_or_in_cur_domain' (simp: ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) @@ -4659,21 +4583,21 @@ lemma removeFromBitmap_ct_idle_or_in_cur_domain'[wp]: lemma tcbSchedEnqueue_ksCurDomain[wp]: "\ \s. P (ksCurDomain s)\ tcbSchedEnqueue tptr \\_ s. P (ksCurDomain s)\" -apply (simp add: tcbSchedEnqueue_def unless_def) -apply (wp | simp)+ -done + apply (simp add: tcbSchedEnqueue_def unless_def) + apply wpsimp + done lemma tcbSchedEnqueue_ksDomSchedule[wp]: "\ \s. P (ksDomSchedule s)\ tcbSchedEnqueue tptr \\_ s. P (ksDomSchedule s)\" -apply (simp add: tcbSchedEnqueue_def unless_def) -apply (wp | simp)+ -done + apply (simp add: tcbSchedEnqueue_def unless_def) + apply wpsimp + done lemma tcbSchedEnqueue_ct_idle_or_in_cur_domain'[wp]: "\ct_idle_or_in_cur_domain'\ tcbSchedEnqueue tptr \\_. ct_idle_or_in_cur_domain'\" -apply (simp add: tcbSchedEnqueue_def unless_def) -apply (wp threadSet_ct_idle_or_in_cur_domain' | simp)+ -done + apply (simp add: tcbSchedEnqueue_def unless_def) + apply (wp threadSet_ct_idle_or_in_cur_domain' | simp)+ + done lemma setSchedulerAction_spec: "\\\setSchedulerAction ChooseNewThread @@ -4685,57 +4609,55 @@ lemma setSchedulerAction_spec: lemma rescheduleRequired_ct_idle_or_in_cur_domain'[wp]: "\\\ rescheduleRequired \\rv. ct_idle_or_in_cur_domain'\" -apply (simp add: rescheduleRequired_def) -apply (wp setSchedulerAction_spec) -done + apply (simp add: rescheduleRequired_def) + apply (wp setSchedulerAction_spec) + done lemma rescheduleRequired_ksCurDomain[wp]: "\ \s. P (ksCurDomain s) \ rescheduleRequired \\_ s. P (ksCurDomain s) \" -apply (simp add: rescheduleRequired_def) -apply (wp | wpc | simp )+ -done + apply (simp add: rescheduleRequired_def) + apply wpsimp + done lemma rescheduleRequired_ksDomSchedule[wp]: "\ \s. P (ksDomSchedule s) \ rescheduleRequired \\_ s. P (ksDomSchedule s) \" -apply (simp add: rescheduleRequired_def) -apply (wp | wpc | simp )+ -done + by (simp add: rescheduleRequired_def) wpsimp lemma setThreadState_ct_idle_or_in_cur_domain'[wp]: "\ct_idle_or_in_cur_domain'\ setThreadState st tptr \\rv. ct_idle_or_in_cur_domain'\" -apply (simp add: setThreadState_def) -apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+ -done + apply (simp add: setThreadState_def) + apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+ + done lemma setThreadState_ksCurDomain[wp]: "\ \s. P (ksCurDomain s) \ setThreadState st tptr \\_ s. P (ksCurDomain s) \" -apply (simp add: setThreadState_def) -apply (wp | simp)+ -done + apply (simp add: setThreadState_def) + apply wpsimp + done lemma setThreadState_ksDomSchedule[wp]: "\ \s. P (ksDomSchedule s) \ setThreadState st tptr \\_ s. P (ksDomSchedule s) \" -apply (simp add: setThreadState_def) -apply (wp | simp)+ -done + apply (simp add: setThreadState_def) + apply wpsimp + done lemma setBoundNotification_ct_idle_or_in_cur_domain'[wp]: "\ct_idle_or_in_cur_domain'\ setBoundNotification t a \\rv. ct_idle_or_in_cur_domain'\" -apply (simp add: setBoundNotification_def) -apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+ -done + apply (simp add: setBoundNotification_def) + apply (wp threadSet_ct_idle_or_in_cur_domain' hoare_drop_imps | simp)+ + done lemma setBoundNotification_ksCurDomain[wp]: "\ \s. P (ksCurDomain s) \ setBoundNotification st tptr \\_ s. P (ksCurDomain s) \" -apply (simp add: setBoundNotification_def) -apply (wp | simp)+ -done + apply (simp add: setBoundNotification_def) + apply wpsimp + done lemma setBoundNotification_ksDomSchedule[wp]: "\ \s. P (ksDomSchedule s) \ setBoundNotification st tptr \\_ s. P (ksDomSchedule s) \" -apply (simp add: setBoundNotification_def) -apply (wp | simp)+ -done + apply (simp add: setBoundNotification_def) + apply wpsimp + done crunch ksDomScheduleIdx[wp]: rescheduleRequired, setBoundNotification, setThreadState "\s. P (ksDomScheduleIdx s)" @@ -4748,8 +4670,7 @@ crunch gsUntypedZeroRanges[wp]: rescheduleRequired, setBoundNotification, lemma sts_utr[wp]: "\untyped_ranges_zero'\ setThreadState st t \\_. untyped_ranges_zero'\" apply (simp add: cteCaps_of_def) - apply (rule hoare_pre, wp untyped_ranges_zero_lift) - apply (simp add: o_def) + apply (wp untyped_ranges_zero_lift) done lemma sts_invs_minor': @@ -4763,6 +4684,7 @@ lemma sts_invs_minor': and invs'\ setThreadState st t \\rv. invs'\" + including no_pre apply (simp add: invs'_def valid_state'_def) apply (rule hoare_pre) apply (wp sts_valid_queues valid_irq_node_lift irqs_masked_lift @@ -4788,6 +4710,7 @@ lemma sbn_invs_minor': and invs'\ setBoundNotification ntfn t \\rv. invs'\" + including no_pre apply (simp add: invs'_def valid_state'_def) apply (rule hoare_pre) apply (wp irqs_masked_lift valid_irq_node_lift setBoundNotification_valid_queues' sbn_valid_queues @@ -4895,24 +4818,21 @@ lemma threadSet_ct_running': \ct_running'\ threadSet f t \\rv. ct_running'\" apply (simp add: ct_in_state'_def) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply (wp threadSet_pred_tcb_no_state) - apply simp + apply (wp threadSet_pred_tcb_no_state; simp) apply wp done lemma setThreadState_tcb_in_cur_domain'[wp]: "\tcb_in_cur_domain' t'\ setThreadState st t \\_. tcb_in_cur_domain' t'\" -apply (simp add: tcb_in_cur_domain'_def) -apply (rule hoare_pre) -apply wps -apply (wp setThreadState_not_st | simp)+ -done + apply (simp add: tcb_in_cur_domain'_def) + apply (rule hoare_pre) + apply wps + apply (wp setThreadState_not_st | simp)+ + done lemma asUser_global_refs': "\valid_global_refs'\ asUser t f \\rv. valid_global_refs'\" apply (simp add: asUser_def split_def) - apply (wp threadSet_global_refs) - apply simp+ - apply (wp select_f_inv) + apply (wpsimp wp: threadSet_global_refs select_f_inv) done lemma sch_act_sane_lift: @@ -4922,7 +4842,7 @@ lemma sch_act_sane_lift: apply (simp add: sch_act_sane_def) apply (rule hoare_vcg_all_lift) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply (wp assms) + apply (wp assms)+ done lemma storeWord_invs'[wp]: @@ -4986,7 +4906,7 @@ lemma storeWordUser_invs_no_cicd'[wp]: lemma hoare_valid_ipc_buffer_ptr_typ_at': "(\q. \typ_at' UserDataT q\ a \\_. typ_at' UserDataT q\) \ \valid_ipc_buffer_ptr' p\ a \\_. valid_ipc_buffer_ptr' p\" - unfolding valid_ipc_buffer_ptr'_def2 + unfolding valid_ipc_buffer_ptr'_def2 including no_pre apply wp apply assumption done @@ -5019,7 +4939,7 @@ lemma get_cap_corres_all_rights_P: apply (rule corres_guard_imp) apply (rule corres_split [OF _ get_cap_corres_P [where P=P]]) defer - apply (wp getCTE_wp') + apply (wp getCTE_wp')+ apply simp apply fastforce apply (insert cap_relation_masks, simp) @@ -5028,9 +4948,7 @@ lemma get_cap_corres_all_rights_P: lemma asUser_irq_handlers': "\valid_irq_handlers'\ asUser t f \\rv. valid_irq_handlers'\" apply (simp add: asUser_def split_def) - apply (wp threadSet_irq_handlers' [OF all_tcbI, OF ball_tcb_cte_casesI]) - apply simp+ - apply (wp select_f_inv) + apply (wpsimp wp: threadSet_irq_handlers' [OF all_tcbI, OF ball_tcb_cte_casesI] select_f_inv) done (* the brave can try to move this up to near tcb_update_corres' *) @@ -5135,7 +5053,7 @@ lemma ethread_set_corresT: apply (rule x) apply (erule e) apply (simp add: z)+ - apply wp + apply wp+ apply clarsimp apply (simp add: valid_etcbs_def tcb_at_st_tcb_at[symmetric]) apply (force simp: tcb_at_def get_etcb_def obj_at_def) diff --git a/proof/refine/Tcb_R.thy b/proof/refine/Tcb_R.thy index e092edf61..40d311e71 100644 --- a/proof/refine/Tcb_R.thy +++ b/proof/refine/Tcb_R.thy @@ -55,7 +55,7 @@ lemma activate_corres: apply (rule activate_idle_thread_corres) apply (clarsimp elim!: st_tcb_weakenE) apply (clarsimp elim!: pred_tcb'_weakenE) - apply (wp gts_st_tcb gts_st_tcb' gts_st_tcb_at) + apply (wp gts_st_tcb gts_st_tcb' gts_st_tcb_at)+ apply (clarsimp simp: ct_in_state_def tcb_at_invs elim!: st_tcb_weakenE) apply (clarsimp simp: tcb_at_invs' ct_in_state'_def @@ -73,7 +73,7 @@ lemma bind_notification_corres: apply (rule corres_split[OF _ set_ntfn_corres]) apply (rule sbn_corres) apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) - apply (wp) + apply (wp)+ apply auto done @@ -108,7 +108,7 @@ lemma activate_invs': \ (runnable' state \ idle' state)" in hoare_seq_ext) apply (case_tac x, simp_all add: isTS_defs hoare_pre_cont split del: if_splits cong: if_cong) - apply (rule hoare_pre, wp) + apply (wp) apply (clarsimp simp: ct_in_state'_def) apply (rule_tac Q="\rv. invs' and ct_idle'" in hoare_post_imp, simp) apply (wp activateIdle_invs) @@ -122,14 +122,13 @@ lemma activate_invs': and sch_act_simple and invs' and (\s. thread = ksCurThread s)" in hoare_post_imp, clarsimp) - apply (wp sch_act_simple_lift) + apply (wp sch_act_simple_lift)+ apply (clarsimp simp: valid_idle'_def invs'_def valid_state'_def pred_tcb_at'_def obj_at'_def elim!: pred_tcb'_weakenE) - apply (wp gts_st_tcb') - apply (clarsimp simp: tcb_at_invs' ct_in_state'_def + apply (wp gts_st_tcb')+ + apply (clarsimp simp: tcb_at_invs' ct_in_state'_def pred_disj_def) - apply simp done crunch nosch[wp]: activateIdleThread "\s. P (ksSchedulerAction s)" @@ -145,7 +144,7 @@ lemma setThreadState_runnable_simp: apply (drule use_valid[OF _ threadSet_pred_tcb_at_state[where proj="itcbState" and p=t and P="op = ts"]]) apply simp apply (subst bind_known_operation_eq) - apply wp + apply wp+ apply clarsimp apply (subst eq_commute, erule conjI[OF _ refl]) apply (rule empty_fail_getThreadState) @@ -202,9 +201,10 @@ lemma setupReplyMaster_weak_sch_act_wf[wp]: \\rv s. weak_sch_act_wf (ksSchedulerAction s) s\" apply (simp add: setupReplyMaster_def) apply (wp) - apply (rule_tac Q="\_ s. weak_sch_act_wf (ksSchedulerAction s) s" - in hoare_post_imp, clarsimp) - apply (wp) + apply (rule_tac Q="\_ s. weak_sch_act_wf (ksSchedulerAction s) s" + in hoare_post_imp, clarsimp) + apply (wp)+ + apply assumption done crunch valid_queues[wp]: setupReplyMaster "Invariants_H.valid_queues" @@ -229,7 +229,7 @@ lemma restart_corres: apply (rule_tac Q="\rv. invs' and tcb_at' t" in hoare_strengthen_post) apply wp apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak valid_pspace'_def) - apply wp + apply wp+ apply (simp add: valid_sched_def invs_def tcb_at_is_etcb_at) apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak) done @@ -238,9 +238,9 @@ lemma setupReplyMaster_sch_act_simple[wp]: "\sch_act_simple\ setupReplyMaster thread \\_. sch_act_simple\" apply (simp add: setupReplyMaster_def sch_act_simple_def) apply (wp) - apply (rule_tac Q="\_. sch_act_simple" in hoare_post_imp, - clarsimp simp: sch_act_simple_def) - apply (wp) + apply (rule_tac Q="\_. sch_act_simple" in hoare_post_imp, + clarsimp simp: sch_act_simple_def) + apply (wp)+ apply (simp add: sch_act_simple_def) done @@ -251,15 +251,17 @@ lemma restart_invs': apply (wp setThreadState_nonqueued_state_update cancelIPC_simple setThreadState_st_tcb | wp_once sch_act_simple_lift)+ - apply (wp hoare_convert_imp) - apply (wp setThreadState_nonqueued_state_update - setThreadState_st_tcb) + apply (wp hoare_convert_imp) + apply (wp setThreadState_nonqueued_state_update + setThreadState_st_tcb) + apply (clarsimp) + apply (wp hoare_convert_imp)[1] apply (clarsimp) - apply (wp hoare_convert_imp)[1] - apply (clarsimp) - apply (wp) - apply (clarsimp simp: comp_def) - apply (rule hoare_strengthen_post, rule gts_sp') + apply (wp)+ + apply (clarsimp simp: comp_def) + apply (rule hoare_strengthen_post, rule gts_sp') + prefer 2 + apply assumption apply (clarsimp simp: pred_tcb_at' invs'_def valid_state'_def ct_in_state'_def) apply (fastforce simp: pred_tcb_at'_def obj_at'_def) @@ -268,33 +270,12 @@ lemma restart_invs': lemma restart_tcb'[wp]: "\tcb_at' t'\ ThreadDecls_H.restart t \\rv. tcb_at' t'\" apply (simp add: restart_def isBlocked_def2) - apply wp - apply simp - apply wp + apply wpsimp done -lemma - no_fail_setRegister: "no_fail \ (setRegister r v)" +lemma no_fail_setRegister: "no_fail \ (setRegister r v)" by (simp add: setRegister_def) -lemma copyRegsToArea_invs[wp]: - "\invs\ copyRegsToArea regs a b \\rv. invs\" - apply (simp add: copyRegsToArea_def) - apply (wp zipWithM_x_inv) - apply simp - apply wp - done - -lemma copyAreaToRegs_invs[wp]: - "\invs and tcb_at b\ copyAreaToRegs regs a b \\rv. invs\" - apply (simp add: copyAreaToRegs_def) - apply wp - apply (rule thread_set_invs_trivial, (simp add: tcb_cap_cases_def)+) - apply (rule mapM_wp [where S=UNIV, simplified]) - apply wp - apply simp - done - lemma suspend_cap_to'[wp]: "\ex_nonz_cap_to' p\ suspend t \\rv. ex_nonz_cap_to' p\" apply (simp add: suspend_def unless_def) @@ -327,10 +308,10 @@ lemma readreg_corres: apply simp apply (rule no_fail_mapM) apply (simp add: no_fail_getRegister) - apply wp + apply wp+ apply (rule corres_when [OF refl]) apply (rule suspend_corres) - apply wp + apply wp+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def dest!: idle_no_ex_cap) apply (clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap) @@ -432,7 +413,7 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ getRestartPCs_corres]) apply (rule setNextPCs_corres) - apply wp + apply wp+ apply simp+ done show ?thesis @@ -498,18 +479,6 @@ lemma copyreg_invs': \\rv. invs'\" by (rule hoare_strengthen_post, rule copyreg_invs'', simp) -lemma isRunnable_wp': - "\\s. Q (st_tcb_at' runnable' t s) s\ isRunnable t \Q\" - apply (simp add: isRunnable_def2) - apply wp - apply (simp add: getThreadState_def threadGet_def) - apply wp - apply (clarsimp simp: getObject_def valid_def in_monad - loadObject_default_def projectKOs obj_at'_def - split_def objBits_simps in_magnitude_check) - apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs objBitsKO_def) - done - lemma threadSet_valid_queues_no_state: "\Invariants_H.valid_queues and (\s. \p. t \ set (ksReadyQueues s p))\ threadSet f t \\_. Invariants_H.valid_queues\" @@ -550,8 +519,9 @@ lemma gts_isRunnable_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF _ gts_corres]) apply (case_tac rv, clarsimp+) - apply (wp hoare_TrueI, simp+) - done + apply (wp hoare_TrueI)+ + apply auto + done lemma tcbSchedDequeue_not_queued: "\\\ tcbSchedDequeue t @@ -579,17 +549,16 @@ lemma threadSet_ct_in_state': \ct_in_state' test\ threadSet f t \\rv. ct_in_state' test\" apply (simp add: ct_in_state'_def) apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply (wp threadSet_pred_tcb_no_state) - apply simp + apply (wp threadSet_pred_tcb_no_state)+ + apply simp+ apply wp done lemma tcbSchedDequeue_ct_in_state'[wp]: "\ct_in_state' test\ tcbSchedDequeue t \\rv. ct_in_state' test\" apply (simp add: ct_in_state'_def) - apply (rule hoare_lift_Pf [where f=ksCurThread]) - apply wp - done + apply (rule hoare_lift_Pf [where f=ksCurThread]; wp) + done lemma valid_tcb'_tcbPriority_update: "\valid_tcb' tcb s; f (tcbPriority tcb) \ maxPriority \ \ valid_tcb' (tcbPriority_update f tcb) s" apply (simp add: valid_tcb'_def tcb_cte_cases_def) @@ -599,6 +568,7 @@ lemma threadSet_valid_objs_tcbPriority_update: "\valid_objs' and (\_. x \ maxPriority)\ threadSet (tcbPriority_update (\_. x)) t \\_. valid_objs'\" + including no_pre apply (simp add: threadSet_def) apply wp prefer 2 @@ -610,9 +580,9 @@ lemma threadSet_valid_objs_tcbPriority_update: apply (simp add: projectKOs) apply (simp add: valid_obj'_def) apply (subgoal_tac "tcb_at' t s") - apply simp - apply (rule valid_tcb'_tcbPriority_update) - apply (fastforce simp: obj_at'_def)+ + apply simp + apply (rule valid_tcb'_tcbPriority_update) + apply (fastforce simp: obj_at'_def)+ done lemma sp_corres2: @@ -627,7 +597,7 @@ lemma sp_corres2: apply (rule corres_split [OF _ corres_when[OF _ tcbSchedEnqueue_corres]]) apply (rule corres_split [OF corres_when[OF _ rescheduleRequired_corres] gct_corres]) apply (wp hoare_vcg_imp_lift hoare_vcg_if_lift hoare_vcg_all_lift hoare_vcg_disj_lift - gts_wp isRunnable_wp' threadSet_pred_tcb_no_state threadSet_valid_queues_no_state + gts_wp isRunnable_wp threadSet_pred_tcb_no_state threadSet_valid_queues_no_state threadSet_valid_queues'_no_state threadSet_valid_objs_tcbPriority_update threadSet_weak_sch_act_wf tcbSchedDequeue_not_in_queue threadSet_ct_in_state'[simplified ct_in_state'_def] tcbSchedDequeue_valid_queues @@ -777,6 +747,7 @@ proof - tcbSchedEnqueue t \\_. invs'\" by (wp, clarsimp) show ?thesis + including no_pre apply (rule hoare_gen_asm) apply (simp add: setPriority_def) apply (wp rescheduleRequired_all_invs_but_ct_not_inQ) @@ -792,14 +763,14 @@ proof - in hoare_post_imp, clarsimp simp: invs'_def valid_state'_def) apply (wp) apply (rule_tac Q="\_. invs'" in hoare_post_imp, - clarsimp simp: pred_tcb_at'_def comp_def) + clarsimp simp: pred_tcb_at'_def comp_def) apply (wp threadSet_invs_trivial, simp_all add: inQ_def cong: conj_cong) apply (rule_tac Q="\_. invs' and obj_at' (Not \ tcbQueued) t and (\s. \d p. t \ set (ksReadyQueues s (d,p)))" in hoare_post_imp) apply (clarsimp dest: obj_at_ko_at' simp: obj_at'_def) - apply (wp_trace tcbSchedDequeue_not_queued) + apply (wp tcbSchedDequeue_not_queued)+ apply (clarsimp)+ done qed @@ -881,7 +852,7 @@ lemma check_cap_at_corres: apply (erule(1) sameObject_corres2) apply assumption apply (rule corres_trivial, simp) - apply (wp get_cap_wp getCTE_wp') + apply (wp get_cap_wp getCTE_wp')+ apply (fastforce elim: cte_wp_at_weakenE intro: Q) apply (fastforce elim: cte_wp_at_weakenE' intro: Q') done @@ -996,8 +967,7 @@ lemma checked_insert_tcb_invs'[wp]: (checkCapAt (ThreadCap target) slot' (assertDerived src_slot new_cap (cteInsert new_cap src_slot slot))) \\rv. invs'\" apply (simp add: checkCapAt_def liftM_def assertDerived_def stateAssert_def) - apply (rule hoare_pre) - apply (wp getCTE_cteCap_wp cteInsert_invs) + apply (wp getCTE_cteCap_wp cteInsert_invs) apply (clarsimp split: option.splits) apply (subst(asm) tree_cte_cteCap_eq[unfolded o_def]) apply (clarsimp split: option.splits) @@ -1011,7 +981,7 @@ lemma checked_insert_tcb_invs'[wp]: apply (frule capBadgeNone_masters, simp) apply (rule conjI) apply (rule_tac x=slot' in exI) - apply fastforce + subgoal by fastforce apply (clarsimp simp: isCap_simps cteCaps_of_def) apply (erule(1) valid_irq_handlers_ctes_ofD) apply (clarsimp simp: invs'_def valid_state'_def) @@ -1033,15 +1003,11 @@ lemma isValidVTableRootD: split: capability.split_asm arch_capability.split_asm option.split_asm) -declare in_image_op_plus[simp] - lemma assertDerived_wp: "\P and (\s. cte_wp_at' (is_derived' (ctes_of s) slot cap o cteCap) slot s)\ f \Q\ \ \P\ assertDerived slot cap f \Q\" apply (simp add: assertDerived_def) - apply (rule hoare_pre) - apply (wp|assumption)+ - apply simp + apply wpsimp done lemma tcbMCP_ts_safe: @@ -1071,7 +1037,8 @@ lemma valid_tcb'_tcbMCP_update: lemma setMCPriority_valid_objs'[wp]: "\valid_objs' and K (prio \ maxPriority)\ setMCPriority t prio \\rv. valid_objs'\" unfolding setMCPriority_def - apply (simp add: threadSet_def) + including no_pre + apply (simp add: threadSet_def) apply wp prefer 2 apply (rule getObject_tcb_sp) @@ -1284,12 +1251,12 @@ proof - apply (rule user_setreg_corres) apply (rule corres_trivial) apply simp - apply wp + apply wp+ apply (rule threadset_corres, (simp add: tcb_relation_def), (simp add: exst_same_def)+)[1] - apply wp + apply wp+ apply (rule cap_delete_corres) - apply wp + apply wp+ apply (fastforce simp: emptyable_def) apply fastforce apply clarsimp @@ -1304,7 +1271,7 @@ proof - prefer 3 apply simp apply (erule checked_insert_corres) - apply wp + apply wp+ apply (rule threadset_corres, simp add: tcb_relation_def, (simp add: exst_same_def)+) apply (wp thread_set_tcb_ipc_buffer_cap_cleared_invs @@ -1600,14 +1567,14 @@ lemma tcbinv_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF _ unbind_notification_corres]) apply (rule corres_trivial, simp) - apply wp + apply wp+ apply (clarsimp) apply clarsimp apply simp apply (rule corres_guard_imp) apply (rule corres_split[OF _ bind_notification_corres]) apply (rule corres_trivial, simp) - apply wp + apply wp+ apply clarsimp apply (clarsimp simp: obj_at_def is_ntfn) apply (clarsimp simp: obj_at'_def projectKOs) @@ -1644,7 +1611,7 @@ lemma valid_bound_ntfn_lift: assumes P: "\P T p. \\s. P (typ_at' T p s)\ f \\rv s. P (typ_at' T p s)\" shows "\\s. valid_bound_ntfn' a s\ f \\rv s. valid_bound_ntfn' a s\" apply (simp add: valid_bound_ntfn'_def, case_tac a, simp_all) - apply (wp typ_at_lifts[OF P]) + apply (wp typ_at_lifts[OF P])+ done lemma bindNotification_invs': @@ -1655,6 +1622,7 @@ lemma bindNotification_invs': and invs'\ bindNotification tcbptr ntfnptr \\_. invs'\" + including no_pre apply (simp add: bindNotification_def invs'_def valid_state'_def) apply (rule hoare_seq_ext[OF _ get_ntfn_sp']) apply (rule hoare_pre) @@ -1763,7 +1731,7 @@ lemma decode_writereg_corres: apply (rule corres_split_norE) apply (rule corres_trivial, simp) apply (rule corres_trivial, simp) - apply (wp) + apply (wp)+ apply simp+ done @@ -1867,7 +1835,7 @@ lemma check_prio_corres: apply (rule corres_returnOkTT) apply (simp add: minPriority_def) apply (simp, rule threadget_corres, simp add: tcb_relation_def) - apply (wp gct_wp) + apply (wp gct_wp)+ apply (simp add: cur_tcb_def cur_tcb'_def)+ done @@ -1885,7 +1853,7 @@ lemma decode_set_priority_corres: apply (rule corres_split_norE[OF _ check_prio_corres]) (* check_prio *) apply (clarsimp simp: returnOk_def newroot_rel_def cap_relation_def) apply (case_tac cap, clarsimp+) - apply (wp hoareE_TrueI) + apply (wp hoareE_TrueI)+ apply (force simp: cur_tcb_def valid_etcbs_def tcb_at_st_tcb_at) apply (simp add: invs'_def cur_tcb'_def) done @@ -1904,7 +1872,7 @@ lemma decode_set_mcpriority_corres: apply (rule corres_split_norE[OF _ check_prio_corres]) (* check_prio *) apply (clarsimp simp: returnOk_def newroot_rel_def cap_relation_def) apply (case_tac cap, clarsimp+) - apply (wp hoareE_TrueI) + apply (wp hoareE_TrueI)+ apply (force simp: cur_tcb_def valid_etcbs_def tcb_at_st_tcb_at) apply (simp add: invs'_def cur_tcb'_def) done @@ -2083,7 +2051,7 @@ lemma decodeSetIPCBuffer_is_tc[wp]: apply (rule hoare_pre) apply (wp | wpc)+ apply (simp only: isThreadControl_def tcbinvocation.simps) - apply wp + apply wp+ apply (clarsimp simp: isThreadControl_def) done @@ -2123,7 +2091,7 @@ lemma slot_long_running_corres: simp: liftM_def[symmetric] final_matters'_def long_running_delete_def longRunningDelete_def isCap_simps)[1] - apply (wp get_cap_wp getCTE_wp) + apply (wp get_cap_wp getCTE_wp)+ apply clarsimp apply (clarsimp simp: cte_wp_at_ctes_of) apply fastforce @@ -2133,7 +2101,7 @@ lemma slot_long_running_inv'[wp]: "\P\ slotCapLongRunningDelete ptr \\rv. P\" apply (simp add: slotCapLongRunningDelete_def) apply (rule hoare_seq_ext [OF _ getCTE_inv]) - apply (rule hoare_pre, wpcw, wp isFinalCapability_inv) + apply (rule hoare_pre, wpcw, (wp isFinalCapability_inv)+) apply simp done @@ -2185,7 +2153,7 @@ lemma decode_set_space_corres: apply (simp split: option.split) apply (rule corres_trivial, simp) apply simp - apply wp + apply wp+ apply (clarsimp simp: cap_map_update_data) apply simp apply ((simp only: simp_thms pred_conj_def | wp)+)[2] @@ -2193,7 +2161,7 @@ lemma decode_set_space_corres: apply simp apply (rule corres_trivial, simp) apply simp - apply (unfold whenE_def, wp)[2] + apply (unfold whenE_def, wp+)[2] apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data) apply (fastforce dest: list_all2_nthD2[where p=0]) apply ((simp split del: if_split | wp | rule hoare_drop_imps)+)[2] @@ -2201,12 +2169,12 @@ lemma decode_set_space_corres: apply simp apply (rule corres_trivial, simp) apply simp - apply (unfold whenE_def, wp)[2] + apply (unfold whenE_def, wp+)[2] apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified]) apply simp - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0) - apply wp + apply wp+ apply (clarsimp simp: get_tcb_ctable_ptr_def get_tcb_vtable_ptr_def is_cap_simps valid_cap_def tcb_at_cte_at_0 tcb_at_cte_at_1[simplified]) @@ -2363,11 +2331,11 @@ lemma decodeTCBConf_wf[wp]: in hoare_post_imp_R) apply wp apply (clarsimp simp: isThreadControl_def2 cong: option.case_cong) - apply (wp) + apply wp+ apply (rule hoare_post_imp_R) apply (rule decodeSetMCPriority_wf_isThreadControl) apply (fastforce simp: isThreadControl_def2)+ - apply (wp_trace) + apply wp apply (rule_tac Q'="\r. invs' and tcb_at' t and ex_nonz_cap_to' t and K (valid_option_prio (tcNewPriority r))" in hoare_post_imp_R) @@ -2400,8 +2368,6 @@ lemma getSlotCap_valid_option: declare hoare_True_E_R [simp del] -declare resolveAddressBits.simps[simp del] - lemma lsft_real_cte: "\valid_objs'\ lookupSlotForThread t x \\rv. real_cte_at' rv\, -" apply (simp add: lookupSlotForThread_def) @@ -2415,7 +2381,7 @@ lemma tcb_real_cte_16: lemma isValidVTableRoot: "isValidVTableRoot c = (\p asid. c = ArchObjectCap (PageDirectoryCap p (Some asid)))" - by (simp add: isValidVTableRoot_def ARM_H.isValidVTableRoot_def isCap_simps + by (simp add: ARM_H.isValidVTableRoot_def isCap_simps split: capability.splits arch_capability.splits option.splits) @@ -2461,7 +2427,7 @@ notes if_cong[cong] shows option.splits) apply simp apply (rule get_ntfn_corres) - apply wp + apply wp+ apply (rule corres_trivial, clarsimp simp: whenE_def returnOk_def) apply (wp | simp add: whenE_def split del: if_split)+ apply (rule corres_trivial, simp) @@ -2492,7 +2458,7 @@ lemma decode_unbind_notification_corres: apply (simp add: returnOk_def) apply simp apply (rule gbn_corres) - apply wp + apply wp+ apply auto done @@ -2572,8 +2538,8 @@ lemma decodeTCBInv_wf: apply (simp add: decodeTCBInvocation_def Let_def cong: if_cong invocation_label.case_cong split del: if_split) apply (rule hoare_pre) - apply (wpc, wp decodeTCBConf_wf decodeReadReg_wf - decodeWriteReg_wf decodeCopyReg_wf decodeBindNotification_wf decodeUnbindNotification_wf) + apply (wpc, (wp decodeTCBConf_wf decodeReadReg_wf decodeWriteReg_wf + decodeCopyReg_wf decodeBindNotification_wf decodeUnbindNotification_wf)+) apply (clarsimp simp: real_cte_at') apply (fastforce simp: real_cte_at_not_tcb_at') done @@ -2585,7 +2551,9 @@ lemma restart_makes_simple': apply (simp add: restart_def) apply (wp sts_st_tcb_at'_cases cancelIPC_simple cancelIPC_st_tcb_at static_imp_wp | simp)+ - apply (rule hoare_strengthen_post [OF isBlocked_inv]) + apply (rule hoare_strengthen_post [OF isBlocked_inv]) + prefer 2 + apply assumption apply clarsimp done diff --git a/proof/refine/Untyped_R.thy b/proof/refine/Untyped_R.thy index 9b94a7d12..1f4cddfa5 100644 --- a/proof/refine/Untyped_R.thy +++ b/proof/refine/Untyped_R.thy @@ -97,7 +97,7 @@ lemma corres_check_no_children: apply simp apply (rule ensure_no_children_corres) apply simp - apply wp + apply wp+ apply simp+ apply (clarsimp simp:dc_def,wp)+ apply simp @@ -134,6 +134,8 @@ lemma is_frame_type_isFrameType_eq[simp]: (Types_H.isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ +(* FIXME: remove *) +lemmas APIType_capBits = objSize_eq_capBits lemma dec_untyped_inv_corres: assumes cap_rel: "list_all2 cap_relation cs cs'" @@ -345,7 +347,7 @@ next apply (drule_tac x = "if_res reset" 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]) + le_less_trans[OF diff_le_self]) apply (rule whenE_throwError_corres) apply (clarsimp) apply (clarsimp simp: fromAPIType_def) @@ -371,7 +373,7 @@ next 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]]) + 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) @@ -379,7 +381,7 @@ next apply (rule minus_one_helper) apply (simp add: word_le_nat_alt) apply (simp add: unat_arith_simps) - apply wp + apply wp+ apply simp apply (rule corres_returnOkTT) apply (rule crel) @@ -393,15 +395,15 @@ next hoare_drop_impE_R hoare_vcg_all_lift_R | clarsimp)+ apply (rule hoare_strengthen_post [where Q = "\r. invs and valid_cap r and cte_at slot"]) - apply wp + apply wp+ apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def valid_cap_def word_bits_def) apply (frule caps_of_state_valid_cap, clarsimp+) apply (strengthen refl exI[mk_strg I E] exI[where x=d])+ apply simp - apply wp + apply wp+ apply (rule hoare_strengthen_post [where Q = "\r. invs' and cte_at' (cte_map slot)"]) - apply wp + apply wp+ apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' ) apply auto[1] apply (wp whenE_throwError_wp | wp_once hoare_drop_imps)+ @@ -637,6 +639,7 @@ lemma checkFreeIndex_wp: "\\s. if descendants_of' slot (ctes_of s) = {} then Q y s else Q x s\ constOnFailure x (doE z \ ensureNoChildren slot; returnOk y odE) \Q\" + including no_pre apply (clarsimp simp:constOnFailure_def const_def) apply (wp ensureNoChildren_wp) apply simp @@ -646,7 +649,7 @@ declare upt_Suc[simp] lemma ensureNoChildren_sp: "\P\ ensureNoChildren sl \\rv s. P s \ descendants_of' sl (ctes_of s) = {}\,-" - by (rule hoare_pre, wp ensureNoChildren_wp, simp) + by (wp ensureNoChildren_wp, simp) declare isPDCap_PD [simp] @@ -659,15 +662,15 @@ lemma dui_sp_helper': liftE (getSlotCap slot) odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \ P s\, -" apply (cases Q, simp_all add: lookupTargetSlot_def) - apply (rule hoare_pre, wp, simp) + apply (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 (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 wpsimp apply simp done @@ -737,7 +740,7 @@ lemma empty_descendants_range_in': lemma liftE_validE_R: "\P\ f \Q\ \ \P\ liftE f \Q\,-" - by (wp, simp) + by wpsimp lemma decodeUntyped_wf[wp]: "\invs' and cte_wp_at' (\cte. cteCap cte = UntypedCap d w sz idx) slot @@ -755,10 +758,10 @@ lemma decodeUntyped_wf[wp]: apply (rule list_case_throw_validE_R) apply (clarsimp split del: if_split split: list.splits) apply (intro conjI impI allI) - apply ((rule hoare_pre,wp)+)[6] + apply (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'])+ + validE_R_sp[OF dui_sp_helper'])+ apply (case_tac "\ isCNodeCap nodeCap") apply (simp add: validE_R_def) apply (simp add: mapM_locate_eq bind_liftE_distrib bindE_assoc @@ -806,7 +809,7 @@ lemma decodeUntyped_wf[wp]: 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 (clarsimp dest!: less_Suc_unat_less_bound) apply (erule word_unat.Abs_eqD) apply (simp add: unats_def) apply (simp add: unats_def) @@ -1438,9 +1441,6 @@ lemma clearUntypedFreeIndex_corres_noop_psp: apply (rule corres_trivial, simp) apply (wp getCTE_wp' | wpc | simp add: updateTrackedFreeIndex_def getSlotCap_def)+ - apply (rule no_fail_pre) - apply (wp no_fail_getSlotCap getCTE_wp' - | wpc | simp add: updateTrackedFreeIndex_def getSlotCap_def)+ done lemma create_cap_corres: @@ -1484,7 +1484,7 @@ shows prefer 3 apply wp+ apply (rule hoare_post_imp, simp) - apply wp + apply wp+ defer apply ((wp | simp)+)[1] apply (simp add: create_cap_ext_def set_cdt_list_def update_cdt_list_def bind_assoc) @@ -1553,7 +1553,7 @@ shows apply (clarsimp split: if_split_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 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]) @@ -3196,9 +3196,7 @@ lemma createNewCaps_range_helper: \ (\p. capClass (capfn p) = PhysicalClass \ capUntypedPtr (capfn p) = p \ capBits (capfn p) = (APIType_capBits tp us))\" - apply (simp add: createNewCaps_def toAPIType_def - - createNewCaps_def Arch_createNewCaps_def + apply (simp add: createNewCaps_def toAPIType_def Arch_createNewCaps_def split del: if_split cong: option.case_cong) apply (rule hoare_grab_asm)+ apply (frule range_cover.range_cover_n_less) @@ -3400,6 +3398,7 @@ lemma createNewCaps_not_parents: apply (clarsimp simp: tree_cte_cteCap_eq) apply (erule_tac x=x in allE) apply simp + including no_pre 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) @@ -3953,7 +3952,7 @@ lemma deleteObjects_caps_overlap_reserved': apply (erule ranE) apply (fastforce split:if_splits) apply (clarsimp simp:caps_overlap_reserved'_def2) - apply wp + apply wp+ apply (clarsimp simp:caps_overlap_reserved'_def2 valid_cap'_def capAligned_def)+ done @@ -4074,8 +4073,7 @@ lemma updateFreeIndex_clear_invs': updateFreeIndex src idx \\r s. invs' s\" apply (clarsimp simp:invs'_def valid_state'_def) - apply (rule hoare_pre) - apply (wp updateFreeIndex_valid_pspace_no_overlap') + apply (wp updateFreeIndex_valid_pspace_no_overlap') apply (simp add: updateFreeIndex_def updateTrackedFreeIndex_def) apply (wp updateFreeIndex_valid_pspace_no_overlap' sch_act_wf_lift valid_queues_lift updateCap_iflive' tcb_in_cur_domain'_lift @@ -4083,10 +4081,10 @@ lemma updateFreeIndex_clear_invs': apply (rule hoare_vcg_conj_lift) apply (simp add: ifunsafe'_def3 cteInsert_def setUntypedCapAsFull_def split del: if_split) - apply wp + apply wp+ apply (rule hoare_vcg_conj_lift) apply (simp add:updateCap_def) - apply wp + apply wp+ apply (wp valid_irq_node_lift) apply (rule hoare_vcg_conj_lift) apply (simp add:updateCap_def) @@ -4295,8 +4293,7 @@ lemma update_untyped_cap_corres: apply (rule set_untyped_cap_corres) apply ((clarsimp simp: cte_wp_at_caps_of_state cte_wp_at_ctes_of)+)[3] apply (subst identity_eq) - apply (wp getCTE_sp getCTE_get) - apply (rule no_fail_pre[OF no_fail_getCTE]) + apply (wp getCTE_sp getCTE_get no_fail_getCTE)+ apply (clarsimp simp: cte_wp_at_ctes_of cte_wp_at_caps_of_state)+ done @@ -4321,11 +4318,11 @@ lemma updateFreeIndex_corres: apply (rule update_untyped_cap_corres, simp+) apply (clarsimp simp: isCap_simps) apply simp - apply (wp getSlotCap_wp) + apply (wp getSlotCap_wp)+ apply (clarsimp simp: state_relation_def cte_wp_at_ctes_of) apply (rule no_fail_pre, wp no_fail_getSlotCap) apply (clarsimp simp: cte_wp_at_ctes_of) - apply (wp getSlotCap_wp) + apply (wp getSlotCap_wp)+ apply (clarsimp simp: state_relation_def cte_wp_at_ctes_of) apply (rule no_fail_pre, wp no_fail_getSlotCap) apply simp @@ -4578,7 +4575,7 @@ lemma cNodeNoOverlap: apply blast apply (simp add: is_aligned_no_overflow power_overflow word_bits_def Int_atLeastAtMost) - apply wp + apply wp+ done lemma cNodeNoOverlap_empty: @@ -4601,7 +4598,7 @@ lemma cNodeNoOverlap_empty: 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 wp + apply wp+ done lemma mapME_x_corres_same_xs: @@ -4824,13 +4821,13 @@ lemma reset_untyped_cap_corres: apply (erule order_less_le_trans) apply simp apply simp - apply wp + apply wp+ apply (rule corres_machine_op) apply (rule corres_Id) apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute reset_chunk_bits_def resetChunkBits_def) apply simp - apply wp + apply wp+ apply (clarsimp simp: cte_wp_at_caps_of_state) apply (clarsimp simp: getFreeRef_def valid_pspace'_def cte_wp_at_ctes_of valid_cap_def cap_aligned_def) @@ -5505,7 +5502,7 @@ let ?ui' = "Invocations_H.untyped_invocation.Retype (cte_map cref) reset apply (wp updateFreeIndex_forward_invs' updateFreeIndex_caps_overlap_reserved updateFreeIndex_caps_no_overlap'' updateFreeIndex_pspace_no_overlap' hoare_vcg_const_Ball_lift updateFreeIndex_cte_wp_at - updateFreeIndex_descendants_range_in') + updateFreeIndex_descendants_range_in')+ apply clarsimp apply (clarsimp simp:conj_comms) apply (strengthen invs_mdb invs_valid_objs @@ -5761,7 +5758,7 @@ lemma insertNewCap_valid_global_refs': 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 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) @@ -5915,15 +5912,14 @@ lemma zipWithM_x_insertNewCap_invs'': apply (simp add: mapM_def sequence_def) apply (wp, simp) apply (simp add: mapM_Cons) - apply wp - apply assumption + including no_pre apply wp 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') + 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) @@ -6158,6 +6154,7 @@ lemma invokeUntyped_invs'': [symmetric,where w = "mask sz" and t = ptr,symmetric] note msimp[simp add] = misc getObjectSize_def_eq neg_mask_add_mask show "\op = s\ invokeUntyped ui \\rv s. invs' s \ Q s\" + including no_pre apply (clarsimp simp:invokeUntyped_def getSlotCap_def ui) apply (rule validE_valid) apply (rule hoare_pre) @@ -6297,8 +6294,8 @@ lemma inv_untyp_st_tcb_at'[wp]: \\rv. st_tcb_at' P tptr\" apply (rule hoare_pre) apply (rule hoare_strengthen_post) - apply (rule invokeUntyped_invs''[where Q="st_tcb_at' P tptr"], - wp createNewCaps_pred_tcb_at') + apply (rule invokeUntyped_invs''[where Q="st_tcb_at' P tptr"]; + wp createNewCaps_pred_tcb_at') apply (auto simp: valid_pspace'_def)[1] apply (wp resetUntypedCap_st_tcb_at' | simp)+ apply (cases ui, clarsimp simp: cte_wp_at_ctes_of isCap_simps) diff --git a/proof/refine/VSpace_R.thy b/proof/refine/VSpace_R.thy index 74879a1c1..f7028e1e3 100644 --- a/proof/refine/VSpace_R.thy +++ b/proof/refine/VSpace_R.thy @@ -238,7 +238,7 @@ lemma find_pd_for_asid_assert_corres: apply simp apply (clarsimp simp: state_relation_def arch_state_relation_def pd_at_uniq_def ran_option_map) - apply wp + apply wp+ apply (simp add: checkPDAt_def stateAssert_def) apply (rule no_fail_pre, wp) apply simp @@ -263,7 +263,7 @@ lemma find_pd_for_asid_assert_corres: apply (rule corres_split_catch [OF _ find_pd_for_asid_corres'[where pd=pd]]) apply (rule_tac P="\" and P'="\" in corres_inst) apply (simp add: corres_fail) - apply (wp find_pd_for_asid_valids[where pd=pd]) + apply (wp find_pd_for_asid_valids[where pd=pd])+ apply (clarsimp simp: word_neq_0_conv) apply simp done @@ -284,7 +284,7 @@ lemma findPDForASIDAssert_known_corres: apply (rule corres_guard_imp) apply (rule corres_split [OF _ find_pd_for_asid_assert_corres[where pd=pd]]) apply simp - apply wp + apply wp+ apply clarsimp apply simp done @@ -347,8 +347,7 @@ lemma store_hw_asid_corres: apply (rule ext) apply simp apply (rule corres_trivial) - apply (clarsimp simp: corres_gets state_relation_def - arch_state_relation_def) + apply (clarsimp simp: state_relation_def arch_state_relation_def) apply ((wp | simp)+)[4] apply (rule corres_trivial) apply (clarsimp simp: state_relation_def arch_state_relation_def) @@ -423,7 +422,7 @@ lemma find_free_hw_asid_corres: ([next_asid .e. maxBound] @ init [minBound .e. next_asid])" in option.nchotomy[rule_format]) apply (erule corres_disj_division) - apply (clarsimp split del: if_splits) + apply (clarsimp split del: if_split) apply (rule corres_split [OF _ invalidate_asid_ext_corres]) apply (rule corres_split' [where r'=dc]) apply (rule corres_trivial, rule corres_machine_op) @@ -515,7 +514,7 @@ lemma arm_context_switch_corres: lemma hv_corres: "corres (fr \ dc) (tcb_at thread) (tcb_at' thread) (handle_vm_fault thread fault) (handleVMFault thread fault)" - apply (simp add: handleVMFault_def ARM_H.handleVMFault_def) + apply (simp add: ARM_H.handleVMFault_def) apply (cases fault) apply simp apply (rule corres_guard_imp) @@ -532,7 +531,7 @@ lemma hv_corres: apply (rule corres_Id, rule refl, simp) apply (rule no_fail_getDFSR) apply (rule corres_trivial, simp add: arch_fault_map_def) - apply wp + apply wp+ apply simp+ apply (rule corres_guard_imp) apply (rule corres_splitEE) @@ -549,7 +548,7 @@ lemma hv_corres: apply (rule corres_Id, rule refl, simp) apply (rule no_fail_getIFSR) apply (rule corres_trivial, simp add: arch_fault_map_def) - apply wp + apply wp+ apply simp+ done @@ -579,7 +578,7 @@ lemma flush_space_corres: apply (rule corres_machine_op) apply (rule corres_Id, rule refl, simp) apply (rule no_fail_invalidateTLB_ASID) - apply wp + apply wp+ apply clarsimp apply (simp add: pd_at_asid_uniq) apply simp @@ -606,21 +605,12 @@ lemma invalidate_tlb_by_asid_corres: apply (rule corres_machine_op) apply (rule corres_Id, rule refl, simp) apply (rule no_fail_invalidateTLB_ASID) - apply wp + apply wp+ apply clarsimp apply (simp add: pd_at_asid_uniq) apply simp done -lemma corres_name_pre: - "\ \s s'. \ P s; P' s'; (s, s') \ state_relation \ - \ corres rvr (op = s) (op = s') f g \ - \ corres rvr P P' f g" - apply (simp add: corres_underlying_def split_def - Ball_def) - apply blast - done - lemma invalidate_tlb_by_asid_corres_ex: "corres dc (\s. asid \ mask asid_bits \ asid \ 0 @@ -724,7 +714,7 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split' [where r'="op = \ cte_map"]) apply (simp add: tcbVTableSlot_def cte_map_def objBits_def cte_level_bits_def - objBitsKO_def tcb_cnode_index_def to_bl_1 of_bl_True) + objBitsKO_def tcb_cnode_index_def to_bl_1) apply (rule_tac R="\thread_root. valid_arch_state and valid_asid_map and valid_arch_objs and valid_vs_lookup and unique_table_refs o caps_of_state and @@ -906,15 +896,15 @@ lemma delete_asid_corres: apply (rule corres_split [OF _ gct_corres]) apply simp apply (rule set_vm_root_corres) - apply wp + apply wp+ apply (simp del: fun_upd_apply) apply (fold cur_tcb_def) apply (wp set_asid_pool_asid_map_unmap set_asid_pool_arch_objs_unmap_single - set_asid_pool_vs_lookup_unmap') + set_asid_pool_vs_lookup_unmap')+ apply simp apply (fold cur_tcb'_def) - apply (wp invalidate_asid_entry_invalidates) + apply (wp invalidate_asid_entry_invalidates)+ apply (wp | clarsimp simp: o_def)+ apply (subgoal_tac "vspace_at_asid asid pd s") apply (auto simp: obj_at_def a_type_def graph_of_def @@ -935,7 +925,7 @@ lemma delete_asid_corres: apply (wp getASID_wp) apply clarsimp apply assumption - apply wp + apply wp+ apply clarsimp apply (clarsimp simp: valid_arch_state_def valid_asid_table_def dest!: invs_arch_state) @@ -997,7 +987,7 @@ lemma delete_asid_pool_corres: in invalidate_asid_entry_corres) apply wp apply clarsimp - apply wp + apply wp+ apply (clarsimp simp: invs_def valid_state_def valid_arch_caps_def valid_pspace_def vspace_at_asid_def cong: conj_cong) @@ -1063,7 +1053,7 @@ lemma delete_asid_pool_corres: apply (rule gct_corres) apply (simp only:) apply (rule set_vm_root_corres) - apply wp + apply wp+ apply (rule_tac R="\_ s. rv = arm_asid_table (arch_state s)" in hoare_post_add) apply (drule sym, simp only: ) @@ -1090,7 +1080,7 @@ lemma delete_asid_pool_corres: apply (clarsimp simp: cur_tcb'_def) apply (simp add: o_def pred_conj_def) apply wp - apply (wp getASID_wp) + apply (wp getASID_wp)+ apply (clarsimp simp: conj_comms) apply (auto simp: vs_lookup_def intro: vs_asid_refsI)[1] apply clarsimp @@ -1151,7 +1141,7 @@ proof - apply (case_tac arch_cap, auto simp: X[simplified] split: option.splits)[1] apply (simp add: cte_map_def objBits_simps tcb_cnode_index_def tcbVTableSlot_def to_bl_1 cte_level_bits_def) - apply wp + apply wp+ apply (clarsimp simp: cur_tcb_def) apply (erule tcb_at_cte_at) apply (simp add: tcb_cap_cases_def) @@ -1201,16 +1191,17 @@ lemma storeHWASID_valid_arch' [wp]: \\_. valid_arch_state'\" apply (simp add: storeHWASID_def) apply wp - apply (simp add: valid_arch_state'_def comp_upd_simp - fun_upd_def[symmetric]) - apply (rule hoare_pre, wp) + prefer 2 + apply assumption + apply (simp add: valid_arch_state'_def comp_upd_simp fun_upd_def[symmetric]) + apply wp apply (simp add: findPDForASIDAssert_def const_def checkPDUniqueToASID_def checkPDASIDMapMembership_def) apply wp apply (rule_tac Q'="\rv s. valid_asid_map' (armKSASIDMap (ksArchState s)) \ asid \ 0 \ asid \ mask asid_bits" in hoare_post_imp_R) - apply (wp findPDForASID_inv2) + apply (wp findPDForASID_inv2)+ apply (clarsimp simp: valid_asid_map'_def) apply (subst conj_commute, rule context_conjI) apply clarsimp @@ -1373,7 +1364,7 @@ lemma flush_page_corres: apply (rule corres_split [OF _ gct_corres]) apply simp apply (rule set_vm_root_corres) - apply wp + apply wp+ apply (rule corres_Id, rule refl, simp) apply (rule no_fail_pre, wp no_fail_invalidateTLB_VAASID) apply simp @@ -1450,13 +1441,13 @@ lemma unmap_page_table_corres: apply (rule corres_split[OF _ corres_machine_op]) apply (rule flush_table_corres) apply (rule corres_Id, rule refl, simp) - apply (wp no_fail_cleanByVA_PoU) - apply (simp, wp) + apply (wp no_fail_cleanByVA_PoU)+ + apply (simp, wp+) apply (simp add:pde_relation_aligned_def)+ apply (wp store_pde_pd_at_asid store_pde_arch_objs_invalid) apply (rule hoare_vcg_conj_lift) apply (simp add: store_pde_def) - apply (wp set_pd_vs_lookup_unmap) + apply (wp set_pd_vs_lookup_unmap)+ apply (rule corres_trivial, simp) apply (wp page_table_mapped_wp) apply (wp hoare_drop_imps)[1] @@ -1516,7 +1507,7 @@ lemma check_mapping_corres: is_aligned_shiftr pg_entry_align_def unlessE_def returnOk_def pte_relation_aligned_def split: ARM_A.pte.split if_splits ARM_H.pte.split ) - apply wp + apply wp+ apply simp apply (simp add:is_aligned_mask[symmetric] is_aligned_shiftr pg_entry_align_def) apply (rule corres_guard_imp) @@ -1527,7 +1518,7 @@ lemma check_mapping_corres: is_aligned_shiftr pg_entry_align_def unlessE_def returnOk_def pde_relation_aligned_def split: ARM_A.pde.split if_splits ARM_H.pde.split ) - apply wp + apply wp+ apply simp+ done @@ -1611,10 +1602,9 @@ lemma unmap_page_corres: apply clarsimp apply (wp store_pte_typ_at hoare_vcg_const_Ball_lift | simp | wp_once hoare_drop_imps)+ apply (wp lookup_pt_slot_ptes lookup_pt_slot_inv lookupPTSlot_inv - lookup_pt_slot_is_aligned lookup_pt_slot_is_aligned_6) - apply (clarsimp simp: page_directory_pde_at_lookupI - vmsz_aligned_def pd_aligned pd_bits_def pageBits_def - pd_aligned valid_unmap_def) + lookup_pt_slot_is_aligned lookup_pt_slot_is_aligned_6)+ + apply (clarsimp simp: page_directory_pde_at_lookupI vmsz_aligned_def pd_aligned + pd_bits_def pageBits_def valid_unmap_def) apply (drule(1) less_kernel_base_mapping_slots[OF _ page_directory_at_aligned_pd_bits]) apply simp apply (simp add:pd_bits_def pageBits_def) @@ -1731,13 +1721,13 @@ lemma perform_page_directory_corres: apply (rule corres_split [OF _ gct_corres]) apply clarsimp apply (rule set_vm_root_corres) - apply wp + apply wp+ apply (simp add: cur_tcb_def[symmetric]) apply (wp hoare_drop_imps) apply (simp add: cur_tcb'_def[symmetric]) - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply clarsimp - apply (auto simp: valid_pdi_def)[2] + apply (auto simp: valid_pdi_def)[2] apply (clarsimp simp: page_directory_invocation_map_def) done @@ -1909,9 +1899,9 @@ lemma valid_slots_duplicated_updateCap[wp]: apply (case_tac m') apply (simp_all add:valid_slots_duplicated'_def) apply (case_tac a,case_tac aa,simp_all) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply (case_tac b,case_tac a,simp_all) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ done definition @@ -1994,7 +1984,7 @@ lemma pte_check_if_mapped_corres: P'="pspace_aligned' and pspace_distinct'", THEN iffD2]) apply (clarsimp simp: pte_relation'_def split: ) apply (case_tac pt, simp_all)[1] - apply wp + apply wp+ apply (simp) apply simp done @@ -2008,7 +1998,7 @@ lemma pde_check_if_mapped_corres: P'="pspace_aligned' and pspace_distinct'", THEN iffD2]) apply (clarsimp simp: pte_relation'_def split: ) apply (case_tac pd, simp_all)[1] - apply wp + apply wp+ apply (clarsimp simp: pte_relation_aligned_def split: if_split_asm) apply simp done @@ -2053,7 +2043,6 @@ lemma set_cap_valid_page_map_inv: "\valid_page_inv (ARM_A.page_invocation.PageMap asid cap slot m)\ set_cap cap slot \\rv. valid_page_map_inv asid cap slot m\" apply (simp add: valid_page_inv_def valid_page_map_inv_def) apply (wp set_cap_cte_wp_at_cases hoare_vcg_ex_lift| simp)+ - apply (simp_all) apply clarsimp apply (rule conjI, fastforce simp: cte_wp_at_def) apply (rule_tac x=a in exI, rule_tac x=b in exI) @@ -2180,7 +2169,7 @@ proof - apply (case_tac sum, case_tac aa) apply (clarsimp simp: mapping_map_def valid_slots'_def valid_slots_def valid_page_inv_def neq_Nil_conv valid_page_map_inv_def) apply (rule corres_name_pre) - apply (clarsimp simp:mapM_Cons bind_assoc split del:if_splits) + apply (clarsimp simp:mapM_Cons bind_assoc split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF _ pte_check_if_mapped_corres]) apply (rule corres_split[OF _ store_pte_corres']) @@ -2191,7 +2180,7 @@ proof - apply (simp add: last_byte_pte_def objBits_simps archObjSize_def) apply simp apply (rule no_fail_cleanCacheRange_PoU) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply (clarsimp simp:pte_relation_aligned_def) apply (clarsimp dest!:valid_slots_duplicated_pteD') apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) @@ -2202,7 +2191,7 @@ proof - apply (clarsimp simp:pte_relation_aligned_def) apply (clarsimp dest!:valid_slots_duplicated_pteD') apply (clarsimp simp del: fun_upd_apply simp add: cte_wp_at_caps_of_state) - apply (wp_trace add: hoare_vcg_const_Ball_lift store_pte_typ_at store_pte_cte_wp_at hoare_vcg_ex_lift) + apply (wp add: hoare_vcg_const_Ball_lift store_pte_typ_at store_pte_cte_wp_at hoare_vcg_ex_lift)+ apply (wp | simp add: pteCheckIfMapped_def)+ apply (clarsimp simp add: cte_wp_at_caps_of_state valid_slots_def parent_for_refs_def empty_refs_def invs_psp_aligned simp del: fun_upd_apply) apply (rule conjI) @@ -2221,7 +2210,7 @@ proof - apply (case_tac ba) apply (clarsimp simp: mapping_map_def valid_slots_def valid_slots'_def neq_Nil_conv valid_page_inv_def valid_page_map_inv_def) apply (rule corres_name_pre) - apply (clarsimp simp:mapM_Cons bind_assoc split del:if_splits) + apply (clarsimp simp:mapM_Cons bind_assoc split del:if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF _ pde_check_if_mapped_corres]) apply (rule corres_split[OF _ store_pde_corres']) @@ -2232,14 +2221,14 @@ proof - apply (simp add: last_byte_pde_def objBits_simps archObjSize_def) apply simp apply (rule no_fail_cleanCacheRange_PoU) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply (clarsimp simp: pde_relation_aligned_def) apply (clarsimp dest!:valid_slots_duplicated_pdeD' ) apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) prefer 2 apply auto[1] apply (wp mapM_swp_store_pde_invs_unmap[where pde="ARM_A.pde.InvalidPDE", simplified] hoare_vcg_ex_lift) - apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def del: fun_upd_apply)+ + apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def)+ apply (clarsimp simp: pde_relation_aligned_def) apply (clarsimp dest!:valid_slots_duplicated_pdeD') apply (clarsimp simp add: cte_wp_at_caps_of_state simp del: fun_upd_apply) @@ -2291,7 +2280,7 @@ proof - apply (clarsimp simp: mapping_map_def) apply (rule corres_name_pre) apply (clarsimp simp:mapM_Cons mapM_x_mapM bind_assoc valid_slots_def valid_page_inv_def - neq_Nil_conv split del:if_splits ) + neq_Nil_conv split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF _ pte_check_if_mapped_corres]) apply (rule corres_split[OF _ store_pte_corres']) @@ -2302,7 +2291,7 @@ proof - apply (simp add: last_byte_pte_def objBits_simps archObjSize_def) apply simp apply (rule no_fail_cleanCacheRange_PoU) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply (clarsimp simp:valid_page_inv'_def) apply (clarsimp dest!:valid_slots_duplicated_pteD') apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) @@ -2332,7 +2321,7 @@ proof - apply (rule corres_name_pre) apply (clarsimp simp: mapping_map_def valid_page_inv_def mapM_x_mapM mapM_Cons bind_assoc - valid_slots_def neq_Nil_conv split del:if_splits) + valid_slots_def neq_Nil_conv split del:if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF _ pde_check_if_mapped_corres]) apply (rule corres_split[OF _ store_pde_corres']) @@ -2343,14 +2332,14 @@ proof - apply (simp add: last_byte_pde_def objBits_simps archObjSize_def) apply simp apply (rule no_fail_cleanCacheRange_PoU) - apply (wp hoare_vcg_ex_lift) + apply (wp hoare_vcg_ex_lift)+ apply (clarsimp simp: pde_relation_aligned_def valid_page_inv'_def) apply (clarsimp dest!:valid_slots_duplicated_pdeD' ) apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) prefer 2 apply auto[1] apply (wp mapM_swp_store_pde_invs_unmap[where pde="ARM_A.pde.InvalidPDE", simplified] hoare_vcg_ex_lift) - apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def del: fun_upd_apply)+ + apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def)+ apply (clarsimp simp: pde_relation_aligned_def valid_page_inv'_def) apply (clarsimp dest!:valid_slots_duplicated_pdeD') apply (clarsimp simp add: cte_wp_at_caps_of_state simp del: fun_upd_apply) @@ -2409,7 +2398,7 @@ proof - apply (rule_tac F="is_page_cap cap" in corres_gen_asm) apply (rule updateCap_same_master) apply (clarsimp simp: is_page_cap_def update_map_data_def) - apply (wp get_cap_wp getSlotCap_wp) + apply (wp get_cap_wp getSlotCap_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def) apply (drule (2) diminished_is_update')+ apply (clarsimp simp: cap_rights_update_def acap_rights_update_def update_map_data_def is_cap_simps) @@ -2429,7 +2418,7 @@ proof - apply (rule_tac F="is_page_cap cap" in corres_gen_asm) apply (rule updateCap_same_master) apply (clarsimp simp: is_page_cap_def update_map_data_def) - apply (wp get_cap_wp getSlotCap_wp) + apply (wp get_cap_wp getSlotCap_wp)+ apply (simp add: cte_wp_at_caps_of_state) apply (strengthen pull_out_P)+ apply wp @@ -2454,11 +2443,11 @@ proof - apply (rule corres_split [OF _ gct_corres]) apply simp apply (rule set_vm_root_corres) - apply wp + apply wp+ apply (simp add: cur_tcb_def [symmetric] cur_tcb'_def [symmetric]) apply (wp hoare_drop_imps) apply (simp add: cur_tcb_def [symmetric] cur_tcb'_def [symmetric]) - apply (wp hoare_drop_imps) + apply (wp hoare_drop_imps)+ apply (auto simp: valid_page_inv_def)[2] -- "PageGetAddr" apply (clarsimp simp: perform_page_invocation_def performPageInvocation_def page_invocation_map_def fromPAddr_def) @@ -2468,7 +2457,7 @@ proof - apply (rule corres_split[OF set_mi_corres set_mrs_corres]) apply (simp add: message_info_map_def) apply clarsimp - apply (wp) + apply (wp)+ apply (clarsimp simp: tcb_at_invs) apply (clarsimp simp: tcb_at_invs') done @@ -2551,7 +2540,7 @@ lemma perform_page_table_corres: apply (rule corres_Id, rule refl, simp) apply (rule no_fail_cleanByVA_PoU) apply (simp add: pde_relation_aligned_def) - apply (wp set_cap_typ_at) + apply (wp set_cap_typ_at)+ apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state is_arch_update_def) apply (clarsimp simp: is_cap_simps cap_master_cap_simps dest!: cap_master_cap_eqDs) @@ -2574,14 +2563,14 @@ lemma perform_page_table_corres: apply (rule_tac F="is_pt_cap x" in corres_gen_asm) apply (rule updateCap_same_master) apply (clarsimp simp: is_pt_cap_def update_map_data_def) - apply (wp get_cap_wp) + apply (wp get_cap_wp)+ apply (rule corres_if[OF refl]) apply (rule corres_split [OF _ unmap_page_table_corres]) apply (rule corres_split_nor) apply (rule corres_machine_op, rule corres_Id) apply simp+ apply (rule clear_page_table_corres) - apply wp + apply wp+ apply (rule corres_trivial, simp) apply (simp add: cte_wp_at_caps_of_state pred_conj_def split del: if_split) @@ -2648,13 +2637,13 @@ lemma pap_corres: apply (clarsimp simp: mask_asid_low_bits_ucast_ucast) apply (drule ucast_ucast_eq, simp, simp, simp) apply assumption - apply (wp set_cap_typ_at) + apply (wp set_cap_typ_at)+ apply clarsimp apply (erule cte_wp_at_weakenE) apply (clarsimp simp: is_cap_simps cap_master_cap_simps dest!: cap_master_cap_eqDs) apply (wp getASID_wp) apply (rule refl) - apply (wp get_cap_wp getCTE_wp) + apply (wp get_cap_wp getCTE_wp)+ apply (clarsimp simp: valid_apinv_def cte_wp_at_def cap_master_cap_def is_pd_cap_def obj_at_def) apply (clarsimp simp: a_type_def) apply (clarsimp simp: cte_wp_at_ctes_of valid_apinv'_def) @@ -3021,7 +3010,7 @@ lemma storePDE_ifunsafe [wp]: lemma storePDE_idle [wp]: "\valid_idle'\ storePDE p pde \\rv. valid_idle'\" unfolding valid_idle'_def - by (rule hoare_lift_Pf [where f="ksIdleThread"]) wp + by (rule hoare_lift_Pf [where f="ksIdleThread"]; wp) crunch arch' [wp]: storePDE "\s. P (ksArchState s)" (ignore: setObject) @@ -3032,9 +3021,8 @@ crunch cur' [wp]: storePDE "\s. P (ksCurThread s)" lemma storePDE_irq_states' [wp]: "\valid_irq_states'\ storePDE pde p \\_. valid_irq_states'\" apply (simp add: storePDE_def) - apply (wp valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine) - apply simp - apply (wp updateObject_default_inv) + apply (wpsimp wp: valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine + updateObject_default_inv) done crunch no_0_obj' [wp]: storePDE no_0_obj' @@ -3045,14 +3033,15 @@ lemma storePDE_pde_mappings'[wp]: \\rv. valid_pde_mappings'\" apply (rule hoare_gen_asm) apply (wp valid_pde_mappings_lift') - apply (rule hoare_post_imp) - apply (simp only: obj_at'_real_def) - apply (simp add: storePDE_def) - apply (wp setObject_ko_wp_at) - apply simp - apply (simp add: objBits_simps archObjSize_def) - apply simp - apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs) + apply (rule hoare_post_imp) + apply (simp only: obj_at'_real_def) + apply (simp add: storePDE_def) + apply (wp setObject_ko_wp_at) + apply simp + apply (simp add: objBits_simps archObjSize_def) + apply simp + apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs) + apply assumption done lemma storePDE_vms'[wp]: @@ -3214,7 +3203,7 @@ lemma storePTE_ifunsafe [wp]: lemma storePTE_idle [wp]: "\valid_idle'\ storePTE p pte \\rv. valid_idle'\" unfolding valid_idle'_def - by (rule hoare_lift_Pf [where f="ksIdleThread"]) wp + by (rule hoare_lift_Pf [where f="ksIdleThread"]; wp) crunch arch' [wp]: storePTE "\s. P (ksArchState s)" (ignore: setObject) @@ -3225,9 +3214,8 @@ crunch cur' [wp]: storePTE "\s. P (ksCurThread s)" lemma storePTE_irq_states' [wp]: "\valid_irq_states'\ storePTE pte p \\_. valid_irq_states'\" apply (simp add: storePTE_def) - apply (wp valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine) - apply simp - apply (wp updateObject_default_inv) + apply (wpsimp wp: valid_irq_states_lift' dmo_lift' no_irq_storeWord setObject_ksMachine + updateObject_default_inv) done lemma storePTE_valid_objs [wp]: @@ -3247,9 +3235,10 @@ crunch no_0_obj' [wp]: storePTE no_0_obj' lemma storePTE_pde_mappings'[wp]: "\valid_pde_mappings'\ storePTE p pte \\rv. valid_pde_mappings'\" apply (wp valid_pde_mappings_lift') - apply (simp add: storePTE_def) - apply (rule obj_at_setObject2) - apply (clarsimp dest!: updateObject_default_result) + apply (simp add: storePTE_def) + apply (rule obj_at_setObject2) + apply (clarsimp dest!: updateObject_default_result) + apply assumption done lemma storePTE_vms'[wp]: @@ -3407,9 +3396,7 @@ lemma setASIDPool_it' [wp]: lemma setASIDPool_idle [wp]: "\valid_idle'\ setObject p (ap::asidpool) \\rv. valid_idle'\" unfolding valid_idle'_def - apply (rule hoare_lift_Pf [where f="ksIdleThread"]) - apply wp - done + by (rule hoare_lift_Pf [where f="ksIdleThread"]; wp) lemma setASIDPool_irq_states' [wp]: "\valid_irq_states'\ setObject p (ap::asidpool) \\_. valid_irq_states'\" @@ -3425,8 +3412,9 @@ lemma setASIDPool_irq_states' [wp]: lemma setObject_asidpool_mappings'[wp]: "\valid_pde_mappings'\ setObject p (ap::asidpool) \\rv. valid_pde_mappings'\" apply (wp valid_pde_mappings_lift') - apply (rule obj_at_setObject2) - apply (clarsimp dest!: updateObject_default_result) + apply (rule obj_at_setObject2) + apply (clarsimp dest!: updateObject_default_result) + apply assumption done lemma setASIDPool_vms'[wp]: @@ -3477,7 +3465,7 @@ lemma setObject_asidpool_tcb_in_cur_domain'[wp]: lemma setObject_asidpool_ct_idle_or_in_cur_domain'[wp]: "\ct_idle_or_in_cur_domain'\ setObject p (ap::asidpool) \\_. ct_idle_or_in_cur_domain'\" apply (rule ct_idle_or_in_cur_domain'_lift) - apply (wp hoare_vcg_disj_lift) + apply (wp hoare_vcg_disj_lift)+ done lemma setObject_ap_ksDomScheduleIdx [wp]: @@ -3702,8 +3690,7 @@ lemma perform_pt_invs [wp]: apply (case_tac cte) apply clarsimp apply (drule ctes_of_valid_cap', fastforce) - apply (clarsimp simp: valid_cap'_def capAligned_def - cte_wp_at_ctes_of valid_page_inv'_def valid_cap'_def + apply (clarsimp simp: valid_cap'_def cte_wp_at_ctes_of valid_page_inv'_def capAligned_def is_arch_update'_def isCap_simps) apply clarsimp apply (wp arch_update_updateCap_invs unmapPage_cte_wp_at' getSlotCap_wp|wpc)+ @@ -3711,19 +3698,19 @@ lemma perform_pt_invs [wp]: apply (rule_tac Q="\_. invs' and cte_wp_at' (\cte. \d r R sz m. cteCap cte = ArchObjectCap (PageCap d r R sz m)) word" in hoare_strengthen_post) - apply (wp unmapPage_cte_wp_at') - apply (clarsimp simp: cte_wp_at_ctes_of) - apply (simp add: is_arch_update'_def isCap_simps) - apply (case_tac cte) - apply clarsimp+ + apply (wp unmapPage_cte_wp_at') + apply (clarsimp simp: cte_wp_at_ctes_of) + apply (case_tac cte) + apply clarsimp + apply (frule ctes_of_valid_cap') + apply (auto simp: valid_page_inv'_def valid_slots'_def + cte_wp_at_ctes_of valid_pde_slots'_def)[1] + apply (simp add: is_arch_update'_def isCap_simps) + apply (simp add: valid_cap'_def capAligned_def) apply (clarsimp simp: cte_wp_at_ctes_of) - apply (case_tac cte) - apply clarsimp - apply (frule ctes_of_valid_cap') - apply (auto simp: valid_page_inv'_def valid_slots'_def - cte_wp_at_ctes_of valid_pde_slots'_def)[1] apply (simp add: is_arch_update'_def isCap_simps) - apply (simp add: valid_cap'_def capAligned_def) + apply (case_tac cte) + apply clarsimp+ done lemma ucast_ucast_le_low_bits [simp]: @@ -3749,7 +3736,7 @@ lemma perform_aci_invs [wp]: split: if_split_asm) apply (case_tac ko, clarsimp simp: inv_def) apply (clarsimp simp: page_directory_at'_def, drule_tac x=0 in spec) - apply (auto elim!: invs_no_0_obj') + apply auto done lemma capMaster_isPDCap: diff --git a/proof/sep-capDL/Frame_SD.thy b/proof/sep-capDL/Frame_SD.thy index d50386e88..bb8e4d550 100644 --- a/proof/sep-capDL/Frame_SD.thy +++ b/proof/sep-capDL/Frame_SD.thy @@ -359,7 +359,7 @@ lemma set_cdl_tcb_field_wp: apply (simp add:object_type_simps object_wipe_slots_object_clean)+ apply (drule_tac tcb = cdl_tcb in fields_cong) apply simp - apply wp + apply wp+ apply (clarsimp simp:opt_object_def object_at_def) done diff --git a/proof/sep-capDL/Helpers_SD.thy b/proof/sep-capDL/Helpers_SD.thy index 9c069fb69..c48f14cb8 100644 --- a/proof/sep-capDL/Helpers_SD.thy +++ b/proof/sep-capDL/Helpers_SD.thy @@ -976,7 +976,7 @@ lemma derive_cap_non_exclusive: apply (clarsimp simp: validE_R_def derive_cap_def safe_for_derive_def split:cdl_cap.splits) - apply (intro conjI allI impI,wp) + apply (intro conjI allI impI, wp+) done lemma derived_cap_safe_for_derive[simp]: diff --git a/sys-init/CreateIRQCaps_SI.thy b/sys-init/CreateIRQCaps_SI.thy index 5836f1991..084032fb8 100644 --- a/sys-init/CreateIRQCaps_SI.thy +++ b/sys-init/CreateIRQCaps_SI.thy @@ -189,6 +189,7 @@ lemma create_irq_caps_sep_helper: and K ((map_of (zip (used_irq_list spec) free_cptrs), drop (card (used_irqs spec)) free_cptrs) = rv \ inj_on t' (used_irq_nodes spec) \ dom t' = used_irq_nodes spec)\ s\" + including no_pre apply clarsimp apply (rule hoare_gen_asm_conj) apply (clarsimp simp: create_irq_caps_def si_irq_nodes_def2 sep_conj_exists) diff --git a/sys-init/CreateObjects_SI.thy b/sys-init/CreateObjects_SI.thy index 143d6f386..3f1e94247 100644 --- a/sys-init/CreateObjects_SI.thy +++ b/sys-init/CreateObjects_SI.thy @@ -1333,7 +1333,7 @@ lemma retype_untypeds_wp_helper: apply (rule_tac x=all_available_ids in exI) apply (rule_tac x=t in exI) apply fastforce - apply wp + apply wp+ apply (clarsimp simp: opt_object_def real_object_at_def) apply blast apply clarsimp diff --git a/sys-init/DuplicateCaps_SI.thy b/sys-init/DuplicateCaps_SI.thy index 32590e6c2..8fe31714c 100644 --- a/sys-init/DuplicateCaps_SI.thy +++ b/sys-init/DuplicateCaps_SI.thy @@ -109,6 +109,7 @@ lemma duplicate_cap_sep_helper: \si_cap_at t (map_of (zip [obj\obj_ids. cnode_or_tcb_at obj spec] free_cptrs)) spec dev obj_id \* si_cap_at t orig_caps spec dev obj_id \* si_objects \* R\ s\" + including no_pre apply (rule hoare_assume_pre) apply (clarsimp simp: duplicate_cap_def si_cap_at_def sep_conj_exists) apply (rule_tac x=free_cptr in hoare_exI) @@ -181,7 +182,8 @@ lemma duplicate_caps_sep_helper: duplicate_caps spec orig_caps obj_ids free_cptrs \\dup_caps. \si_caps_at t dup_caps spec dev {obj_id. cnode_or_tcb_at obj_id spec} \* - si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects \* R\\" + si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects \* R\\" + including no_pre apply (rule hoare_gen_asm) apply (clarsimp simp: duplicate_caps_def si_caps_at_def) apply (wp) diff --git a/sys-init/InitCSpace_SI.thy b/sys-init/InitCSpace_SI.thy index 4495194d0..9340b8bd7 100644 --- a/sys-init/InitCSpace_SI.thy +++ b/sys-init/InitCSpace_SI.thy @@ -1179,10 +1179,10 @@ lemma init_cnode_slot_move_not_original_inv: \ \P\ init_cnode_slot spec orig_caps dup_caps irq_caps Move obj_id slot \\_. P\" apply (clarsimp simp: init_cnode_slot_def cap_at_def) apply wp + apply (rule hoare_pre_cont) apply (rule hoare_pre_cont) - apply (rule hoare_pre_cont) - apply clarsimp - apply wp + apply clarsimp + apply wp+ apply clarsimp done @@ -1206,7 +1206,7 @@ lemma init_cnode_slot_move_not_original_sep: si_spec_irq_null_cap_at irq_caps spec obj_id slot \* si_cap_at t dup_caps spec dev obj_id \* object_fields_empty spec t obj_id \* si_objects \* R\\" - apply (wp init_cnode_slot_move_not_original_inv, simp) + apply (wp init_cnode_slot_move_not_original_inv) apply (subst (asm) cnode_slot_half_initialised_not_original_slot, assumption+) apply (subst (asm) si_obj_cap_at_si_spec_obj_null_cap_at_not_original, assumption) apply (clarsimp simp: si_spec_irq_cap_at_def si_spec_irq_null_cap_at_def original_cap_at_def) @@ -1226,8 +1226,8 @@ lemma init_cnode_slot_move_sep: si_cap_at t dup_caps spec dev obj_id \* object_fields_empty spec t obj_id \* si_objects \* R\\" apply (case_tac "original_cap_at (obj_id, slot) spec") - apply (wp init_cnode_slot_move_original_sep, simp+) - apply (wp init_cnode_slot_move_not_original_sep, simp+) + apply (wp init_cnode_slot_move_original_sep) + apply (wp init_cnode_slot_move_not_original_sep) done lemma init_cnode_slots_move_sep: @@ -1680,9 +1680,9 @@ lemma init_cspace_sep': si_objects \* R\\" apply (rule hoare_gen_asm) apply (unfold init_cspace_def) - apply wp - apply (wp init_cspace_move_sep, simp+) - apply (wp init_cspace_copy_sep, simp+) + apply (wp init_cspace_move_sep) + apply (wp init_cspace_copy_sep)+ + apply simp done lemma hoare_subst: diff --git a/sys-init/InitVSpace_SI.thy b/sys-init/InitVSpace_SI.thy index 39f483be8..f1cf58d68 100644 --- a/sys-init/InitVSpace_SI.thy +++ b/sys-init/InitVSpace_SI.thy @@ -575,6 +575,7 @@ lemma set_asid_wp: set_asid spec orig_caps obj_id \\rv. \si_caps_at t orig_caps spec dev {obj_id. real_object_at obj_id spec} \* si_objects \* R\\" + including no_pre apply (rule hoare_gen_asm, clarsimp) apply (frule (1) object_at_real_object_at) apply (rule valid_si_caps_at_si_cap_at [where obj_id=obj_id], clarsimp+) @@ -822,7 +823,7 @@ lemma map_page_in_pt_sep: si_caps_at t orig_caps spec False {obj_id. real_object_at obj_id spec} \* si_objects \* R\\" - + including no_pre apply (rule hoare_gen_asm, clarsimp) apply (simp add:map_page_def) apply (rule assert_opt_validI)+ @@ -836,8 +837,8 @@ lemma map_page_in_pt_sep: apply (frule (1) object_at_real_object_at [where obj_id = "cap_object pt_cap"]) apply (frule (1) object_at_real_object_at [where obj_id = "cap_object frame_cap"]) apply (intro conjI) - apply (clarsimp simp: object_at_def is_pt_def is_frame_def - ,simp split:cdl_object.splits) + apply (clarsimp simp: object_at_def is_pt_def is_frame_def, + simp split:cdl_object.splits) apply clarsimp apply wp apply (clarsimp simp: object_at_def) @@ -1006,7 +1007,7 @@ lemma map_page_table_slots_wp': apply (clarsimp simp: object_at_def object_type_is_object cap_ref_object_def split: cdl_cap.splits) apply (clarsimp simp: sep_conj_assoc) - apply (wp sep_wp: map_page_table_slots_wp'' [where t=t], simp+) + apply (wp sep_wp: map_page_table_slots_wp'' [where t=t]) apply sep_solve done diff --git a/tools/autocorres/ExceptionRewrite.thy b/tools/autocorres/ExceptionRewrite.thy index 350245ab5..b2217c549 100644 --- a/tools/autocorres/ExceptionRewrite.thy +++ b/tools/autocorres/ExceptionRewrite.thy @@ -212,6 +212,7 @@ lemma L1_fail_noreturn [simp,L1except]: "no_return \ L1_fail" lemma L1_seq_noreturn_lhs: "no_return \ L \ no_return \ (L1_seq L R)" apply (clarsimp simp: L1_defs no_return_def) + including no_pre apply wp apply clarsimp done diff --git a/tools/autocorres/ExecConcrete.thy b/tools/autocorres/ExecConcrete.thy index b372eccfa..f50a17e50 100644 --- a/tools/autocorres/ExecConcrete.thy +++ b/tools/autocorres/ExecConcrete.thy @@ -68,6 +68,7 @@ lemmas exec_transformed_wp_nf [wp] = lemma exec_transformed_return_wp [wp]: "\ \s. \s''. (\s'. (s, s') \ sr \ (s'', s') \ sr) \ P a s'' \ exec_transformed sr (return a) \ P \" + including no_pre apply wp apply clarsimp apply force @@ -75,6 +76,7 @@ lemma exec_transformed_return_wp [wp]: lemma exec_transformed_returnOk_wp [wp]: "\ \s. \s''. (\s'. (s, s') \ sr \ (s'', s') \ sr) \ P a s'' \ exec_transformed sr (returnOk a) \ P \,\ E \" + including no_pre apply wp apply clarsimp apply force @@ -88,9 +90,8 @@ lemma exec_transformed_fail_wp_nf [wp]: done lemma exec_transformed_fail_wp [wp]: - "\ \_. True \ exec_transformed st fail \ P \" - by wp - + "\ \_. True \ exec_transformed st fail \ P \" + including no_pre by wp (* * Execute the given monad with a concrete state. @@ -149,6 +150,7 @@ lemma exec_concrete_wp_nf [wp]: apply rule apply (rule exec_concrete_wp) apply (erule validNF_valid) + including no_pre apply wp apply (erule validNF_no_fail) done diff --git a/tools/autocorres/HeapLift.thy b/tools/autocorres/HeapLift.thy index 63d9b944a..6c29a4811 100644 --- a/tools/autocorres/HeapLift.thy +++ b/tools/autocorres/HeapLift.thy @@ -283,7 +283,7 @@ lemma L2Tcorres_exec_concrete [heap_abs]: apply (rule corresXF_except) apply assumption apply (rule corresXF_fail) - apply wp[1] + including no_pre apply wp apply simp done @@ -303,7 +303,7 @@ lemma L2Tcorres_exec_abstract [heap_abs]: apply (rule corresXF_except) apply assumption apply (rule corresXF_fail) - apply wp[1] + including no_pre apply wp apply simp done diff --git a/tools/autocorres/L1Defs.thy b/tools/autocorres/L1Defs.thy index 852691ee4..8770761b9 100644 --- a/tools/autocorres/L1Defs.thy +++ b/tools/autocorres/L1Defs.thy @@ -324,7 +324,7 @@ lemma L1corres_prepend_unknown_var': apply (monad_eq simp: Bex_def) apply metis apply (subst L1_init_def) - apply (wp select_wp) + including no_pre apply (wp select_wp) apply fastforce done diff --git a/tools/autocorres/L1Valid.thy b/tools/autocorres/L1Valid.thy index 6e193f4f9..d7ea5fc8f 100644 --- a/tools/autocorres/L1Valid.thy +++ b/tools/autocorres/L1Valid.thy @@ -119,6 +119,7 @@ lemma L1_catch_lp: " \s. E2 () s \ E () s \ \ \P\ L1_catch A B \Q\, \E\" apply (clarsimp simp: L1_catch_def) + including no_pre apply wp apply (erule validE_weaken, simp+)[1] apply (erule validE_weaken, simp+)[1] diff --git a/tools/autocorres/tests/examples/Factorial.thy b/tools/autocorres/tests/examples/Factorial.thy index 5a5fadd0e..7f2fc0616 100644 --- a/tools/autocorres/tests/examples/Factorial.thy +++ b/tools/autocorres/tests/examples/Factorial.thy @@ -94,7 +94,6 @@ proof (induct n arbitrary: m) apply wp apply (simp del: One_nat_def) apply (wp induct_asm) - apply assumption apply unat_arith apply assumption done diff --git a/tools/autocorres/tests/examples/Memcpy.thy b/tools/autocorres/tests/examples/Memcpy.thy index c794ee44b..74a31437b 100644 --- a/tools/autocorres/tests/examples/Memcpy.thy +++ b/tools/autocorres/tests/examples/Memcpy.thy @@ -80,7 +80,7 @@ lemma memcpy_char: (* The remaining loop is never encountered *) apply (rule validNF_false_pre) - apply wp + apply wp+ (* Finally we're left with the single assignment *) apply (clarsimp simp:hrs_mem_update h_val_heap_update) diff --git a/tools/autocorres/tests/proof-tests/heap_lift_force_prevent.thy b/tools/autocorres/tests/proof-tests/heap_lift_force_prevent.thy index 3051a3e78..9706df8ae 100644 --- a/tools/autocorres/tests/proof-tests/heap_lift_force_prevent.thy +++ b/tools/autocorres/tests/proof-tests/heap_lift_force_prevent.thy @@ -43,7 +43,7 @@ lemma unlifted_a_wp [wp]: lemma lifted_b_wp [wp]: "\ \s. is_valid_w32 s p \ (\a. heap_w32 s p = a \ P (a * 3) s) \ lifted_b' p \ \r s. P r s \" apply (clarsimp simp: lifted_b'_def) - apply wp + including no_pre apply wp apply (auto simp: simple_lift_c_guard lift_global_heap_def field_simps) done From 45df23b3e1a8b9d1784eb96daea8041dc6bf32fb Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Tue, 10 Jan 2017 11:41:10 +0100 Subject: [PATCH 4/7] infoflow examples: clean out unnecessary warnings --- proof/infoflow/Example_Valid_State.thy | 6 ++---- proof/infoflow/PolicyExample.thy | 2 +- proof/infoflow/PolicySystemSAC.thy | 14 ++++++-------- 3 files changed, 9 insertions(+), 13 deletions(-) diff --git a/proof/infoflow/Example_Valid_State.thy b/proof/infoflow/Example_Valid_State.thy index e36998771..6beca7b40 100644 --- a/proof/infoflow/Example_Valid_State.thy +++ b/proof/infoflow/Example_Valid_State.thy @@ -778,7 +778,7 @@ lemma kh0_dom: irq_node_offs_range" apply (rule equalityI) apply (simp add: kh0_def dom_def) - apply (clarsimp simp: irq_node_offs_in_range irq_node_offs_distinct) + apply (clarsimp simp: irq_node_offs_in_range) apply (clarsimp simp: dom_def) apply (rule conjI, clarsimp simp: kh0_def)+ apply (force simp: kh0_def cte_level_bits_def dest: irq_node_offs_range_correct) @@ -1000,8 +1000,6 @@ lemma Sys1_pas_wellformed: Sys1AuthGraph_def) done -declare AllowSend_def[simp] AllowRecv_def[simp] - lemma domains_of_state_s0[simp]: "domains_of_state s0_internal = {(High_tcb_ptr, High_domain), (Low_tcb_ptr, Low_domain), (idle_tcb_ptr, default_domain)}" apply(rule equalityI) @@ -1750,7 +1748,7 @@ lemma respects_device_trivial: cap_range_respects_device_region_def machine_state0_def) apply (intro conjI impI) apply (drule s0_caps_of_state) - apply (fastforce simp: cap_is_device.simps)[1] + apply fastforce apply (clarsimp simp: s0_internal_def machine_state0_def) done diff --git a/proof/infoflow/PolicyExample.thy b/proof/infoflow/PolicyExample.thy index 42ab43895..b9c6b36a8 100644 --- a/proof/infoflow/PolicyExample.thy +++ b/proof/infoflow/PolicyExample.thy @@ -209,7 +209,7 @@ lemmas subjectReads_C' = reads_lrefl[of "partition_label C"] lemma subjectReads_C: "subjectReads example_auth_graph (partition_label C) = {partition_label C,partition_label CTR,partition_label NTFN1, partition_label EP, partition_label RM, partition_label NTFN2}" - apply(clarsimp simp: example_auth_graph_def) + apply(clarsimp) apply(rule equalityI) apply(rule subsetI) apply(erule subjectReads.induct) diff --git a/proof/infoflow/PolicySystemSAC.thy b/proof/infoflow/PolicySystemSAC.thy index 2454aae23..25bb9bedb 100644 --- a/proof/infoflow/PolicySystemSAC.thy +++ b/proof/infoflow/PolicySystemSAC.thy @@ -163,11 +163,11 @@ lemma abd_reads_all_bw : "x \ {NicA, NicB, NicD} \ {partitio (* non refl cases *) apply (case_tac "xa \ RMControls") apply (rule reads_all_rm_controlled_subjects, rule abd_reads_rm, simp, simp) - apply (erule_tac a = xa in insertE, simp add:RMControls_def) + apply (erule_tac a = xa in insertE, simp) apply (erule_tac a = xa in insertE, simp only:, rule abd_reads_rm, simp) - apply (erule_tac a = xa in insertE, simp add:RMControls_def) - apply (erule_tac a = xa in insertE, simp add:RMControls_def) - apply (erule_tac a = xa in insertE, simp add:RMControls_def) + apply (erule_tac a = xa in insertE, simp) + apply (erule_tac a = xa in insertE, simp) + apply (erule_tac a = xa in insertE, simp) apply (erule_tac a = xa in insertE, simp only:, rule abdrm_reads_ep, simp, blast) apply (erule_tac a = xa in insertE, simp only:, rule abdrm_reads_sc, simp, blast) apply (erule_tac a = xa in insertE, simp only:, rule abd_reads_c, simp) @@ -625,7 +625,7 @@ lemma ep_affects: "subjectAffects SACAuthGraph (partition_label EP) = {partition (* forward *) apply (rule subsetI) apply (erule subjectAffects.induct) - by (simp add:SACAuthGraph_def, blast?)+ + by (simp, blast?)+ subsection {* NTFN1,2,3 *} @@ -899,8 +899,6 @@ lemma t_affects : "subjectAffects SACAuthGraph (partition_label T) = {partition_ subsection {* Policy *} -declare SACAuthGraph_def [simp del] - lemmas SAC_reads = sc_reads ep_reads c_reads rm_reads r_reads abd_reads ntfn123_reads t_reads lemmas SAC_affects = sc_affects ep_affects c_affects rm_affects r_affects abd_affects ntfn1_affects ntfn2_affects ntfn3_affects t_affects @@ -961,7 +959,7 @@ lemma SAC_policyFlows : "policyFlows SACAuthGraph = SACPolicyFlows" (* scheduler flows to all *) apply (simp add:PSched_flows_to_all) (* all subjects flow to all subjects *) - apply (clarify, simp del:SACAuthGraph_def) + apply (clarify, simp) apply (rule policy_affects) apply (case_tac l, case_tac[1-12] k, auto simp:SAC_partsSubjectAffects_T SAC_partsSubjectAffects_exceptT) done From c1cb43e83fed2a90d6681cfec520d537fea713ff Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Tue, 10 Jan 2017 20:24:03 +0100 Subject: [PATCH 5/7] trivial: ignore generated files --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 9cdc197bf..d792b1fa8 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,7 @@ *.lev *#*# +spec/cspec/c/32/ spec/cspec/c/api/ spec/cspec/c/arch/ spec/cspec/c/kernel_all.c From 8ac1200329498ce03501638c86596fa32a0548f4 Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Fri, 26 Aug 2016 15:28:17 +1000 Subject: [PATCH 6/7] cleanup: remove accidentally declared const --- proof/infoflow/Example_Valid_State.thy | 23 +++++++++++------------ spec/design/m-skel/ARM/MachineTypes.thy | 6 +++--- spec/machine/ARM/MachineTypes.thy | 6 +++--- 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/proof/infoflow/Example_Valid_State.thy b/proof/infoflow/Example_Valid_State.thy index 6beca7b40..b96cab505 100644 --- a/proof/infoflow/Example_Valid_State.thy +++ b/proof/infoflow/Example_Valid_State.thy @@ -14,8 +14,6 @@ imports "../../lib/Distinct_Cmd" begin -context begin interpretation Arch . (*FIXME: arch_split*) - section {* Example *} (* This example is a classic 'one way information flow' @@ -25,10 +23,20 @@ section {* Example *} implement a ring-buffer. We consider the NTFN to be in the domain of High, and the shared memory to be in the domain of Low. *) +(* basic machine-level declarations that need to happen outside the locale *) + +consts s0_context :: user_context + +(* define the irqs to come regularly every 10 *) + +axiomatization where + irq_oracle_def: "ARM.irq_oracle \ \pos. if pos mod 10 = 0 then 10 else 0" + +context begin interpretation Arch . (*FIXME: arch_split*) + subsection {* We show that the authority graph does not let information flow from High to Low *} - datatype auth_graph_label = High | Low | IRQ0 abbreviation partition_label where @@ -1142,10 +1150,6 @@ lemma silc_inv_s0: apply (clarsimp simp: all_children_def s0_internal_def silc_dom_equiv_def equiv_for_refl) done - -text {* define the irq's to come regularly every 10 *} - -defs irq_oracle_def: "irq_oracle \ \pos. if pos mod 10 = 0 then 10 else 0" lemma only_timer_irq_s0: "only_timer_irq timer_irq s0_internal" @@ -1174,11 +1178,6 @@ lemma s0_valid_domain_list: "valid_domain_list s0_internal" by (clarsimp simp: valid_domain_list_2_def s0_internal_def exst0_def) -end - -consts s0_context :: user_context - -context begin interpretation Arch . (*FIXME: arch_split*) definition "s0 \ ((if ct_idle s0_internal then idle_context s0_internal else s0_context,s0_internal),KernelExit)" diff --git a/spec/design/m-skel/ARM/MachineTypes.thy b/spec/design/m-skel/ARM/MachineTypes.thy index 75f1160e7..d796f362e 100644 --- a/spec/design/m-skel/ARM/MachineTypes.thy +++ b/spec/design/m-skel/ARM/MachineTypes.thy @@ -80,9 +80,9 @@ record exclusive_state :: ARM.exclusive_monitors machine_state_rest :: ARM.machine_state_rest -consts irq_oracle :: "nat \ 10 word" - -axiomatization irq_oracle_max_irqInst where +axiomatization + irq_oracle :: "nat \ 10 word" +where irq_oracle_max_irq: "\ n. (irq_oracle n) <= ARM.maxIRQ" end_qualify diff --git a/spec/machine/ARM/MachineTypes.thy b/spec/machine/ARM/MachineTypes.thy index 33a6423ca..136f59915 100644 --- a/spec/machine/ARM/MachineTypes.thy +++ b/spec/machine/ARM/MachineTypes.thy @@ -208,9 +208,9 @@ record exclusive_state :: ARM.exclusive_monitors machine_state_rest :: ARM.machine_state_rest -consts irq_oracle :: "nat \ 10 word" - -axiomatization irq_oracle_max_irqInst where +axiomatization + irq_oracle :: "nat \ 10 word" +where irq_oracle_max_irq: "\ n. (irq_oracle n) <= ARM.maxIRQ" end_qualify From 3fee2d83b42dc6dd6515d5d4ba7dc3781466fe4e Mon Sep 17 00:00:00 2001 From: Gerwin Klein Date: Fri, 13 Jan 2017 18:31:59 +0100 Subject: [PATCH 7/7] cleanup: correct version info --- spec/design/version | 28 ++-------------------------- 1 file changed, 2 insertions(+), 26 deletions(-) diff --git a/spec/design/version b/spec/design/version index 3552f5794..397d9fa6b 100644 --- a/spec/design/version +++ b/spec/design/version @@ -1,32 +1,8 @@ -Built from git repo at /home/agomezl/NICTA/verification/l4v/spec/haskell by agomezl +Built from git repo at /Users/kleing/verification/l4v/spec/haskell by kleing Generated from changeset: -55a331c ExecSpec: Changes to the haskell to better reflect ASpec +9668464 cleanup: remove accidentally declared const Warning - uncomitted changes used: -M ../design/skel/TCBDecls_H.thy M ../design/version -?? ../../.tramp_history -?? ../../diff_sel4 -?? ../../kernel_all_1.txt -?? ../../kernel_all_2.txt -?? ../../olf_kernel_all.c_pp -?? ../../proof/access-control/Syscall_AC.thy.bkp -?? ../../proof/crefine/.Fastpath_C.thy.marks -?? ../../proof/crefine/.Ipc_C.thy.marks -?? ../../proof/crefine/.IsolatedThreadAction.thy.marks -?? ../../proof/crefine/Fastpath_C2.thy -?? ../../proof/crefine/IsolatedThreadAction.thy.bkp -?? ../../proof/drefine/Tcb_DR.thy.bkp -?? ../../proof/infoflow/ADT_IF_Refine.thy.bkp -?? ../../proof/infoflow/ADT_IF_Refine_C.thy.bkp -?? ../../proof/infoflow/Example_Valid_StateH.thy.bkp -?? ../../proof/invariant-abstract/DetSchedDomainTime_AI.thy.bkp -?? ../../proof/refine/DomainTime_R.thy.bkp -?? ../cspec/c/32/ -?? ../design/skel/ARM/ArchFault_H.thy.bkp -?? ../../test-images/ -?? ../../tools/c-parser/testfiles/test_foo.c -?? ../../tools/c-parser/testfiles/test_foo.thy -?? ../../tws_rm.sh