adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge master into x64-split

This commit is contained in:
Matthew Brecknell 2017-01-13 17:22:03 +11:00
parent c1782fc155 7ff35cc1f7
commit abf1db5b51
404 changed files with 8038 additions and 6132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.md
View File

@ -113,7 +113,7 @@ cores are useful.
### Software
The proofs in this repository use `Isabelle2016`. A copy of Isabelle
The proofs in this repository use `Isabelle2016-1`. A copy of Isabelle
is included in the repository setup.
The dependencies for installing Isabelle in this repository are
@ -208,7 +208,7 @@ These commands perform the following steps:
* build basic Isabelle images, including `HOL-Word` to ensure that
the installation works. This may take a few minutes.
Alternatively, it is possible to use the official Isabelle2016 release
Alternatively, it is possible to use the official Isabelle2016-1 release
bundle for your platform from the [Isabelle website][2]. In this case, the
installation steps above can be skipped, and you would replace the directory
`verification/isabelle/` with a symbolic link to the Isabelle home directory

2
camkes/adl-spec/Examples_CAMKES.thy
View File

@ -8,7 +8,7 @@
* @TAG(NICTA_GPL)
*)
header {* \label{sec:examples}Example Systems *}
chapter {* \label{sec:examples}Example Systems *}
(*<*)
theory Examples_CAMKES

2
camkes/adl-spec/Wellformed_CAMKES.thy
View File

@ -8,7 +8,7 @@
* @TAG(NICTA_GPL)
*)
header {* Wellformedness of Specifications *}
chapter {* Wellformedness of Specifications *}
(*<*)
theory Wellformed_CAMKES

4
camkes/cdl-refine/Generator_CAMKES_CDL.thy
View File

@ -179,8 +179,8 @@ lemma helper3: "(\<Sum>(a, b) \<leftarrow> xs. Suc (f a b)) = length xs + (\<Sum
by clarsimp+
lemma helper4: "fold op + ((map (\<lambda>(a, b). f a b) xs)::nat list) 0 = (\<Sum>(a, b) \<leftarrow> xs. f a b)"
apply (subst fold_plus_listsum_rev)
apply (subst listsum_rev)
apply (subst fold_plus_sum_list_rev)
apply (subst sum_list_rev)
by clarsimp
lemma set_of_enumerate:"card (set (enumerate n xs)) = length xs"

4
camkes/glue-proofs/DataIn.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* Shared Memory *}
chapter {* Shared Memory *}
(*<*)
theory DataIn imports
"../../tools/c-parser/CTranslation"
@ -23,6 +23,8 @@ install_C_file "DataIn.c"
autocorres [ts_rules = nondet] "DataIn.c"
locale DataIn_glue = DataIn
+ assumes swi_safe_to_ignore[simplified, simp]:
"asm_semantics_ok_to_ignore TYPE(nat) true (''swi '' @ x)"
begin
lemma DataIn__run_nf: "\<lbrace>\<lambda>s. \<forall>r. P r s\<rbrace> DataIn__run' \<lbrace>P\<rbrace>!"

4
camkes/glue-proofs/EventFrom.thy
View File

@ -8,7 +8,7 @@
* @TAG(NICTA_GPL)
*)
header {* Event Send *}
chapter {* Event Send *}
(*<*)
theory EventFrom imports
"../../tools/c-parser/CTranslation"
@ -24,6 +24,8 @@ install_C_file "EventFrom.c"
autocorres [ts_rules = nondet] "EventFrom.c"
locale EventFrom_glue = EventFrom
+ assumes swi_safe_to_ignore[simplified, simp]:
"asm_semantics_ok_to_ignore TYPE(nat) true (''swi '' @ x)"
begin
lemma EventFrom__run_nf: "\<lbrace>\<lambda>s. \<forall>r. P r s\<rbrace> EventFrom__run' \<lbrace>P\<rbrace>!"

4
camkes/glue-proofs/EventTo.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* Event Receive *}
chapter {* Event Receive *}
(*<*)
theory EventTo imports
"../../tools/c-parser/CTranslation"
@ -47,6 +47,8 @@ end
locale EventTo_glue = EventTo +
assumes seL4_SetMR_axiom: "exec_concrete lift_global_heap (seL4_SetMR' i val) = seL4_SetMR_lifted' i val"
assumes swi_safe_to_ignore[simplified, simp]:
"asm_semantics_ok_to_ignore TYPE(nat) true (''swi '' @ x)"
begin
definition

2
camkes/glue-proofs/RPCFrom.thy
View File

@ -49,6 +49,8 @@ end
locale RPCFrom_glue = RPCFrom +
assumes seL4_SetMR_axiom: "exec_concrete lift_global_heap (seL4_SetMR' i val) = seL4_SetMR_lifted' i val"
assumes swi_safe_to_ignore[simplified, simp]:
"asm_semantics_ok_to_ignore TYPE(nat) true (''swi '' @ x)"
begin
(*>*)

4
camkes/glue-proofs/RPCTo.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* RPC Receive *}
chapter {* RPC Receive *}
(*<*)
theory RPCTo imports
"../../tools/c-parser/CTranslation"
@ -76,6 +76,8 @@ locale RPCTo_glue = RPCTo +
\<lbrace>P19'\<rbrace>!"
assumes RPCTo_increment_64_wp: "\<lbrace>\<lambda>s21'. \<forall>r22'. P23'
r22' s21'\<rbrace> RPCTo_increment_64' x24' \<lbrace>P23'\<rbrace>!"
assumes swi_safe_to_ignore[simplified, simp]:
"asm_semantics_ok_to_ignore TYPE(nat) true (''swi '' @ x)"
begin
definition

2
camkes/glue-proofs/Syntax.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* Syntax *}
chapter {* Syntax *}
(*<*)
theory Syntax imports
"../../tools/c-parser/CTranslation"

2
camkes/glue-spec/Abbreviations.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:abbreviations}Convenience Definitions *}
chapter {* \label{h:abbreviations}Convenience Definitions *}
(*<*)
theory Abbreviations

4
camkes/glue-spec/CIMP.thy
View File

@ -7,10 +7,10 @@
*
* @TAG(NICTA_GPL)
*)
header {* Concurrent Imperative Syntax and Semantics \label{s:cimp} *}
chapter {* Concurrent Imperative Syntax and Semantics \label{s:cimp} *}
(*<*)
theory CIMP
imports Main
imports "../../lib/String_Compare"
begin
(*>*)
text {*

2
camkes/glue-spec/Connector.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:connector}Connector Components *}
chapter {* \label{h:connector}Connector Components *}
(*<*)
theory Connector

2
camkes/glue-spec/Types.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:types}Datatypes *}
chapter {* \label{h:types}Datatypes *}
(*<*)
theory Types

2
camkes/glue-spec/UserStubs.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:userstubs}Component Behaviour *}
chapter {* \label{h:userstubs}Component Behaviour *}
(*<*)
theory UserStubs

2
camkes/glue-spec/example-dataport/GenDataportBase.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:dataportbase}Example -- Dataports *}
chapter {* \label{h:dataportbase}Example -- Dataports *}
(*<*)
(* THIS FILE IS AUTOMATICALLY GENERATED. YOUR EDITS WILL BE OVERWRITTEN. *)
theory GenDataportBase

2
camkes/glue-spec/example-event/GenEventBase.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{s:eventbase}Example -- Events *}
chapter {* \label{s:eventbase}Example -- Events *}
(*<*)
(* THIS FILE IS AUTOMATICALLY GENERATED. YOUR EDITS WILL BE OVERWRITTEN. *)
theory GenEventBase

2
camkes/glue-spec/example-procedure/GenSimpleBase.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:procbase}Example -- Procedures *}
chapter {* \label{h:procbase}Example -- Procedures *}
(*<*)
(* THIS FILE IS AUTOMATICALLY GENERATED. YOUR EDITS WILL BE OVERWRITTEN. *)
theory GenSimpleBase

2
camkes/glue-spec/example-untrusted/GenFilterBase.thy
View File

@ -7,7 +7,7 @@
*
* @TAG(NICTA_GPL)
*)
header {* \label{h:filter}Example -- System Level Reasoning *}
chapter {* \label{h:filter}Example -- System Level Reasoning *}
(*<*)
(* THIS FILE IS AUTOMATICALLY GENERATED. YOUR EDITS WILL BE OVERWRITTEN. *)

2
camkes/tests.xml
View File

@ -21,5 +21,5 @@
<test name="CamkesAdlSpec">make CamkesAdlSpec</test>
<test name="CamkesCdlRefine" depends="CamkesAdlSpec DPolicy">make CamkesCdlRefine</test>
<test name="CamkesGlueSpec">make CamkesGlueSpec</test>
<test name="CamkesGlueProofs" depends="AutoCorres">make CamkesGlueProofs</test>
<test name="CamkesGlueProofs" depends="AutoCorres" cpu-timeout="7200">make CamkesGlueProofs</test>
</testsuite>

2
lib/AddUpdSimps.thy
View File

@ -78,7 +78,7 @@ fun add_upd_simps t exsimps ctxt = let
val add_upd_simps_syn = Outer_Syntax.local_theory @{command_keyword "add_upd_simps"}
"recursively show updates don't matter to constants"
(Parse.term -- Scan.optional
(Parse.$$$ "(" |-- Scan.repeat Parse.xthm --| Parse.$$$ ")") []
(Parse.$$$ "(" |-- Scan.repeat Parse.thm --| Parse.$$$ ")") []
>> (fn (t, simps) => fn ctxt => add_upd_simps (Syntax.read_term ctxt t)
(Attrib.eval_thms ctxt simps) ctxt))
*}

2
lib/Apply_Trace.thy
View File

@ -141,7 +141,7 @@ fun apply args f text = Proof.assert_backward #> refine args f text #>
Seq.maps_results (Proof.apply ((raw_primitive_text I),(Position.none, Position.none)));
fun apply_results args f (text, range) =
Seq.APPEND (apply args f text, method_error "" (Position.set_range range));
Seq.APPEND (apply args f text, method_error "" (Position.range_position range));
end

2
lib/AutoLevity_Base.thy
View File

@ -333,7 +333,7 @@ Toplevel.add_hook (fn transition => fn start_state => fn end_state =>
Synchronized.change transactions
(Symtab.map_default (thynm, (Postab_strict.empty, Postab_strict.empty))
(apfst (Postab_strict.update (pos, (name, entry)))))
in () end) handle e => if Exn.is_interrupt e then reraise e else
in () end) handle e => if Exn.is_interrupt e then Exn.reraise e else
Synchronized.change transactions
(Symtab.map_default (thynm, (Postab_strict.empty, Postab_strict.empty))
(apsnd (Postab_strict.map_default (pos, []) (cons (@{make_string} e)))))

2
lib/Distinct_Cmd.thy
View File

@ -45,7 +45,7 @@ fun process_binding lthy binding =
(* Parse the parameters to "distinct". *)
val distinct_parser =
(Scan.optional (Parse_Spec.opt_thm_name ":") Attrib.empty_binding
(Scan.optional (Parse_Spec.opt_thm_name ":") Binding.empty_atts
-- Scan.repeat1 Parse.term)
(* Generate a prop of the form "a ~= b". *)

8
lib/Distinct_Prop.thy
View File

@ -51,7 +51,7 @@ lemma distinct_prefix:
"\<lbrakk> distinct xs; ys \<le> xs \<rbrakk> \<Longrightarrow> distinct ys"
apply (induct xs arbitrary: ys; clarsimp)
apply (case_tac ys; clarsimp)
by (fastforce simp: less_eq_list_def dest: set_mono_prefixeq)
by (fastforce simp: less_eq_list_def dest: set_mono_prefix)
lemma distinct_sets_prop:
"distinct_sets xs = distinct_prop (\<lambda>x y. x \<inter> y = {}) xs"
@ -62,10 +62,10 @@ lemma distinct_take_strg:
by simp
lemma distinct_prop_prefixE:
"\<lbrakk> distinct_prop P ys; prefixeq xs ys \<rbrakk> \<Longrightarrow> distinct_prop P xs"
"\<lbrakk> distinct_prop P ys; prefix xs ys \<rbrakk> \<Longrightarrow> distinct_prop P xs"
apply (induct xs arbitrary: ys; clarsimp)
apply (case_tac ys; clarsimp)
by (fastforce dest: set_mono_prefixeq)
by (fastforce dest: set_mono_prefix)
lemma distinct_sets_union_sub:
@ -108,7 +108,7 @@ lemma distinct_sets_append_Cons_disjoint:
lemma distinct_prop_take:
"\<lbrakk>distinct_prop P xs; i < length xs\<rbrakk> \<Longrightarrow> distinct_prop P (take i xs)"
by (metis take_is_prefixeq distinct_prop_prefixE)
by (metis take_is_prefix distinct_prop_prefixE)
lemma distinct_sets_take:
"\<lbrakk>distinct_sets xs; i < length xs\<rbrakk> \<Longrightarrow> distinct_sets (take i xs)"

26
lib/Eisbach_Methods.thy
View File

@ -13,8 +13,8 @@
*)
theory Eisbach_Methods
imports "~~/src/HOL/Eisbach/Eisbach_Tools"
"subgoal_focus/Subgoal_Methods"
imports "subgoal_focus/Subgoal_Methods"
"~~/src/HOL/Eisbach/Eisbach_Tools"
begin
@ -28,7 +28,7 @@ method_setup print_raw_goal = \<open>Scan.succeed (fn ctxt => fn facts =>
ML \<open>fun method_evaluate text ctxt facts =
Method.NO_CONTEXT_TACTIC ctxt
(Method_Closure.method_evaluate text ctxt facts)\<close>
(Method.evaluate_runtime text ctxt facts)\<close>
method_setup print_headgoal =
@ -43,7 +43,7 @@ section \<open>Simple Combinators\<close>
method_setup defer_tac = \<open>Scan.succeed (fn _ => SIMPLE_METHOD (defer_tac 1))\<close>
method_setup all =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun tac i st' =
Goal.restrict i 1 st'
@ -54,7 +54,7 @@ method_setup all =
\<close>
method_setup determ =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun tac st' = method_evaluate m ctxt facts st'
@ -62,7 +62,7 @@ method_setup determ =
\<close>
method_setup changed =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun tac st' = method_evaluate m ctxt facts st'
@ -71,7 +71,7 @@ method_setup changed =
method_setup timeit =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun timed_tac st seq = Seq.make (fn () => Option.map (apsnd (timed_tac st))
(timeit (fn () => (Seq.pull seq))));
@ -84,12 +84,12 @@ method_setup timeit =
method_setup timeout =
\<open>Scan.lift Parse.int -- Method_Closure.method_text >> (fn (i,m) => fn ctxt => fn facts =>
\<open>Scan.lift Parse.int -- Method.text_closure >> (fn (i,m) => fn ctxt => fn facts =>
let
fun str_of_goal th = Pretty.string_of (Goal_Display.pretty_goal ctxt th);
fun limit st f x = TimeLimit.timeLimit (Time.fromSeconds i) f x
handle TimeLimit.TimeOut => error ("Method timed out:\n" ^ (str_of_goal st));
fun limit st f x = Timeout.apply (Time.fromSeconds i) f x
handle Timeout.TIMEOUT _ => error ("Method timed out:\n" ^ (str_of_goal st));
fun timed_tac st seq = Seq.make (limit st (fn () => Option.map (apsnd (timed_tac st))
(Seq.pull seq)));
@ -107,7 +107,7 @@ text \<open>The following @{text fails} and @{text succeeds} methods protect the
The @{text fails} method inverts success, only succeeding if the given method would fail.\<close>
method_setup fails =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun fail_tac st' =
(case Seq.pull (method_evaluate m ctxt facts st') of
@ -118,7 +118,7 @@ method_setup fails =
\<close>
method_setup succeeds =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun can_tac st' =
(case Seq.pull (method_evaluate m ctxt facts st') of
@ -250,7 +250,7 @@ subsection \<open>Finding a goal based on successful application of a method\<cl
context begin
method_setup find_goal =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun prefer_first i = SELECT_GOAL
(fn st' =>

4
lib/EquivValid.thy
View File

@ -329,7 +329,7 @@ lemma if_ev:
assumes "b \<Longrightarrow> equiv_valid I A B P f"
assumes "\<not> b \<Longrightarrow> equiv_valid I A B Q g"
shows "equiv_valid I A B (\<lambda>s. (b \<longrightarrow> P s) \<and> (\<not>b \<longrightarrow> Q s)) (if b then f else g)"
apply (clarsimp split: split_if)
apply (clarsimp split: if_split)
using assms by blast
lemmas if_ev_pre = equiv_valid_guard_imp[OF if_ev]
@ -984,7 +984,7 @@ lemma if_evrv:
assumes "b \<Longrightarrow> equiv_valid_rv_inv I A R P f"
assumes "\<not> b \<Longrightarrow> equiv_valid_rv_inv I A R Q g"
shows "equiv_valid_rv_inv I A R (\<lambda>s. (b \<longrightarrow> P s) \<and> (\<not>b \<longrightarrow> Q s)) (if b then f else g)"
apply (clarsimp split: split_if)
apply (clarsimp split: if_split)
using assms by blast
end

2
lib/Extend_Locale.thy
View File

@ -74,7 +74,7 @@ val _ =
val lthy'' = lthy'
|> Local_Theory.exit_global
|> Named_Target.init next_locale_name
|> Named_Target.init NONE next_locale_name
in lthy'' end)
)));

4
lib/ExtraCorres.thy
View File

@ -47,8 +47,8 @@ lemma corres_mapM_list_all2:
and rc: "\<And>x xs y ys. \<lbrakk> r xs ys; r' x y \<rbrakk> \<Longrightarrow> r (x # xs) (y # ys)"
and corr: "\<And>x xs y ys. \<lbrakk> S x y; list_all2 S xs ys \<rbrakk>
\<Longrightarrow> corres_underlying sr nf nf' r' (Q (x # xs)) (Q' (y # ys)) (f x) (f' y)"
and ha: "\<And>x xs y. \<lbrakk> S x y; suffixeq (x#xs) as \<rbrakk> \<Longrightarrow> \<lbrace>Q (x # xs)\<rbrace> f x \<lbrace>\<lambda>r. Q xs\<rbrace>"
and hc: "\<And>x y ys. \<lbrakk> S x y; suffixeq (y#ys) cs \<rbrakk> \<Longrightarrow> \<lbrace>Q' (y # ys) \<rbrace> f' y \<lbrace>\<lambda>r. Q' ys\<rbrace>"
and ha: "\<And>x xs y. \<lbrakk> S x y; suffix (x#xs) as \<rbrakk> \<Longrightarrow> \<lbrace>Q (x # xs)\<rbrace> f x \<lbrace>\<lambda>r. Q xs\<rbrace>"
and hc: "\<And>x y ys. \<lbrakk> S x y; suffix (y#ys) cs \<rbrakk> \<Longrightarrow> \<lbrace>Q' (y # ys) \<rbrace> f' y \<lbrace>\<lambda>r. Q' ys\<rbrace>"
and lall: "list_all2 S as cs"
shows "corres_underlying sr nf nf' r (Q as) (Q' cs) (mapM f as) (mapM f' cs)"
using lall

10
lib/HaskellLemmaBucket.thy
View File

@ -108,7 +108,7 @@ lemma break_subsetsD:
apply simp
apply (case_tac "break f xs")
apply (elim meta_allE, drule(1) meta_mp)
apply (fastforce simp: split_def split: split_if_asm)
apply (fastforce simp: split_def split: if_split_asm)
done
lemma distinct_prop_breakD:
@ -116,7 +116,7 @@ lemma distinct_prop_breakD:
\<Longrightarrow> \<forall>y \<in> set ys. \<forall>z \<in> set zs. P y z"
apply (induct xs arbitrary: ys zs)
apply simp
apply (simp add: split_def split: split_if_asm)
apply (simp add: split_def split: if_split_asm)
apply (case_tac "break f xs")
apply (elim meta_allE, drule(1) meta_mp)
apply (frule break_subsetsD)
@ -267,13 +267,13 @@ lemma snd_stateAssert_after:
"\<not> snd ((do _ \<leftarrow> f; stateAssert R vs od) s) \<Longrightarrow>
\<not>snd (f s) \<and> (\<forall>(rv, s') \<in> fst (f s). R s')"
apply (clarsimp simp: bind_def stateAssert_def get_def assert_def
return_def fail_def split_def split: split_if_asm)
return_def fail_def split_def split: if_split_asm)
done
lemma oblivious_stateAssert [simp]:
"oblivious f (stateAssert g xs) = (\<forall>s. g (f s) = g s)"
apply (simp add: oblivious_def stateAssert_def exec_get
assert_def return_def fail_def split: split_if)
assert_def return_def fail_def split: if_split)
apply auto
done
@ -295,7 +295,7 @@ lemma findM_is_mapME:
liftM_def cong: if_cong)
apply (simp add: liftE_bindE bind_assoc)
apply (rule bind_cong[OF refl])
apply (simp add: bindE_assoc split: split_if)
apply (simp add: bindE_assoc split: if_split)
apply (simp add: liftE_bindE bind_assoc throwError_bind)
done

2
lib/Insulin.thy
View File

@ -287,7 +287,7 @@ Outer_Syntax.command @{command_keyword "desugar_term"}
ML {*
Outer_Syntax.command @{command_keyword "desugar_thm"}
"thm str str2... -> desugar str in thm"
(Parse.xthm -- Scan.repeat1 Parse.string >> (fn (t, s) =>
(Parse.thm -- Scan.repeat1 Parse.string >> (fn (t, s) =>
Toplevel.keep (fn state => let val ctxt = Toplevel.context_of state in
Insulin.desugar_thm ctxt (Attrib.eval_thms ctxt [t] |> hd) s |> writeln end)))
*}

6
lib/LemmaBucket.thy
View File

@ -295,8 +295,8 @@ lemma sum_suc_pair: "(\<Sum>(a, b) \<leftarrow> xs. Suc (f a b)) = length xs + (
by clarsimp+
lemma fold_add_sum: "fold op + ((map (\<lambda>(a, b). f a b) xs)::nat list) 0 = (\<Sum>(a, b) \<leftarrow> xs. f a b)"
apply (subst fold_plus_listsum_rev)
apply (subst listsum_rev)
apply (subst fold_plus_sum_list_rev)
apply (subst sum_list_rev)
by clarsimp
lemma set_of_enumerate:"card (set (enumerate n xs)) = length xs"
@ -435,7 +435,7 @@ lemma dom_map_fold:"dom (fold op ++ (map (\<lambda>x. [f x \<mapsto> g x]) xs) m
by (induct xs arbitrary:f g ms; clarsimp)
lemma list_ran_prop:"map_of (map (\<lambda>x. (f x, g x)) xs) i = Some t \<Longrightarrow> \<exists>x \<in> set xs. g x = t"
by (induct xs arbitrary:f g t i; clarsimp split:split_if_asm)
by (induct xs arbitrary:f g t i; clarsimp split:if_split_asm)
lemma in_set_enumerate_eq2:"(a, b) \<in> set (enumerate n xs) \<Longrightarrow> (b = xs ! (a - n))"
by (simp add: in_set_enumerate_eq)

22
lib/LemmaBucket_C.thy
View File

@ -53,7 +53,7 @@ lemma exec_Guard:
"(G \<turnstile> \<langle>Guard Err S c, Normal s\<rangle> \<Rightarrow> s')
= (if s \<in> S then G \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> s'
else s' = Fault Err)"
by (auto split: split_if elim!: exec_elim_cases intro: exec.intros)
by (auto split: if_split elim!: exec_elim_cases intro: exec.intros)
lemma to_bytes_word8:
"to_bytes (v :: word8) xs = [v]"
@ -285,7 +285,7 @@ lemma intvl_nowrap:
apply (drule intvlD)
apply clarsimp
apply (simp add: unat_arith_simps)
apply (simp split: split_if_asm)
apply (simp split: if_split_asm)
apply (simp add: unat_of_nat)
done
@ -457,16 +457,16 @@ next
by (simp add: map_le_def list_map_def merge_dom2 set_zip)
hence "length xs < length n" and "x = n ! length xs"
by (auto simp add: list_map_eq split: split_if_asm)
by (auto simp add: list_map_eq split: if_split_asm)
thus "xs @ [x] \<le> n" using xsn
by (simp add: append_one_prefixeq less_eq_list_def)
by (simp add: append_one_prefix less_eq_list_def)
qed
lemma typ_slice_t_self:
"td \<in> fst ` set (typ_slice_t td m)"
apply (cases td)
apply (simp split: split_if)
apply (simp split: if_split)
done
lemma drop_heap_list_le2:
@ -874,7 +874,7 @@ lemma typ_slice_t_array:
typ_slice_t (export_uinfo (array_tag TYPE('a['b :: finite])))
(y + size_of TYPE('a :: mem_type) * n)"
apply (simp add: array_tag_def array_tag_n_eq
split del: split_if)
split del: if_split)
apply (rule disjI2)
apply (subgoal_tac "y + (size_of TYPE('a) * n) < CARD('b) * size_of TYPE('a)")
apply (simp add: typ_slice_list_cut[where m="size_of TYPE('a)"]
@ -1114,7 +1114,7 @@ lemma ptr_retyp_valid_footprint_disjoint2:
apply (subst (asm) ptr_retyp_d)
apply clarsimp
apply fast
apply (clarsimp simp add: ptr_retyp_d_eq_fst split: split_if_asm)
apply (clarsimp simp add: ptr_retyp_d_eq_fst split: if_split_asm)
apply fast
apply (erule intvlI)
done
@ -1141,7 +1141,7 @@ lemma h_t_valid_ptr_retyp_eq:
"\<not> cptr_type p <\<^sub>\<tau> cptr_type p' \<Longrightarrow> h_t_valid (ptr_retyp p td) g p'
= (if ptr_span p \<inter> ptr_span p' = {} then h_t_valid td g p'
else field_of_t p' p \<and> g p')"
apply (clarsimp simp: ptr_retyp_disjoint_iff split: split_if)
apply (clarsimp simp: ptr_retyp_disjoint_iff split: if_split)
apply (cases "g p'")
apply (rule iffI)
apply (rule ccontr, drule h_t_valid_neq_disjoint, rule ptr_retyp_h_t_valid, simp+)
@ -1157,10 +1157,10 @@ lemma field_lookup_list_Some_again:
\<Longrightarrow> i < length xs
\<Longrightarrow> f \<notin> dt_snd ` set ((take i xs))
\<Longrightarrow> field_lookup_list xs [f] n
= Some (dt_fst (xs ! i), n + listsum (map (size_td o dt_fst) (take i xs)))"
= Some (dt_fst (xs ! i), n + sum_list (map (size_td o dt_fst) (take i xs)))"
apply (induct xs arbitrary: i n, simp_all)
apply (case_tac x1, simp)
apply (case_tac i, auto split: split_if)
apply (case_tac i, auto split: if_split)
done
lemma field_lookup_array:
@ -1169,7 +1169,7 @@ lemma field_lookup_array:
(\<lambda>x. x.[n]) (\<lambda>x f. Arrays.update f n x), i + n * size_of TYPE ('a))"
apply (simp add: typ_info_array array_tag_def array_tag_n_eq)
apply (subst field_lookup_list_Some_again[where i=n],
auto simp add: take_map o_def listsum_triv size_of_def)
auto simp add: take_map o_def sum_list_triv size_of_def)
done
end

84
lib/Lib.thy
View File

@ -16,6 +16,7 @@ chapter "Library"
theory Lib
imports
String_Compare
NICTATools
"~~/src/HOL/Library/Prefix_Order"
begin
@ -66,6 +67,11 @@ lemma case_prod_apply_cong[fundef_cong]:
"\<lbrakk> f (fst p) (snd p) s = f' (fst p') (snd p') s' \<rbrakk> \<Longrightarrow> case_prod f p s = case_prod f' p' s'"
by (simp add: split_def)
lemma prod_injects:
"(x,y) = p \<Longrightarrow> x = fst p \<and> y = snd p"
"p = (x,y) \<Longrightarrow> x = fst p \<and> y = snd p"
by auto
definition
pred_conj :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)" (infixl "and" 35)
where
@ -636,7 +642,7 @@ lemma trancl_trancl:
lemma if_1_0_0:
"((if P then 1 else 0) = (0 :: ('a :: zero_neq_one))) = (\<not> P)"
by (simp split: split_if)
by (simp split: if_split)
lemma neq_Nil_lengthI:
"Suc 0 \<le> length xs \<Longrightarrow> xs \<noteq> []"
@ -686,11 +692,11 @@ definition
lemma graph_of_None_update:
"graph_of (f (p := None)) = graph_of f - {p} \<times> UNIV"
by (auto simp: graph_of_def split: split_if_asm)
by (auto simp: graph_of_def split: if_split_asm)
lemma graph_of_Some_update:
"graph_of (f (p \<mapsto> v)) = (graph_of f - {p} \<times> UNIV) \<union> {(p,v)}"
by (auto simp: graph_of_def split: split_if_asm)
by (auto simp: graph_of_def split: if_split_asm)
lemma graph_of_restrict_map:
"graph_of (m |` S) \<subseteq> graph_of m"
@ -813,7 +819,7 @@ lemma UN_nth_mem:
lemma Union_equal:
"f ` A = f ` B \<Longrightarrow> (\<Union>x \<in> A. f x) = (\<Union>x \<in> B. f x)"
by (subst Union_image_eq [symmetric]) simp
by blast
lemma UN_Diff_disjoint:
"i < length xs \<Longrightarrow> (A - (\<Union>x\<in>set xs. f x)) \<inter> f (xs ! i) = {}"
@ -847,7 +853,7 @@ lemma UN_sub_empty:
lemma bij_betw_fun_updI:
"\<lbrakk>x \<notin> A; y \<notin> B; bij_betw f A B\<rbrakk> \<Longrightarrow> bij_betw (f(x := y)) (insert x A) (insert y B)"
by (clarsimp simp: bij_betw_def fun_upd_image inj_on_fun_updI split: split_if_asm)
by (clarsimp simp: bij_betw_def fun_upd_image inj_on_fun_updI split: if_split_asm)
definition
"bij_betw_map f A B \<equiv> bij_betw f A (Some ` B)"
@ -1015,16 +1021,16 @@ lemma fold_to_map_of:
apply (case_tac "fold op ++ (map (\<lambda>x. [f x \<mapsto> g x]) xs) Map.empty x")
apply clarsimp
apply (drule fold_ignore3)
apply (clarsimp split:split_if_asm)
apply (clarsimp split:if_split_asm)
apply (rule sym)
apply (subst map_of_eq_None_iff)
apply clarsimp
apply (rename_tac xa)
apply (erule_tac x=xa in ballE; clarsimp)
apply clarsimp
apply (frule fold_ignore5; clarsimp split:split_if_asm)
apply (frule fold_ignore5; clarsimp split:if_split_asm)
apply (subst map_add_map_of_foldr[where m=empty, simplified])
apply (induct xs arbitrary:f g; clarsimp split:split_if)
apply (induct xs arbitrary:f g; clarsimp split:if_split)
apply (rule conjI; clarsimp)
apply (drule fold_ignore9; clarsimp)
apply (cut_tac ms="map (\<lambda>x. [f x \<mapsto> g x]) xs" and f="[f a \<mapsto> g a]" and x="f b" in fold_ignore6, clarsimp)
@ -1033,7 +1039,7 @@ lemma fold_to_map_of:
lemma if_n_0_0:
"((if P then n else 0) \<noteq> 0) = (P \<and> n \<noteq> 0)"
by (simp split: split_if)
by (simp split: if_split)
lemma insert_dom:
assumes fx: "f x = Some y"
@ -1297,7 +1303,7 @@ lemma insert_minus_eq:
lemma modify_map_K_D:
"modify_map m p (\<lambda>x. y) p' = Some v \<Longrightarrow> (m (p \<mapsto> y)) p' = Some v"
by (simp add: modify_map_def split: split_if_asm)
by (simp add: modify_map_def split: if_split_asm)
lemma tranclE2:
assumes trancl: "(a, b) \<in> r\<^sup>+"
@ -1391,7 +1397,7 @@ lemma foldl_fun_upd:
lemma all_rv_choice_fn_eq_pred:
"\<lbrakk> \<And>rv. P rv \<Longrightarrow> \<exists>fn. f rv = g fn \<rbrakk> \<Longrightarrow> \<exists>fn. \<forall>rv. P rv \<longrightarrow> f rv = g (fn rv)"
apply (rule_tac x="\<lambda>rv. SOME h. f rv = g h" in exI)
apply (clarsimp split: split_if)
apply (clarsimp split: if_split)
by (meson someI_ex)
lemma ex_const_function:
@ -1400,13 +1406,13 @@ lemma ex_const_function:
lemma if_Const_helper:
"If P (Con x) (Con y) = Con (If P x y)"
by (simp split: split_if)
by (simp split: if_split)
lemmas if_Some_helper = if_Const_helper[where Con=Some]
lemma expand_restrict_map_eq:
"(m |` S = m' |` S) = (\<forall>x. x \<in> S \<longrightarrow> m x = m' x)"
by (simp add: fun_eq_iff restrict_map_def split: split_if)
by (simp add: fun_eq_iff restrict_map_def split: if_split)
lemma disj_imp_rhs:
"(P \<Longrightarrow> Q) \<Longrightarrow> (P \<or> Q) = Q"
@ -1473,7 +1479,7 @@ lemma list_case_If:
lemma remove1_Nil_in_set:
"\<lbrakk> remove1 x xs = []; xs \<noteq> [] \<rbrakk> \<Longrightarrow> x \<in> set xs"
by (induct xs) (auto split: split_if_asm)
by (induct xs) (auto split: if_split_asm)
lemma remove1_empty:
"(remove1 v xs = []) = (xs = [v] \<or> xs = [])"
@ -1481,7 +1487,7 @@ lemma remove1_empty:
lemma set_remove1:
"x \<in> set (remove1 y xs) \<Longrightarrow> x \<in> set xs"
by (induct xs) (auto split: split_if_asm)
by (induct xs) (auto split: if_split_asm)
lemma If_rearrage:
"(if P then if Q then x else y else z) = (if P \<and> Q then x else if P then y else z)"
@ -1626,15 +1632,15 @@ lemma Min_prop:
lemma findSomeD:
"find P xs = Some x \<Longrightarrow> P x \<and> x \<in> set xs"
by (induct xs) (auto split: split_if_asm)
by (induct xs) (auto split: if_split_asm)
lemma findNoneD:
"find P xs = None \<Longrightarrow> \<forall>x \<in> set xs. \<not>P x"
by (induct xs) (auto split: split_if_asm)
by (induct xs) (auto split: if_split_asm)
lemma dom_upd:
"dom (\<lambda>x. if x = y then None else f x) = dom f - {y}"
by (rule set_eqI) (auto split: split_if_asm)
by (rule set_eqI) (auto split: if_split_asm)
definition
@ -1721,7 +1727,7 @@ lemma map_comp_eq:
lemma dom_If_Some:
"dom (\<lambda>x. if x \<in> S then Some v else f x) = (S \<union> dom f)"
by (auto split: split_if)
by (auto split: if_split)
lemma foldl_fun_upd_const:
"foldl (\<lambda>s x. s(f x := v)) s xs
@ -1767,7 +1773,7 @@ qed
lemma ran_del_subset:
"y \<in> ran (f (x := None)) \<Longrightarrow> y \<in> ran f"
by (auto simp: ran_def split: split_if_asm)
by (auto simp: ran_def split: if_split_asm)
lemma trancl_sub_lift:
assumes sub: "\<And>p p'. (p,p') \<in> r \<Longrightarrow> (p,p') \<in> r'"
@ -1819,7 +1825,7 @@ lemma psubset_singleton:
lemma length_takeWhile_ge:
"length (takeWhile f xs) = n \<Longrightarrow> length xs = n \<or> (length xs > n \<and> \<not> f (xs ! n))"
by (induct xs arbitrary: n) (auto split: split_if_asm)
by (induct xs arbitrary: n) (auto split: if_split_asm)
lemma length_takeWhile_le:
"\<not> f (xs ! n) \<Longrightarrow> length (takeWhile f xs) \<le> n"
@ -1828,7 +1834,7 @@ lemma length_takeWhile_le:
lemma length_takeWhile_gt:
"n < length (takeWhile f xs)
\<Longrightarrow> (\<exists>ys zs. length ys = Suc n \<and> xs = ys @ zs \<and> takeWhile f xs = ys @ takeWhile f zs)"
apply (induct xs arbitrary: n; simp split: split_if_asm)
apply (induct xs arbitrary: n; simp split: if_split_asm)
apply (case_tac n; simp)
apply (rule_tac x="[a]" in exI)
apply simp
@ -1910,7 +1916,7 @@ lemma Collect_int_vars:
lemma if_0_1_eq:
"((if P then 1 else 0) = (case Q of True \<Rightarrow> of_nat 1 | False \<Rightarrow> of_nat 0)) = (P = Q)"
by (simp split: split_if bool.split)
by (simp split: if_split bool.split)
lemma modify_map_exists_cte :
"(\<exists>cte. modify_map m p f p' = Some cte) = (\<exists>cte. m p' = Some cte)"
@ -1997,7 +2003,7 @@ lemma case_option_over_if:
= (if G then P else Q v)"
"case_option P Q (if G then Some v else None)
= (if G then Q v else P)"
by (simp split: split_if)+
by (simp split: if_split)+
lemma map_length_cong:
"\<lbrakk> length xs = length ys; \<And>x y. (x, y) \<in> set (zip xs ys) \<Longrightarrow> f x = g y \<rbrakk>
@ -2318,31 +2324,31 @@ lemma fst_last_zip_upt:
apply (simp add: min_def zip_is_empty)
done
lemma neq_into_nprefixeq:
lemma neq_into_nprefix:
"\<lbrakk> x \<noteq> take (length x) y \<rbrakk> \<Longrightarrow> \<not> x \<le> y"
by (clarsimp simp: prefixeq_def less_eq_list_def)
by (clarsimp simp: prefix_def less_eq_list_def)
lemma suffixeq_eqI:
"\<lbrakk> suffixeq xs as; suffixeq xs bs; length as = length bs;
lemma suffix_eqI:
"\<lbrakk> suffix xs as; suffix xs bs; length as = length bs;
take (length as - length xs) as \<le> take (length bs - length xs) bs\<rbrakk> \<Longrightarrow> as = bs"
by (clarsimp elim!: prefixE suffixeqE)
by (clarsimp elim!: prefixE suffixE)
lemma suffixeq_Cons_mem:
"suffixeq (x # xs) as \<Longrightarrow> x \<in> set as"
by (drule suffixeq_set_subset) simp
lemma suffix_Cons_mem:
"suffix (x # xs) as \<Longrightarrow> x \<in> set as"
by (drule suffix_set_subset) simp
lemma distinct_imply_not_in_tail:
"\<lbrakk> distinct list; suffixeq (y # ys) list\<rbrakk> \<Longrightarrow> y \<notin> set ys"
by (clarsimp simp:suffixeq_def)
"\<lbrakk> distinct list; suffix (y # ys) list\<rbrakk> \<Longrightarrow> y \<notin> set ys"
by (clarsimp simp:suffix_def)
lemma list_induct_suffixeq [case_names Nil Cons]:
lemma list_induct_suffix [case_names Nil Cons]:
assumes nilr: "P []"
and consr: "\<And>x xs. \<lbrakk>P xs; suffixeq (x # xs) as \<rbrakk> \<Longrightarrow> P (x # xs)"
and consr: "\<And>x xs. \<lbrakk>P xs; suffix (x # xs) as \<rbrakk> \<Longrightarrow> P (x # xs)"
shows "P as"
proof -
def as' == as
have "suffixeq as as'" unfolding as'_def by simp
have "suffix as as'" unfolding as'_def by simp
then show ?thesis
proof (induct as)
case Nil show ?case by fact
@ -2351,8 +2357,8 @@ proof -
show ?case
proof (rule consr)
from Cons.prems show "suffixeq (x # xs) as" unfolding as'_def .
then have "suffixeq xs as'" by (auto dest: suffixeq_ConsD simp: as'_def)
from Cons.prems show "suffix (x # xs) as" unfolding as'_def .
then have "suffix xs as'" by (auto dest: suffix_ConsD simp: as'_def)
then show "P xs" using Cons.hyps by simp
qed
qed

43
lib/ListLibLemmas.thy
View File

@ -218,7 +218,7 @@ text {* These list operations roughly correspond to cdt
lemma after_can_split: "after_in_list list x = Some y \<Longrightarrow> \<exists>ys xs. list = xs @ (x # y # ys)"
apply (induct list x rule: after_in_list.induct)
apply simp+
apply (simp split: split_if_asm)
apply (simp split: if_split_asm)
apply force
apply (elim exE)
apply simp
@ -243,7 +243,8 @@ lemma distinct_inj_middle: "distinct list \<Longrightarrow> list = (xa @ x # xb)
done
lemma after_can_split_distinct: "distinct list \<Longrightarrow> after_in_list list x = Some y \<Longrightarrow> \<exists>!ys xs. list = xs @ (x # y # ys)"
lemma after_can_split_distinct:
"distinct list \<Longrightarrow> after_in_list list x = Some y \<Longrightarrow> \<exists>!ys. \<exists>!xs. list = xs @ (x # y # ys)"
apply (frule after_can_split)
apply (elim exE)
apply (rule ex1I)
@ -301,9 +302,9 @@ lemma after_in_list_inj:
apply(simp)
apply(case_tac "a=aa")
apply(case_tac list, simp)
apply(simp add: hd_not_after_in_list split: split_if_asm)
apply(simp add: hd_not_after_in_list split: if_split_asm)
apply(case_tac list, simp)
apply(simp add: hd_not_after_in_list split: split_if_asm)
apply(simp add: hd_not_after_in_list split: if_split_asm)
done
lemma list_replace_ignore:"a \<notin> set list \<Longrightarrow> list_replace list a b = list"
@ -370,7 +371,7 @@ lemma list_insert_after_after:
\<Longrightarrow> after_in_list (list_insert_after list a b) p
= (if p = a then Some b else if p = b then after_in_list list a else after_in_list list p)"
apply(induct list p rule: after_in_list.induct)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
apply fastforce
done
@ -385,14 +386,14 @@ lemma remove_distinct_helper: "\<lbrakk>distinct (list_remove list x); a \<noteq
distinct list\<rbrakk>
\<Longrightarrow> a \<notin> set (list_remove list x)"
apply (induct list)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
done
lemma list_remove_distinct:
"distinct list \<Longrightarrow> distinct (list_remove list x)"
apply (induct list)
apply (simp add: remove_distinct_helper split: split_if_asm)+
apply (simp add: remove_distinct_helper split: if_split_asm)+
done
lemma list_remove_none: "x \<notin> set list \<Longrightarrow> list_remove list x = list"
@ -416,14 +417,14 @@ lemma set_list_replace_list:
lemma after_in_list_in_list:
"after_in_list list a = Some b \<Longrightarrow> b \<in> set list"
apply(induct list a arbitrary: b rule: after_in_list.induct)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
done
lemma list_replace_empty_after_empty:
"\<lbrakk>after_in_list list p = Some slot; distinct list\<rbrakk>
\<Longrightarrow> after_in_list (list_replace_list list slot []) p = after_in_list list slot"
apply(induct list slot rule: after_in_list.induct)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
apply (case_tac xs,simp+)
apply (case_tac xs,simp+)
apply (auto dest!: after_in_list_in_list)
@ -433,7 +434,7 @@ lemma list_replace_after_fst_list:
"\<lbrakk>after_in_list list p = Some slot; distinct list\<rbrakk>
\<Longrightarrow> after_in_list (list_replace_list list slot (x # xs)) p = Some x"
apply(induct list p rule: after_in_list.induct)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
apply (drule after_in_list_in_list)+
apply force
done
@ -451,13 +452,13 @@ lemma after_in_list_append_last_hd:
apply(induct list' p rule: after_in_list.induct)
apply(simp)
apply(simp)
apply(simp split: split_if_asm)
apply(simp split: if_split_asm)
done
lemma after_in_list_append_in_hd:
"after_in_list list p = Some a \<Longrightarrow> after_in_list (list @ list') p = Some a"
apply(induct list p rule: after_in_list.induct)
apply(simp split: split_if_asm)+
apply(simp split: if_split_asm)+
done
lemma after_in_list_in_list': "after_in_list list a = Some y \<Longrightarrow> a \<in> set list"
@ -479,13 +480,13 @@ lemma list_replace_after_None_notin_new:
apply(simp)
apply(simp)
apply(case_tac list', simp, simp)
apply(simp split: split_if_asm)
apply(simp split: if_split_asm)
apply(simp add: after_in_list_append_notin_hd)
apply(simp add: after_in_list_append_notin_hd)
apply(case_tac "list_replace_list list slot list'")
apply(simp)
apply(simp)
apply(case_tac list, simp, simp split: split_if_asm)
apply(case_tac list, simp, simp split: if_split_asm)
done
lemma list_replace_after_notin_new:
@ -497,7 +498,7 @@ lemma list_replace_after_notin_new:
apply(intro conjI impI)
apply(simp add: after_in_list_append_notin_hd)
apply(case_tac list, simp, simp)
apply(case_tac list, simp, simp split: split_if_asm)
apply(case_tac list, simp, simp split: if_split_asm)
apply(insert after_in_list_append_notin_hd)
apply(atomize)
apply(erule_tac x=p in allE, erule_tac x="[aa]" in allE, erule_tac x="list' @ lista" in allE)
@ -623,13 +624,13 @@ lemma distinct_after_in_list_antisym:
apply (induct list b arbitrary: a rule: after_in_list.induct)
apply simp+
apply (case_tac xs)
apply (clarsimp split: split_if_asm | intro impI conjI)+
apply (clarsimp split: if_split_asm | intro impI conjI)+
done
lemma after_in_listD: "after_in_list list x = Some y \<Longrightarrow> \<exists>xs ys. list = xs @ (x # y # ys) \<and> x \<notin> set xs"
apply (induct list x arbitrary: a rule: after_in_list.induct)
apply (simp split: split_if_asm | elim exE | force)+
apply (simp split: if_split_asm | elim exE | force)+
apply (rule_tac x="x # xsa" in exI)
apply simp
done
@ -730,7 +731,7 @@ lemma list_swap_preserve_separate:
"\<lbrakk>p \<noteq> desta; p \<noteq> srca; z \<noteq> desta; z \<noteq> srca; after_in_list list p = Some z\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) p = Some z"
apply (induct list p rule: after_in_list.induct)
apply (simp add: list_swap_def split: split_if_asm)+
apply (simp add: list_swap_def split: if_split_asm)+
apply (intro impI conjI)
apply simp+
done
@ -934,7 +935,7 @@ lemma prepend_after_in_list_distinct : "distinct (a # list) \<Longrightarrow> {(
(* base case *)
apply (drule CollectD, simp)
apply (case_tac list, simp)
apply (simp split:split_if_asm)
apply (simp split:if_split_asm)
apply (rule r_into_trancl)
apply (rule CollectI, simp)
(* Inductive case *)
@ -1083,11 +1084,11 @@ lemma after_in_list_last_None:
apply(simp)
apply(case_tac list)
apply(simp)
apply(fastforce split: split_if_asm)
apply(fastforce split: if_split_asm)
done
lemma after_in_list_None_last:
"\<lbrakk>after_in_list list x = None; x \<in> set list\<rbrakk> \<Longrightarrow> x = last list"
by (induct list x rule: after_in_list.induct,(simp split: split_if_asm)+)
by (induct list x rule: after_in_list.induct,(simp split: if_split_asm)+)
end

2
lib/Monad_WP/NonDetMonad.thy
View File

@ -357,7 +357,7 @@ lemma liftE_def2:
text {* Left @{const returnOk} absorbtion over @{term bindE}: *}
lemma returnOk_bindE [simp]: "(returnOk x >>=E f) = f x"
apply (unfold bindE_def return_def returnOk_def)
apply (unfold bindE_def returnOk_def)
apply (clarsimp simp: lift_def)
done

4
lib/Monad_WP/NonDetMonadVCG.thy
View File

@ -633,7 +633,7 @@ lemma in_bindE_L:
(\<exists>s'' x. (Inr x, s'') \<in> fst (f s) \<and> (Inl r, s') \<in> fst (g x s'')) \<or> ((Inl r, s') \<in> fst (f s))"
apply (simp add: bindE_def lift_def bind_def)
apply safe
apply (simp add: return_def throwError_def lift_def split_def split: sum.splits split_if_asm)
apply (simp add: return_def throwError_def lift_def split_def split: sum.splits if_split_asm)
apply force
done
@ -1742,7 +1742,7 @@ lemma list_cases_wp:
(* FIXME: make wp *)
lemma whenE_throwError_wp:
"\<lbrace>\<lambda>s. \<not>Q \<longrightarrow> P s\<rbrace> whenE Q (throwError e) \<lbrace>\<lambda>rv. P\<rbrace>, -"
apply (simp add: whenE_def split del: split_if)
apply (simp add: whenE_def split del: if_split)
apply (rule hoare_pre)
apply wp
apply simp

2
lib/Monad_WP/OptionMonad.thy
View File

@ -262,7 +262,7 @@ proof -
then have ?thesis using `I s`
by (induct arbitrary: s) (auto intro: istep) }
then show ?thesis using assms(1)
by (auto simp: option_while_def option_while'_THE split: split_if_asm)
by (auto simp: option_while_def option_while'_THE split: if_split_asm)
qed
lemma option_while'_term:

4
lib/Monad_WP/OptionMonadND.thy
View File

@ -176,12 +176,12 @@ proof -
have "\<And>s. owhile C B r s = None
\<Longrightarrow> whileLoop C (\<lambda>a. gets_the (B a)) r s = ({}, True)"
by (auto simp: whileLoop_def owhile_def option_while_def option_while'_THE gets_the_loop_terminates
split: split_if_asm dest: option_while'_None wl'_Inl option_while'_inj)
split: if_split_asm dest: option_while'_None wl'_Inl option_while'_inj)
moreover
have "\<And>s r'. owhile C B r s = Some r'
\<Longrightarrow> whileLoop C (\<lambda>a. gets_the (B a)) r s = ({(r', s)}, False)"
by (auto simp: whileLoop_def owhile_def option_while_def option_while'_THE gets_the_loop_terminates
split: split_if_asm dest: wl'_Inl wl'_Inr option_while'_inj intro: option_while'_Some)
split: if_split_asm dest: wl'_Inl wl'_Inr option_while'_inj intro: option_while'_Some)
ultimately
show ?thesis
by (auto simp: fun_eq_iff gets_the_conv split: option.split)

2
lib/Monad_WP/WhileLoopRules.thy
View File

@ -492,7 +492,7 @@ proof -
have cond_true: "\<And>x s. fst (whileLoop C B x s) = {} \<Longrightarrow> C x s"
apply (subst (asm) whileLoop_unroll)
apply (clarsimp simp: condition_def return_def split: split_if_asm)
apply (clarsimp simp: condition_def return_def split: if_split_asm)
done
have "snd (whileLoop C B r s)"

8
lib/Monad_WP/WhileLoopRulesCompleteness.thy
View File

@ -46,9 +46,9 @@ lemma valid_whileLoop_complete:
apply clarsimp
apply (subst (asm) (2) whileLoop_unroll)
apply (case_tac "C a b")
apply (clarsimp simp: valid_def bind_def' Bex_def condition_def split: split_if_asm)
apply (clarsimp simp: valid_def bind_def' Bex_def condition_def split: if_split_asm)
apply force
apply (clarsimp simp: valid_def bind_def' Bex_def condition_def split: split_if_asm)
apply (clarsimp simp: valid_def bind_def' Bex_def condition_def split: if_split_asm)
apply force
apply (subst whileLoop_unroll)
apply (clarsimp simp: valid_def bind_def' condition_def return_def)
@ -351,7 +351,7 @@ lemma valid_path_implies_exs_valid_whileLoop:
apply (clarsimp split: prod.splits)
apply (case_tac l)
apply clarsimp
apply (clarsimp split del: split_if)
apply (clarsimp split del: if_split)
apply (erule bexI [rotated])
apply clarsimp
apply clarsimp
@ -379,7 +379,7 @@ lemma shortest_path_gets_shorter:
apply (drule valid_path_implies_exs_valid_whileLoop)
apply (clarsimp simp: exs_valid_def)
apply (erule bexI [rotated])
apply (clarsimp split: split_if_asm)
apply (clarsimp split: if_split_asm)
apply clarsimp
done

6
lib/Monad_WP/wp/WPEx.thy
View File

@ -164,7 +164,7 @@ val put_Lib_simpset = put_simpset (Simplifier.simpset_of (Proof_Context.init_gl
fun in_mresults_ctxt ctxt = ctxt
|> put_Lib_simpset
|> (fn ctxt => ctxt addsimps [@{thm in_mresults_export}, @{thm in_mresults_bind}])
|> Splitter.del_split @{thm split_if}
|> Splitter.del_split @{thm if_split}
fun prove_qad ctxt term tac = Goal.prove ctxt [] [] term
(K (if Config.get ctxt quick_and_dirty andalso false
@ -179,7 +179,7 @@ fun preannotate_ss ctxt = ctxt
fun in_mresults_ss ctxt = ctxt
|> put_Lib_simpset
|> (fn ctxt => ctxt addsimps [@{thm in_mresults_export}, @{thm in_mresults_bind}])
|> Splitter.del_split @{thm split_if}
|> Splitter.del_split @{thm if_split}
|> simpset_of
@ -280,7 +280,7 @@ fun postcond_ss ctxt = ctxt
fun wp_default_ss ctxt = ctxt
|> put_simpset HOL_ss
|> Splitter.del_split @{thm split_if}
|> Splitter.del_split @{thm if_split}
|> simpset_of
fun raise_tac s = all_tac THEN (fn _ => error s);

8
lib/Monad_WP/wp/WPI.thy
View File

@ -44,7 +44,7 @@ begin
text \<open>The ML version of repeat_new is slightly faster than the Eisbach one.\<close>
method_setup repeat_new =
\<open>Method_Closure.method_text >> (fn m => fn ctxt => fn facts =>
\<open>Method.text_closure >> (fn m => fn ctxt => fn facts =>
let
fun tac i st' =
Goal.restrict i 1 st'
@ -321,7 +321,7 @@ method post_strengthen methods wp_weak wp_strong simp' tests =
determ \<open>make_goals \<open>wp_weak\<close> \<open>wp_strong\<close> \<open>tests\<close>,
(elim trips_pushEs)?,
rule trip_init\<close>,
(simp add: imp_conjL del: simp_dels split del: split_if)?,
(simp add: imp_conjL del: simp_dels split del: if_split)?,
determ \<open>(erule trips_True_drop trips_contr_drop hoare_add_trip)\<close>,
simp',
rule trip_drop,
@ -333,7 +333,7 @@ text \<open>The "wpi" named theorem is used to avoid the safety heuristics, effe
named_theorems wpi
private method final_simp =
(simp del: del: simp_dels split del: split_if cong: post_imp_cong)
(simp del: del: simp_dels split del: if_split cong: post_imp_cong)
text \<open>By default, wpi will only solve an atomic consequent if all its antecedents
aren't preserved. Therefore "test" is simply "fail". Unpreserved antecedents
@ -406,7 +406,7 @@ method wp_drop_imp_internal methods tests =
determ \<open>erule trips_transport\<close>,
((drule trip_term_quants)+)?,
erule strengthen_trip_term,
simp split del: split_if cong: post_conj_cong,
simp split del: if_split cong: post_conj_cong,
rule post_conj_drop)
method wp_drop_imp = wp_drop_imp_internal \<open>tests\<close>

4
lib/MonadicRewrite.thy
View File

@ -102,7 +102,7 @@ proof -
apply (clarsimp simp: monadic_rewrite_def bind_def P image_constant_conv
cong: image_cong)
apply (drule empty_failD2[OF ef])
apply (clarsimp simp: prod_eq_iff split: split_if_asm)
apply (clarsimp simp: prod_eq_iff split: if_split_asm)
done
qed
@ -173,7 +173,7 @@ lemma monadic_rewrite_gen_asm:
lemma monadic_rewrite_assert:
"\<lbrakk> Q \<Longrightarrow> monadic_rewrite True E P (f ()) g \<rbrakk>
\<Longrightarrow> monadic_rewrite True E (\<lambda>s. Q \<longrightarrow> P s) (assert Q >>= f) g"
apply (simp add: assert_def split: split_if)
apply (simp add: assert_def split: if_split)
apply (simp add: monadic_rewrite_def fail_def)
done

65
lib/NonDetMonadLemmaBucket.thy
View File

@ -269,9 +269,9 @@ lemma mapM_x_Cons:
lemma mapM_x_inv_wp2:
assumes post: "\<And>s. \<lbrakk> I s; V [] s \<rbrakk> \<Longrightarrow> Q s"
and hr: "\<And>a as. suffixeq (a # as) xs \<Longrightarrow> \<lbrace>\<lambda>s. I s \<and> V (a # as) s\<rbrace> m a \<lbrace>\<lambda>r s. I s \<and> V as s\<rbrace>"
and hr: "\<And>a as. suffix (a # as) xs \<Longrightarrow> \<lbrace>\<lambda>s. I s \<and> V (a # as) s\<rbrace> m a \<lbrace>\<lambda>r s. I s \<and> V as s\<rbrace>"
shows "\<lbrace>I and V xs\<rbrace> mapM_x m xs \<lbrace>\<lambda>rv. Q\<rbrace>"
proof (induct xs rule: list_induct_suffixeq)
proof (induct xs rule: list_induct_suffix)
case Nil thus ?case
apply (simp add: mapM_x_Nil)
apply wp
@ -576,7 +576,7 @@ lemma cutMon_walk_bindE:
apply (simp add: bindE_def cutMon_walk_bind)
apply (rule bind_cong, rule refl)
apply (simp add: cutMon_def lift_def fail_def
split: split_if_asm)
split: if_split_asm)
apply (clarsimp split: sum.split)
done
@ -596,11 +596,11 @@ lemma cutMon_validE_drop:
lemma assertE_assert:
"assertE F = liftE (assert F)"
by (clarsimp simp: assertE_def assert_def liftE_def returnOk_def
split: split_if)
split: if_split)
lemma snd_cutMon:
"snd (cutMon P f s) = (P s \<longrightarrow> snd (f s))"
by (simp add: cutMon_def fail_def split: split_if)
by (simp add: cutMon_def fail_def split: if_split)
lemma exec_modify:
"(modify f >>= g) s = g () (f s)"
@ -612,7 +612,7 @@ lemma no_fail_spec:
lemma no_fail_assertE [wp]:
"no_fail (\<lambda>_. P) (assertE P)"
by (simp add: assertE_def split: split_if)
by (simp add: assertE_def split: if_split)
lemma no_fail_spec_pre:
"\<lbrakk> no_fail ((op = s) and P') f; \<And>s. P s \<Longrightarrow> P' s \<rbrakk> \<Longrightarrow> no_fail ((op = s) and P) f"
@ -620,11 +620,11 @@ lemma no_fail_spec_pre:
lemma no_fail_whenE [wp]:
"\<lbrakk> G \<Longrightarrow> no_fail P f \<rbrakk> \<Longrightarrow> no_fail (\<lambda>s. G \<longrightarrow> P s) (whenE G f)"
by (simp add: whenE_def split: split_if)
by (simp add: whenE_def split: if_split)
lemma no_fail_unlessE [wp]:
"\<lbrakk> \<not> G \<Longrightarrow> no_fail P f \<rbrakk> \<Longrightarrow> no_fail (\<lambda>s. \<not> G \<longrightarrow> P s) (unlessE G f)"
by (simp add: unlessE_def split: split_if)
by (simp add: unlessE_def split: if_split)
lemma no_fail_throwError [wp]:
"no_fail \<top> (throwError e)"
@ -718,7 +718,7 @@ lemma select_f_asserts:
"select_f (assert P s) = do assert P; return ((), s) od"
"select_f (assert_opt v s) = do v' \<leftarrow> assert_opt v; return (v', s) od"
by (simp add: select_f_def fail_def assert_def return_def bind_def
assert_opt_def split: split_if option.split)+
assert_opt_def split: if_split option.split)+
lemma liftE_bindE_handle:
"((liftE f >>=E (\<lambda>x. g x)) <handle> h)
@ -766,24 +766,24 @@ lemma liftE_bindE_assoc:
lemma empty_fail_use_cutMon:
"\<lbrakk> \<And>s. empty_fail (cutMon (op = s) f) \<rbrakk> \<Longrightarrow> empty_fail f"
apply (clarsimp simp add: empty_fail_def cutMon_def)
apply (fastforce split: split_if_asm)
apply (fastforce split: if_split_asm)
done
lemma empty_fail_drop_cutMon:
"empty_fail f \<Longrightarrow> empty_fail (cutMon P f)"
by (simp add: empty_fail_def fail_def cutMon_def split: split_if)
by (simp add: empty_fail_def fail_def cutMon_def split: if_split)
lemma empty_fail_cutMon:
"\<lbrakk> \<And>s. P s \<Longrightarrow> empty_fail (cutMon (op = s) f) \<rbrakk>
\<Longrightarrow> empty_fail (cutMon P f)"
apply (clarsimp simp: empty_fail_def cutMon_def fail_def
split: split_if)
apply (fastforce split: split_if_asm)
split: if_split)
apply (fastforce split: if_split_asm)
done
lemma empty_fail_If:
"\<lbrakk> P \<Longrightarrow> empty_fail f; \<not> P \<Longrightarrow> empty_fail g \<rbrakk> \<Longrightarrow> empty_fail (if P then f else g)"
by (simp split: split_if)
by (simp split: if_split)
lemmas empty_fail_cutMon_intros =
cutMon_walk_bind[THEN arg_cong[where f=empty_fail], THEN iffD2,
@ -796,16 +796,16 @@ lemmas empty_fail_cutMon_intros =
lemma empty_fail_whenEs:
"empty_fail f \<Longrightarrow> empty_fail (whenE P f)"
"empty_fail f \<Longrightarrow> empty_fail (unlessE P f)"
by (auto simp add: whenE_def unlessE_def empty_fail_error_bits split: split_if)
by (auto simp add: whenE_def unlessE_def empty_fail_error_bits split: if_split)
lemma empty_fail_assertE:
"empty_fail (assertE P)"
by (simp add: assertE_def empty_fail_error_bits split: split_if)
by (simp add: assertE_def empty_fail_error_bits split: if_split)
lemma unlessE_throw_catch_If:
"catch (unlessE P (throwError e) >>=E f) g
= (if P then catch (f ()) g else g e)"
by (simp add: unlessE_def catch_throwError split: split_if)
by (simp add: unlessE_def catch_throwError split: if_split)
lemma gets_the_return:
"(return x = gets_the f) = (\<forall>s. f s = Some x)"
@ -834,7 +834,7 @@ lemma cutMon_assert_opt:
= gets_the (\<lambda>s. if P s then f s else None) >>= g"
by (simp add: cutMon_def gets_the_def exec_gets
bind_assoc fun_eq_iff assert_opt_def
split: split_if)
split: if_split)
lemma gets_the_eq_bind:
"\<lbrakk> \<exists>fn. f = gets_the (fn o fn');
@ -870,7 +870,7 @@ lemma gets_the_asserts:
"(assertE P = gets_the h) = (\<forall>s. h s = (if P then Some (Inr ()) else None))"
by (simp add: assert_def assertE_def
gets_the_fail gets_the_returns
split: split_if)+
split: if_split)+
lemma gets_the_condsE:
"(\<exists>fn. whenE P f = gets_the (fn o fn'))
@ -879,7 +879,7 @@ lemma gets_the_condsE:
= (\<not> P \<longrightarrow> (\<exists>fn. g = gets_the (fn o fn')))"
by (simp add: whenE_def unlessE_def gets_the_returns
ex_const_function
split: split_if)+
split: if_split)+
lemma no_fail_gets_the [wp]:
"no_fail (\<lambda>s. f s \<noteq> None) (gets_the f)"
@ -907,11 +907,11 @@ lemma assert_opt_If:
lemma if_to_top_of_bind:
"(bind (If P x y) z) = If P (bind x z) (bind y z)"
by (simp split: split_if)
by (simp split: if_split)
lemma if_to_top_of_bindE:
"(bindE (If P x y) z) = If P (bindE x z) (bindE y z)"
by (simp split: split_if)
by (simp split: if_split)
lemma alternative_bind:
"((a \<sqinter> b) >>= c) = ((a >>= c) \<sqinter> (b >>= c))"
@ -1076,22 +1076,21 @@ lemma bind_inv_inv_comm:
apply (rule ext)
apply (rename_tac s)
apply (rule_tac s="(do (x, y) \<leftarrow> do x \<leftarrow> f; y \<leftarrow> (\<lambda>_. g s) ; (\<lambda>_. return (x, y) s) od;
n x y od) s" in trans)
n x y od) s" in trans)
apply (simp add: bind_assoc)
apply (intro bind_apply_cong, simp_all)[1]
apply (metis in_inv_by_hoareD)
apply (simp add: return_def bind_def)
apply (metis in_inv_by_hoareD)
apply (rule_tac s="(do (x, y) \<leftarrow> do y \<leftarrow> g; x \<leftarrow> (\<lambda>_. f s) ; (\<lambda>_. return (x, y) s) od;
n x y od) s" in trans[rotated])
n x y od) s" in trans[rotated])
apply (simp add: bind_assoc)
apply (intro bind_apply_cong, simp_all)[1]
apply (metis in_inv_by_hoareD)
apply (simp add: return_def bind_def)
apply (metis in_inv_by_hoareD)
apply (rule bind_apply_cong, simp_all)
apply (clarsimp simp: bind_def split_def image_def return_def)
apply auto
apply (clarsimp simp: bind_def split_def return_def)
apply (auto elim!: nonemptyE | drule(1) empty_failD3)+
done
@ -2222,7 +2221,7 @@ lemma oblivious_returnOk [simp]:
lemma oblivious_assertE [simp]:
"oblivious f (assertE P)"
by (simp add: assertE_def split: split_if)
by (simp add: assertE_def split: if_split)
lemma oblivious_throwError [simp]:
@ -2247,11 +2246,11 @@ lemma oblivious_catch:
lemma oblivious_when [simp]:
"oblivious f (when P m) = (P \<longrightarrow> oblivious f m)"
by (simp add: when_def split: split_if)
by (simp add: when_def split: if_split)
lemma oblivious_whenE [simp]:
"oblivious f (whenE P g) = (P \<longrightarrow> oblivious f g)"
by (simp add: whenE_def split: split_if)
by (simp add: whenE_def split: if_split)
lemma select_f_oblivious [simp]:
"oblivious f (select_f v)"
@ -2319,7 +2318,7 @@ lemma zipWithM_x_Nil2 :
lemma assert2:
"(do v1 \<leftarrow> assert P; v2 \<leftarrow> assert Q; c od)
= (do v \<leftarrow> assert (P \<and> Q); c od)"
by (simp add: assert_def split: split_if)
by (simp add: assert_def split: if_split)
lemma assert_opt_def2:
"assert_opt v = (do assert (v \<noteq> None); return (the v) od)"
@ -2334,7 +2333,7 @@ lemma gets_assert:
"(do v1 \<leftarrow> assert v; v2 \<leftarrow> gets f; c v1 v2 od)
= (do v2 \<leftarrow> gets f; v1 \<leftarrow> assert v; c v1 v2 od)"
by (simp add: simpler_gets_def return_def assert_def fail_def bind_def
split: split_if)
split: if_split)
lemma list_case_return2:
"(case x of [] \<Rightarrow> return v | y # ys \<Rightarrow> return (f y ys))
@ -2345,7 +2344,7 @@ lemma modify_assert:
"(do v2 \<leftarrow> modify f; v1 \<leftarrow> assert v; c v1 od)
= (do v1 \<leftarrow> assert v; v2 \<leftarrow> modify f; c v1 od)"
by (simp add: simpler_modify_def return_def assert_def fail_def bind_def
split: split_if)
split: if_split)
lemma gets_fold_into_modify:
"do x \<leftarrow> gets f; modify (g x) od = modify (\<lambda>s. g (f s) s)"
@ -2504,7 +2503,7 @@ lemma case_option_find_give_me_a_map:
apply (induct xs)
apply simp
apply (simp add: liftM_def mapME_Nil)
apply (simp add: mapME_Cons split: split_if)
apply (simp add: mapME_Cons split: if_split)
apply (clarsimp simp add: throwError_def bindE_def bind_assoc
liftM_def)
apply (rule bind_cong [OF refl])

4
lib/Requalify.thy
View File

@ -64,7 +64,7 @@ val type_alias = syntax_alias Sign.type_alias Proof_Context.type_alias;
in
fun gen_requalify get_proper_nm parse_nm check_nm alias =
(Parse.opt_target -- Scan.repeat1 (Parse.position (Scan.ahead parse_nm -- Parse.xname))
(Parse.opt_target -- Scan.repeat1 (Parse.position (Scan.ahead parse_nm -- Parse.name))
>> (fn (target,bs) =>
Toplevel.local_theory NONE target (fn lthy =>
let
@ -102,7 +102,7 @@ val _ =
val _ =
Outer_Syntax.command @{command_keyword requalify_facts} "alias fact with current naming"
(gen_requalify get_fact_nm Parse.xthm check_fact fact_alias)
(gen_requalify get_fact_nm Parse.thm check_fact fact_alias)
val _ =
Outer_Syntax.command @{command_keyword global_naming} "change global naming of context block"

8
lib/Rule_By_Method.thy
View File

@ -110,7 +110,7 @@ fun with_rule_prems enabled parse =
fun get_rule_prems ctxt =
let
val (thms,b) = Data.get ctxt
in if (not b) then raise THM ("Rule premises not accessible here.",0,[]) else thms end
in if (not b) then [] else thms end
fun zip_subgoal assume tac (ctxt,st : thm) = if Thm.nprems_of st = 0 then Seq.single (ctxt,st) else
@ -208,17 +208,17 @@ fun position (scan : 'a context_parser) : (('a * Position.T) context_parser) = (
let
val (((context',x),tr_toks),toks') = Scan.trace (Scan.pass context (Scan.state -- scan)) toks;
val pos = Token.range_of tr_toks;
in ((x,Position.set_range pos),(context',toks')) end)
in ((x,Position.range_position pos),(context',toks')) end)
val parse_flags = Args.mode "schematic" -- Args.mode "raw_prop" >> (fn (b,b') => {vars = b, prop = b'})
(*TODO: Method_Closure.parse_method should do this already *)
val parse_method = Method_Closure.method_text o apfst (Config.put_generic Method.old_section_parser true)
val parse_method = Method.text_closure o apfst (Config.put_generic Method.old_section_parser true)
fun tac m ctxt =
Method.NO_CONTEXT_TACTIC ctxt
(Method_Closure.method_evaluate m ctxt []);
(Method.evaluate_runtime m ctxt []);
val (rule_prems_by_method : attribute context_parser) = Scan.lift parse_flags :-- (fn flags =>
position (Scan.repeat1

2
lib/ShowTypes.thy
View File

@ -93,7 +93,7 @@ Outer_Syntax.command @{command_keyword term_show_types}
Outer_Syntax.command @{command_keyword thm_show_types}
"thm_show_types THM1 THM2 ... -> show theorems with type annotations"
(Parse.xthms1 >> (fn ts =>
(Parse.thms1 >> (fn ts =>
Toplevel.keep (fn state =>
let val ctxt = Toplevel.context_of state in
Attrib.eval_thms ctxt ts

1
lib/SimpStrategy.thy
View File

@ -96,7 +96,6 @@ let
val ctxt = Proof_Context.init_global thy;
val ss = Simplifier.make_simproc ctxt ("simp_strategy_" ^ fst (dest_Const name))
{lhss = [@{term simp_strategy} $ name $ @{term x}],
identifier = [],
proc = (fn _ => fn ctxt' => fn ct =>
ct
|> (Conv.arg_conv (Simplifier.rewrite (put_simpset ss ctxt'))

4
lib/SimplRewrite.thy
View File

@ -10,9 +10,9 @@
theory SimplRewrite
imports
"~~/src/HOL/Eisbach/Eisbach"
"CTranslationNICTA"
"SplitRule"
"~~/src/HOL/Eisbach/Eisbach"
begin
primrec
@ -32,7 +32,7 @@ where
lemma add_statefn_id1:
"add_statefn id x = x"
by (induct x, simp_all add: inv_id[unfolded id_def])
by (induct x, simp_all add: inv_id[simplified id_def])
lemma add_statefn_id[simp]:
"add_statefn id = id"

142
lib/String_Compare.thy Normal file
View File

@ -0,0 +1,142 @@
(*
*
* Copyright 2016, Data61, CSIRO
*
* This software may be distributed and modified according to the terms of
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
* See "LICENSE_BSD2.txt" for details.
*
* @TAG(DATA61_BSD)
*)
theory String_Compare
imports Main
begin
(* Speed up string comparisons in Isabelle2016-1.
We replace simp rule Char_eq_Char_iff with one which normalises in fewer steps. *)
(* Beware that this might reappear during theory merges. *)
declare Char_eq_Char_iff [simp del]
lemma pos_divmod_nat_rel_mult_2:
assumes "0 \<le> b"
assumes "divmod_nat_rel a b (q, r)"
shows "divmod_nat_rel (1 + 2*a) (2*b) (q, 1 + 2*r)"
using assms unfolding divmod_nat_rel_def by auto
lemma pos_nat_mod_mult_2:
fixes a b :: nat
assumes "0 \<le> a"
shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)"
using pos_divmod_nat_rel_mult_2 [OF assms divmod_nat_rel]
by (rule mod_nat_unique)
lemma pos_nat_mod_mult_2_r:
fixes a b :: nat
assumes "0 \<le> a"
shows "(2 * b + 1) mod (2 * a) = 2 * (b mod a) + 1"
using pos_nat_mod_mult_2 by simp
lemma num_double: "num.Bit0 num.One * n = num.Bit0 n"
by (metis (no_types, lifting) mult_2 numeral_Bit0 numeral_eq_iff
numeral_times_numeral)
lemma num_Bit0_mod_pow2_Suc:
"numeral (num.Bit0 n) mod (2::nat) ^ Suc i = 2 * (numeral n mod 2 ^ i)"
by (metis mod_mult_mult1 mult_2 numeral_Bit0 power_Suc)
lemma num_Bit1_mod_pow2_Suc:
"numeral (num.Bit1 n) mod (2::nat) ^ Suc i = 2 * (numeral n mod 2 ^ i) + 1"
unfolding power_Suc numeral_Bit1 mult_2[symmetric]
by (rule pos_nat_mod_mult_2_r) simp
datatype peano = Peano_Z | Peano_S peano
primrec
peano_of_nat :: "nat \<Rightarrow> peano"
where
"peano_of_nat 0 = Peano_Z"
| "peano_of_nat (Suc n) = Peano_S (peano_of_nat n)"
fun
truncate_num :: "peano \<Rightarrow> num \<Rightarrow> num option"
where
"truncate_num Peano_Z n = None"
| "truncate_num (Peano_S p) num.One = Some num.One"
| "truncate_num (Peano_S p) (num.Bit0 n') = map_option num.Bit0 (truncate_num p n')"
| "truncate_num (Peano_S p) (num.Bit1 n') = Some (case_option num.One num.Bit1 (truncate_num p n'))"
lemma truncate_num:
"(numeral n :: nat) mod 2 ^ d = case_option 0 numeral (truncate_num (peano_of_nat d) n)"
proof (induct d arbitrary: n)
case 0 show ?case by (cases n) auto
next
case (Suc d) show ?case
proof (cases n)
case One thus ?thesis
apply simp
apply (rule mod_less)
using less_2_cases not_less_eq by fastforce
next
case (Bit0 m) thus ?thesis
unfolding Bit0 Suc num_Bit0_mod_pow2_Suc
by (clarsimp simp: num_double split: option.splits)
next
case (Bit1 m) show ?thesis
unfolding Bit1 Suc num_Bit1_mod_pow2_Suc
by (clarsimp simp: num_double split: option.splits)
qed
qed
fun
truncate_num_all_zero :: "peano \<Rightarrow> num \<Rightarrow> bool"
where
"truncate_num_all_zero Peano_Z n = True"
| "truncate_num_all_zero (Peano_S d) (num.Bit0 n) = truncate_num_all_zero d n"
| "truncate_num_all_zero (Peano_S d) _ = False"
lemma truncate_num_all_zero: "truncate_num_all_zero d n \<longleftrightarrow> truncate_num d n = None"
by (induct n arbitrary: d; case_tac d; simp)
fun
truncate_num_compare :: "peano \<Rightarrow> num \<Rightarrow> num \<Rightarrow> bool"
where
"truncate_num_compare Peano_Z m n = True"
| "truncate_num_compare (Peano_S d) num.One num.One = True"
| "truncate_num_compare (Peano_S d) num.One (num.Bit1 n) = truncate_num_all_zero d n"
| "truncate_num_compare (Peano_S d) (num.Bit1 m) num.One = truncate_num_all_zero d m"
| "truncate_num_compare (Peano_S d) (num.Bit0 m) (num.Bit0 n) = truncate_num_compare d m n"
| "truncate_num_compare (Peano_S d) (num.Bit1 m) (num.Bit1 n) = truncate_num_compare d m n"
| "truncate_num_compare (Peano_S d) num.One (num.Bit0 _) = False"
| "truncate_num_compare (Peano_S d) (num.Bit0 _) num.One = False"
| "truncate_num_compare (Peano_S d) (num.Bit0 _) (num.Bit1 _) = False"
| "truncate_num_compare (Peano_S d) (num.Bit1 _) (num.Bit0 _) = False"
lemma truncate_num_compare:
"truncate_num_compare d m n \<longleftrightarrow> truncate_num d m = truncate_num d n"
proof -
have inj_Bit0: "inj num.Bit0" by (auto intro: injI)
show ?thesis
by (induction d m n rule: truncate_num_compare.induct;
clarsimp simp: truncate_num_all_zero map_option_case
inj_eq[OF option.inj_map, OF inj_Bit0]
split: option.splits)
qed
abbreviation
"peano_8 \<equiv> Peano_S (Peano_S (Peano_S (Peano_S (Peano_S (Peano_S (Peano_S (Peano_S Peano_Z)))))))"
lemma numeral_mod_256:
"(numeral n :: nat) mod 256 = case_option 0 numeral (truncate_num peano_8 n)"
proof -
have "peano_of_nat 8 \<equiv> peano_8" by (simp add: eval_nat_numeral)
thus ?thesis using truncate_num[where d=8] by simp
qed
lemma Char_eq_iff_truncate_num_compare [simp]:
"Char k = Char l \<longleftrightarrow> truncate_num_compare peano_8 k l"
unfolding Char_eq_Char_iff numeral_mod_256 truncate_num_compare
by (simp split: option.splits)
end

2
lib/SubMonadLib.thy
View File

@ -114,7 +114,7 @@ lemma select_f_stateAssert:
apply (rule ext)
apply (clarsimp simp: stateAssert_def bind_def select_f_def get_def
assert_def return_def fail_def split_def image_image)
apply (simp only: SUP_def image_def)
apply (simp only: image_def)
apply (clarsimp simp: stateAssert_def bind_def select_f_def get_def
assert_def return_def fail_def split_def image_image)
apply (simp only: image_def mem_simps empty_fail_def simp_thms)

4
lib/WPTutorial.thy
View File

@ -76,7 +76,7 @@ An additional annoyance to the clarsimp/tuple issue described above is
the splitter. The wp tool is designed to work on a hoare triple with a
schematic precondition. Note how the simplifier splits the problem
in two because it contains an if constant. Delete the split
rule from the simpset with (simp split del: split_if) to avoid this
rule from the simpset with (simp split del: if_split) to avoid this
issue and see where wp gets stuck.
We still need to deal with the if constant. In this (somewhat contrived)
@ -95,7 +95,7 @@ lemma example_3:
return $ y \<and> \<not> x
od \<lbrace>\<lambda>rv s. rv\<rbrace>"
apply wp
apply (simp add: if_apply_def2 split del: split_if)
apply (simp add: if_apply_def2 split del: if_split)
apply wp
apply simp
done

2
lib/Word_Lib/Aligned.thy
View File

@ -296,7 +296,7 @@ proof cases
have "(2::nat) ^ m dvd unat (k << m)"
proof
have kv: "(unat k div 2 ^ q) * 2 ^ q + unat k mod 2 ^ q = unat k"
by (rule mod_div_equality)
by (rule div_mult_mod_eq)
have "unat (k << m) = unat (2 ^ m * k)" by (simp add: shiftl_t2n)
also have "\<dots> = (2 ^ m * unat k) mod (2 ^ len_of TYPE('a))" using mv

6
lib/Word_Lib/HOL_Lemmas.thy
View File

@ -42,11 +42,11 @@ lemma strict_part_mono_reverseE:
lemma takeWhile_take_has_property:
"n \<le> length (takeWhile P xs) \<Longrightarrow> \<forall>x \<in> set (take n xs). P x"
by (induct xs arbitrary: n; simp split: split_if_asm) (case_tac n, simp_all)
by (induct xs arbitrary: n; simp split: if_split_asm) (case_tac n, simp_all)
lemma takeWhile_take_has_property_nth:
"\<lbrakk> n < length (takeWhile P xs) \<rbrakk> \<Longrightarrow> P (xs ! n)"
by (induct xs arbitrary: n; simp split: split_if_asm) (case_tac n, simp_all)
by (induct xs arbitrary: n; simp split: if_split_asm) (case_tac n, simp_all)
lemma takeWhile_replicate:
"takeWhile f (replicate len x) = (if f x then replicate len x else [])"
@ -78,7 +78,7 @@ next
have "a ^ n * (a ^ m div a ^ n) = a ^ m"
proof (subst mult.commute)
have "a ^ m = (a ^ m div a ^ n) * a ^ n + a ^ m mod a ^ n"
by (rule mod_div_equality [symmetric])
by (rule div_mult_mod_eq [symmetric])
moreover have "a ^ m mod a ^ n = 0"
by (subst mod_eq_0_iff, rule exI [where x = "a ^ q"],

2
lib/Word_Lib/More_Divides.thy
View File

@ -23,7 +23,7 @@ lemma div_mult_le:
lemma diff_mod_le:
"\<lbrakk> (a::nat) < d; b dvd d \<rbrakk> \<Longrightarrow> a - a mod b \<le> d - b"
apply(subst mult_div_cancel [symmetric])
apply(subst minus_mod_eq_mult_div)
apply(clarsimp simp: dvd_def)
apply(case_tac "b = 0")
apply simp

99
lib/Word_Lib/Word_Lemmas.thy
View File

@ -11,7 +11,8 @@
section "Lemmas with Generic Word Length"
theory Word_Lemmas
imports
imports
Complex_Main
Aligned
Word_Enum
begin
@ -150,7 +151,7 @@ lemma no_plus_overflow_neg:
"(x :: 'a :: len word) < -y \<Longrightarrow> x \<le> x + y"
apply (simp add: no_plus_overflow_uint_size word_less_alt uint_word_ariths word_size)
apply (subst(asm) zmod_zminus1_eq_if)
apply (simp split: split_if_asm)
apply (simp split: if_split_asm)
done
lemma ucast_ucast_eq:
@ -593,7 +594,7 @@ qed
lemma upto_enum_len_less:
"\<lbrakk> n \<le> length [a, b .e. c]; n \<noteq> 0 \<rbrakk> \<Longrightarrow> a \<le> c"
unfolding upto_enum_step_def
by (simp split: split_if_asm)
by (simp split: if_split_asm)
lemma length_upto_enum_step:
fixes x :: "'a :: len word"
@ -1077,7 +1078,6 @@ lemma unat_less_power:
shows "unat k < 2 ^ sz"
using szv unat_mono [OF kv] by simp
(* This should replace some crud \<dots> search for unat_of_nat *)
lemma unat_mult_power_lem:
assumes kv: "k < 2 ^ (len_of TYPE('a::len) - sz)"
shows "unat (2 ^ sz * of_nat k :: (('a::len) word)) = 2 ^ sz * k"
@ -1478,7 +1478,7 @@ lemma power_le_mono:
lemma sublist_equal_part:
"xs \<le> ys \<Longrightarrow> take (length xs) ys = xs"
by (clarsimp simp: prefixeq_def less_eq_list_def)
by (clarsimp simp: prefix_def less_eq_list_def)
lemma two_power_eq:
"\<lbrakk>n < len_of TYPE('a); m < len_of TYPE('a)\<rbrakk>
@ -1488,20 +1488,15 @@ lemma two_power_eq:
apply (simp add: power_le_mono[where 'a='a])+
done
lemma less_list_def': "(xs < ys) = (prefix xs ys)"
apply (metis prefix_order.eq_iff prefix_def less_list_def less_eq_list_def)
done
lemma prefix_length_less:
"xs < ys \<Longrightarrow> length xs < length ys"
apply (clarsimp simp: less_list_def' prefix_def)
apply (frule prefixeq_length_le)
apply (clarsimp simp: less_list_def' strict_prefix_def less_eq_list_def[symmetric])
apply (frule prefix_length_le)
apply (rule ccontr, simp)
apply (clarsimp simp: prefixeq_def)
apply (clarsimp simp: less_eq_list_def prefix_def)
done
lemmas strict_prefix_simps [simp, code] = prefix_simps [folded less_list_def']
lemmas take_strict_prefix = take_prefix [folded less_list_def']
lemmas take_less = take_strict_prefix [folded less_list_def']
lemma not_prefix_longer:
"\<lbrakk> length xs > length ys \<rbrakk> \<Longrightarrow> \<not> xs \<le> ys"
@ -1592,7 +1587,7 @@ lemma of_nat_inj:
lemma map_prefixI:
"xs \<le> ys \<Longrightarrow> map f xs \<le> map f ys"
by (clarsimp simp: less_eq_list_def prefixeq_def)
by (clarsimp simp: less_eq_list_def prefix_def)
lemma if_Some_None_eq_None:
"((if P then Some v else None) = None) = (\<not> P)"
@ -1637,14 +1632,14 @@ lemma list_all2_induct_suffixeq [consumes 1, case_names Nil Cons]:
assumes lall: "list_all2 Q as bs"
and nilr: "P [] []"
and consr: "\<And>x xs y ys.
\<lbrakk>list_all2 Q xs ys; Q x y; P xs ys; suffixeq (x # xs) as; suffixeq (y # ys) bs\<rbrakk>
\<lbrakk>list_all2 Q xs ys; Q x y; P xs ys; suffix (x # xs) as; suffix (y # ys) bs\<rbrakk>
\<Longrightarrow> P (x # xs) (y # ys)"
shows "P as bs"
proof -
def as' == as
def bs' == bs
define as' where "as' == as"
define bs' where "bs' == bs"
have "suffixeq as as' \<and> suffixeq bs bs'" unfolding as'_def bs'_def by simp
have "suffix as as' \<and> suffix bs bs'" unfolding as'_def bs'_def by simp
then show ?thesis using lall
proof (induct rule: list_induct2 [OF list_all2_lengthD [OF lall]])
case 1 show ?case by fact
@ -1654,9 +1649,9 @@ proof -
show ?case
proof (rule consr)
from "2.prems" show "list_all2 Q xs ys" and "Q x y" by simp_all
then show "P xs ys" using "2.hyps" "2.prems" by (auto dest: suffixeq_ConsD)
from "2.prems" show "suffixeq (x # xs) as" and "suffixeq (y # ys) bs"
by (auto simp: as'_def bs'_def)
then show "P xs ys" using "2.hyps" "2.prems" by (auto dest: suffix_ConsD)
from "2.prems" show "suffix (x # xs) as" and "suffix (y # ys) bs"
by (auto simp: as'_def bs'_def)
qed
qed
qed
@ -1838,7 +1833,7 @@ lemma nth_bounded:
simplified add_0_left, rotated])
apply assumption+
apply (simp only: to_bl_0)
apply (simp add: nth_append split: split_if_asm)
apply (simp add: nth_append split: if_split_asm)
done
lemma is_aligned_add_or:
@ -1906,7 +1901,7 @@ qed
lemma take_is_prefix:
"take n xs \<le> xs"
apply (simp add: less_eq_list_def prefixeq_def)
apply (simp add: less_eq_list_def prefix_def)
apply (rule_tac x="drop n xs" in exI)
apply simp
done
@ -2136,7 +2131,7 @@ lemma word_and_1_shiftl:
fixes x :: "'a :: len word" shows
"x && (1 << n) = (if x !! n then (1 << n) else 0)"
apply (rule word_eqI)
apply (simp add: word_size nth_shiftl split: split_if del: shiftl_1)
apply (simp add: word_size nth_shiftl del: shiftl_1)
apply auto
done
@ -2301,7 +2296,7 @@ proof -
have "unat a div 2 ^ n * 2 ^ n \<noteq> unat a"
proof -
have "unat a = unat a div 2 ^ n * 2 ^ n + unat a mod 2 ^ n"
by (simp add: mod_div_equality)
by (simp add: div_mult_mod_eq)
also have "\<dots> \<noteq> unat a div 2 ^ n * 2 ^ n" using sz anz
by (simp add: unat_arith_simps)
finally show ?thesis ..
@ -2481,7 +2476,7 @@ lemma int_div_sub_1:
apply (subgoal_tac "m = 0 \<or> (n - (1 :: int)) div m = (if m dvd n then (n div m) - 1 else n div m)")
apply fastforce
apply (subst mult_cancel_right[symmetric])
apply (simp only: left_diff_distrib split: split_if)
apply (simp only: left_diff_distrib split: if_split)
apply (simp only: mod_div_equality_div_eq)
apply (clarsimp simp: field_simps)
apply (clarsimp simp: dvd_eq_mod_eq_0)
@ -2682,7 +2677,7 @@ lemma bang_conj_lt:
lemma dom_if:
"dom (\<lambda>a. if a \<in> addrs then Some (f a) else g a) = addrs \<union> dom g"
by (auto simp: dom_def split: split_if)
by (auto simp: dom_def split: if_split)
lemma less_is_non_zero_p1:
fixes a :: "'a :: len word"
@ -3085,10 +3080,7 @@ lemma signed_arith_eq_checks_to_ord:
= ((0 <=s a - b) = (b <=s a))"
"(- sint a = sint (- a)) = (0 <=s (- a) = (a <=s 0))"
using sint_range'[where x=a] sint_range'[where x=b]
apply (simp_all add: sint_word_ariths
word_sle_def word_sless_alt sbintrunc_If)
apply arith+
done
by (simp_all add: sint_word_ariths word_sle_def word_sless_alt sbintrunc_If)
(* Basic proofs that signed word div/mod operations are
* truncations of their integer counterparts. *)
@ -3191,11 +3183,11 @@ lemma sgn_div_eq_sgn_mult:
lemma sgn_sdiv_eq_sgn_mult:
"a sdiv b \<noteq> 0 \<Longrightarrow> sgn ((a :: int) sdiv b) = sgn (a * b)"
apply (clarsimp simp: sdiv_int_def sgn_times)
apply (clarsimp simp: sdiv_int_def sgn_mult)
apply (subst sgn_div_eq_sgn_mult)
apply simp
apply (clarsimp simp: sgn_times)
apply (metis abs_mult div_0 div_mult_self2_is_id sgn_0_0 sgn_1_pos sgn_times zero_less_abs_iff)
apply (clarsimp simp: sgn_mult)
apply (metis abs_mult div_0 nonzero_mult_div_cancel_right sgn_0_0 sgn_1_pos sgn_mult zero_less_abs_iff)
done
lemma int_sdiv_same_is_1 [simp]:
@ -3211,10 +3203,10 @@ lemma int_sdiv_same_is_1 [simp]:
apply (case_tac "b = 0")
apply (clarsimp simp: sign_simps)
apply (rule classical)
apply (clarsimp simp: sign_simps sgn_times not_less)
apply (clarsimp simp: sign_simps sgn_mult not_less)
apply (metis le_less neg_0_less_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
apply (rule classical)
apply (clarsimp simp: sign_simps sgn_times not_less sgn_if split: if_splits)
apply (clarsimp simp: sign_simps sgn_mult not_less sgn_if split: if_splits)
apply (metis antisym less_le neg_imp_zdiv_nonneg_iff)
apply (clarsimp simp: sdiv_int_def sgn_if)
done
@ -3231,11 +3223,11 @@ lemma int_sdiv_negated_is_minus1 [simp]:
apply (clarsimp simp: sign_simps not_less)
apply (rule classical)
apply (case_tac "b = 0")
apply (clarsimp simp: sign_simps not_less sgn_times)
apply (clarsimp simp: sign_simps not_less sgn_mult)
apply (case_tac "a > 0")
apply (clarsimp simp: sign_simps not_less sgn_times)
apply (clarsimp simp: sign_simps not_less sgn_mult)
apply (metis less_le neg_less_0_iff_less not_less_iff_gr_or_eq pos_imp_zdiv_neg_iff)
apply (clarsimp simp: sign_simps not_less sgn_times)
apply (clarsimp simp: sign_simps not_less sgn_mult)
apply (metis Divides.transfer_nat_int_function_closures(1) eq_iff minus_zero neg_le_iff_le)
apply (clarsimp simp: sgn_if)
done
@ -3286,7 +3278,7 @@ lemma sdiv_word_min:
apply (cut_tac sint_range' [where x=b])
apply clarsimp
apply (insert sdiv_int_range [where a="sint a" and b="sint b"])
apply (clarsimp simp: max_def abs_if split: split_if_asm)
apply (clarsimp simp: max_def abs_if split: if_split_asm)
done
lemma sdiv_word_max:
@ -3321,7 +3313,7 @@ proof (rule classical)
apply (clarsimp simp: word_size)
apply (insert sdiv_int_range [where a="sint a" and b="sint b"])[1]
apply (insert word_sint.Rep [where x="a"])[1]
apply (clarsimp simp: minus_le_iff word_size abs_if sints_num split: split_if_asm)
apply (clarsimp simp: minus_le_iff word_size abs_if sints_num split: if_split_asm)
apply (metis minus_minus sint_int_min word_sint.Rep_inject)
done
@ -3355,7 +3347,7 @@ lemmas word_sdiv_numerals = word_sdiv_numerals_lhs[where b="numeral y" for y]
lemma smod_int_alt_def:
"(a::int) smod b = sgn (a) * (abs a mod abs b)"
apply (clarsimp simp: smod_int_def sdiv_int_def)
apply (clarsimp simp: zmod_zdiv_equality' abs_sgn sgn_times sgn_if sign_simps)
apply (clarsimp simp: minus_div_mult_eq_mod [symmetric] abs_sgn sgn_mult sgn_if sign_simps)
done
lemma smod_int_range:
@ -3411,7 +3403,7 @@ lemma smod_word_max:
apply (clarsimp)
apply (insert word_sint.Rep [where x="b", simplified sints_num])[1]
apply (insert smod_int_range [where a="sint a" and b="sint b"])
apply (clarsimp simp: abs_if split: split_if_asm)
apply (clarsimp simp: abs_if split: if_split_asm)
done
lemma smod_word_min:
@ -3421,7 +3413,7 @@ lemma smod_word_min:
apply clarsimp
apply (insert word_sint.Rep [where x=b, simplified sints_num])[1]
apply (insert smod_int_range [where a="sint a" and b="sint b"])
apply (clarsimp simp: abs_if add1_zle_eq split: split_if_asm)
apply (clarsimp simp: abs_if add1_zle_eq split: if_split_asm)
done
lemma smod_word_alt_def:
@ -3642,7 +3634,7 @@ lemma nat_mult_power_less_eq:
mult_less_cancel2[where m="a * b ^ (n - m)" and k="b ^ m" and n=1]
apply (simp only: power_add[symmetric] nat_minus_add_max)
apply (simp only: power_add[symmetric] nat_minus_add_max ac_simps)
apply (simp add: max_def split: split_if_asm)
apply (simp add: max_def split: if_split_asm)
done
lemma signed_shift_guard_to_word:
@ -3820,7 +3812,7 @@ lemma to_bool_0 [simp]: "\<not>to_bool 0" by (simp add: to_bool_def)
lemma from_bool_eq_if:
"(from_bool Q = (if P then 1 else 0)) = (P = Q)"
by (simp add: case_bool_If from_bool_def split: split_if)
by (simp add: case_bool_If from_bool_def split: if_split)
lemma to_bool_eq_0:
"(\<not> to_bool x) = (x = 0)"
@ -4127,13 +4119,8 @@ lemma uint_2_id:
done
lemma bintrunc_id:
"\<lbrakk>of_nat n \<ge> m; m > 0\<rbrakk> \<Longrightarrow> bintrunc n m = m"
apply (subst bintrunc_mod2p)
apply (rule int_mod_eq')
apply simp+
apply (induct n arbitrary:m)
apply simp+
by force
"\<lbrakk>m \<le> of_nat n; 0 < m\<rbrakk> \<Longrightarrow> bintrunc n m = m"
by (simp add: bintrunc_mod2p le_less_trans int_mod_eq')
lemma shiftr1_unfold: "shiftr1 x = x >> 1"
by (metis One_nat_def comp_apply funpow.simps(1) funpow.simps(2) id_apply shiftr_def)
@ -4141,7 +4128,7 @@ lemma shiftr1_unfold: "shiftr1 x = x >> 1"
lemma shiftr1_is_div_2: "(x::('a::len) word) >> 1 = x div 2"
apply (case_tac "len_of TYPE('a) = 1")
apply simp
apply (subgoal_tac "x = 0 \<or> x = 1")
apply (subgoal_tac "x = 0 \<or> x = 1")
apply (erule disjE)
apply (clarsimp simp:word_div_def)+
apply (metis One_nat_def less_irrefl_nat sint_1_cases)
@ -4446,7 +4433,7 @@ lemma card_enum_upto:
lemma unat_mask:
"unat (mask n :: 'a :: len word) = 2 ^ (min n (len_of TYPE('a))) - 1"
apply (subst min.commute)
apply (simp add: mask_def not_less min_def split: split_if_asm)
apply (simp add: mask_def not_less min_def split: if_split_asm)
apply (intro conjI impI)
apply (simp add: unat_sub_if_size)
apply (simp add: power_overflow word_size)

2
lib/Word_Lib/Word_Lemmas_64.thy
View File

@ -268,7 +268,7 @@ lemma mask_step_down_64:
done
lemma unat_of_int_64:
"\<lbrakk>i \<ge> 0; i \<le>2 ^ 31\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword64)) = nat i"
"\<lbrakk>i \<ge> 0; i \<le> 2 ^ 63\<rbrakk> \<Longrightarrow> (unat ((of_int i)::sword64)) = nat i"
unfolding unat_def
apply (subst eq_nat_nat_iff, clarsimp+)
apply (simp add: word_of_int uint_word_of_int int_mod_eq')

16
lib/clib/CCorresLemmas.thy
View File

@ -20,7 +20,7 @@ lemma ccorres_rel_imp2:
apply (rule ccorresI', erule(5) ccorresE)
apply simp
apply (erule rev_bexI)
apply (simp add: unif_rrel_def split: split_if_asm)
apply (simp add: unif_rrel_def split: if_split_asm)
apply (cases "hs = []", simp_all)
done
@ -66,9 +66,9 @@ lemma exec_handlers_Hoare_Post:
"\<lbrakk> exec_handlers_Hoare \<Gamma> P c Q' A'; Q' \<subseteq> Q; A' \<subseteq> A \<rbrakk>
\<Longrightarrow> exec_handlers_Hoare \<Gamma> P c Q A"
apply (simp add: exec_handlers_Hoare_def
split del: split_if)
split del: if_split)
apply (elim allEI)
apply (simp split: split_if_asm)
apply (simp split: if_split_asm)
apply blast+
done
@ -96,7 +96,7 @@ lemma exec_handlers_Hoare_from_vcg_might_fail:
"\<lbrakk> \<Gamma> \<turnstile>\<^bsub>/F\<^esub> P c Q, A; UNIV \<subseteq> A' \<rbrakk>
\<Longrightarrow> exec_handlers_Hoare \<Gamma> P (c # hs) Q A'"
apply (clarsimp simp: exec_handlers_Hoare_def
split del: split_if split: split_if_asm)
split del: if_split split: if_split_asm)
apply (erule exec_handlers.cases, simp_all)
apply (case_tac hsa, simp_all)
apply (erule exec_handlers.cases, simp_all)
@ -303,13 +303,13 @@ lemma exec_handlers_Hoare_call_Basic:
"\<lbrakk> \<forall>s' t x. s' \<in> P \<longrightarrow> g s' t (ret s' t) \<in> Q; UNIV \<subseteq> A \<rbrakk> \<Longrightarrow>
exec_handlers_Hoare \<Gamma> P (call initfn p ret (\<lambda>x y. Basic (g x y)) # hs) Q A"
apply (clarsimp simp: exec_handlers_Hoare_def
split del: split_if)
split del: if_split)
apply (erule exec_handlers.cases)
apply clarsimp
apply (erule exec_call_Normal_elim, simp_all)[1]
apply (auto elim!: exec_Normal_elim_cases)[1]
apply (frule exec_handlers_less2, clarsimp+)
apply (clarsimp simp: subset_iff split: split_if_asm)
apply (clarsimp simp: subset_iff split: if_split_asm)
apply (auto elim!: exec_Normal_elim_cases
exec_call_Normal_elim)
done
@ -560,12 +560,12 @@ lemma ccorres_if_lhs:
\<Longrightarrow> ccorres_underlying sr Gamm r xf arrel axf (\<lambda>s. (P \<longrightarrow> Q s) \<and> (\<not> P \<longrightarrow> R s))
{s. (P \<longrightarrow> s \<in> S) \<and> (\<not> P \<longrightarrow> s \<in> T)}
hs (if P then f else g) conc"
by (simp split: split_if)
by (simp split: if_split)
lemma ccorres_if_bind:
"ccorres_underlying sr Gamm r xf arrel axf G G' hs (if a then (b >>= f) else (c >>= f)) d
\<Longrightarrow> ccorres_underlying sr Gamm r xf arrel axf G G' hs ((if a then b else c) >>= f) d"
by (simp split: split_if_asm)
by (simp split: if_split_asm)
lemma ccorres_Cond_rhs:
"\<lbrakk> P \<Longrightarrow> ccorres_underlying sr Gamm rvr xf arrel axf Q S hs absf f;

111
lib/clib/CCorres_Rewrite.thy
View File

@ -17,7 +17,12 @@ imports
"Corres_UL_C"
begin
(* C_simp rules may be applied repeatedly.
The result of a C_simp_final simplification will not be simplified further.
For example, use C_simp_final when the RHS matches the LHS. *)
named_theorems C_simp
named_theorems C_simp_final
context
(* for less typing and local com_eq syntax *)
@ -106,7 +111,7 @@ lemmas ccorres_rewrite_splits =
(* Actual simplification rules *)
lemma com_eq_Skip_Seq [C_simp]:
"c \<sim> c' \<Longrightarrow> Skip;;c \<sim> c'"
"Skip;;c \<sim> c"
apply (clarsimp simp: com_eq_def)
apply (rule iffI)
apply (fastforce elim!: exec_elim_cases)
@ -115,7 +120,7 @@ lemma com_eq_Skip_Seq [C_simp]:
done
lemma com_eq_Seq_Skip [C_simp]:
"c \<sim> c' \<Longrightarrow> c;;Skip \<sim> c'"
"c;;Skip \<sim> c"
apply (clarsimp simp: com_eq_def)
apply (rule iffI)
apply (fastforce elim!: exec_elim_cases)
@ -126,12 +131,12 @@ lemma com_eq_Seq_Skip [C_simp]:
done
lemma com_eq_Cond_empty [C_simp]:
"c \<sim> c' \<Longrightarrow> Cond {} c1 c \<sim> c'"
"Cond {} c1 c \<sim> c"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec.CondFalse elim!: exec_elim_cases)
lemma com_eq_Cond_UNIV [C_simp]:
"c \<sim> c' \<Longrightarrow> Cond UNIV c c2 \<sim> c'"
"Cond UNIV c c2 \<sim> c"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec.CondTrue elim!: exec_elim_cases)
@ -141,16 +146,16 @@ lemma exec_Cond_cases:
by (cases "s \<in> b") (auto intro: exec.CondTrue exec.CondFalse)
lemma com_eq_Cond_both [C_simp]:
"c \<sim> c' \<Longrightarrow> Cond b c c \<sim> c'"
"Cond b c c \<sim> c"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec_Cond_cases elim!: exec_elim_cases)
lemma com_eq_If_False [C_simp]:
"c \<sim> c' \<Longrightarrow> IF False THEN c1 ELSE c FI \<sim> c'"
"IF False THEN c1 ELSE c FI \<sim> c"
by (simp add: com_eq_Cond_empty)
lemma com_eq_If_True [C_simp]:
"c \<sim> c' \<Longrightarrow> IF True THEN c ELSE c2 FI \<sim> c'"
"IF True THEN c ELSE c2 FI \<sim> c"
by (simp add: com_eq_Cond_UNIV)
lemma com_eq_While_empty [C_simp]:
@ -163,20 +168,20 @@ lemma com_eq_While_FALSE [C_simp]:
by (simp add: com_eq_While_empty whileAnno_def)
lemma com_eq_Guard_UNIV [C_simp]:
"c \<sim> c' \<Longrightarrow> Guard f UNIV c \<sim> c'"
"Guard f UNIV c \<sim> c"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec.Guard elim!: exec_elim_cases)
lemma com_eq_Guard_True [C_simp]:
"c \<sim> c' \<Longrightarrow> Guard f \<lbrace>True\<rbrace> c \<sim> c'"
"Guard f \<lbrace>True\<rbrace> c \<sim> c"
by (clarsimp simp: com_eq_Guard_UNIV)
lemma com_eq_Guard_empty [C_simp]:
lemma com_eq_Guard_empty [C_simp_final]:
"Guard f {} c \<sim> Guard f {} Skip"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec.GuardFault elim!: exec_elim_cases)
lemma com_eq_Guard_False [C_simp]:
lemma com_eq_Guard_False [C_simp_final]:
"Guard f \<lbrace>False\<rbrace> c \<sim> Guard f {} Skip"
by (clarsimp simp: com_eq_Guard_empty)
@ -186,7 +191,7 @@ lemma com_eq_Catch_Skip [C_simp]:
by (auto intro: exec.CatchMiss exec.Skip elim!: exec_elim_cases)
lemma com_eq_Catch_Throw [C_simp]:
"c \<sim> c' \<Longrightarrow> Catch Throw c \<sim> c'"
"Catch Throw c \<sim> c"
unfolding com_eq_def
by (clarsimp, case_tac s, auto intro: exec.CatchMatch exec.Throw elim!: exec_elim_cases)
@ -198,21 +203,26 @@ lemma com_eq_Throw [C_simp]:
end
(* First introduces com_eq goal, then tries repeat application of, in this order:
- actual rewrite rules,
- propagation rules,
- com_eq_refl if nothing else works.
(* First introduces com_eq goal (rule cccorres_com_eqI), then breaks the term into
its component parts (ccorres_rewrite_decompose), and finally reassembles,
applying simplification rules whenever possible, and otherwise applying reflexivity.
Needs top-level repetition because a terminal step that introduces e.g. Skip does not
necessarily participate in further rewrites.
At every decomposition or simplification step, we first apply a transitivity rule,
to ensure we can continue simplifying each subterm until no more simplifications
are possible, before applying reflexivity to reassemble the enclosing term.
Limited to unconditional rewrite rules. Purpose is not to provide a real rewriting engine,
just to get rid of annoying Skip and Cond {} bits that come from config options or macros.
*)
method ccorres_rewrite declares C_simp =
(changed \<open>rule ccorres_com_eqI,
determ \<open>repeat_new \<open>determ \<open>rule C_simp ccorres_rewrite_splits com_eq_refl\<close>\<close>\<close>\<close>)+
method ccorres_rewrite_decompose =
(rule com_eq_trans, (rule ccorres_rewrite_splits; ccorres_rewrite_decompose)?)
method ccorres_rewrite_recombine declares C_simp C_simp_final =
determ \<open>rule C_simp_final C_simp[THEN com_eq_trans] com_eq_refl\<close>
method ccorres_rewrite declares C_simp C_simp_final =
changed \<open>rule ccorres_com_eqI, ccorres_rewrite_decompose, ccorres_rewrite_recombine+\<close>
(* Example *)
lemma
@ -223,16 +233,65 @@ lemma
Skip;;
(IF False THEN Skip ELSE SKIP;; TRY THROW CATCH c3 END FI;; SKIP))"
apply ccorres_rewrite (* c;; c;; c2;; c3 *)
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H (c;;c;;c2;;c3)" \<Rightarrow> \<open>-\<close>)
apply (ccorres_rewrite C_simp: c3) (* c;; c;; c2;; c *)
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H (c;;c;;c2;;c)" \<Rightarrow> \<open>-\<close>)
apply (ccorres_rewrite C_simp: c) (* c;; c2;; c *)
apply ccorres_rewrite? (* fails if nothing changes *)
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H (c;;c2;;c)" \<Rightarrow> \<open>-\<close>)
apply (fails \<open>ccorres_rewrite\<close>) (* fails if nothing changes *)
oops
(* Test for WHILE (whileAnno) case *)
lemma
shows "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(WHILE b DO Guard f g c;; IF False THEN c2 FI OD;; SKIP)"
lemma "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(WHILE b DO Guard f g c;; IF False THEN c2 FI OD;; SKIP)"
apply ccorres_rewrite
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(WHILE b DO Guard f g c OD)" \<Rightarrow> \<open>-\<close>)
oops
end
(* Test that simplification works down all branches of the term. *)
lemma "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(IF b THEN
(SKIP ;; c) ;; (SKIP ;; IF True THEN SKIP ELSE c FI)
ELSE
(SKIP ;; SKIP) ;; (Guard f UNIV c ;; SKIP)
FI)"
apply ccorres_rewrite
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H c" \<Rightarrow> \<open>-\<close>)
oops
(* Test that complex simplification rules work. *)
context begin
private lemma com_eq_Cond_redundant:
"com_eq \<Gamma> (IF b THEN c1 ELSE IF b THEN c2 ELSE c3 FI FI) (IF b THEN c1 ELSE c3 FI)"
unfolding com_eq_def
by (auto intro: exec.CondTrue exec.CondFalse elim!: exec_elim_cases)
private lemma "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(SKIP ;;
IF b THEN
(SKIP ;; c1) ;; (SKIP ;; SKIP)
ELSE
IF b THEN
IF b1 THEN c2 ELSE c2 FI
ELSE
WHILE False DO c4 OD ;; (c3 ;; SKIP)
FI
FI)"
apply (ccorres_rewrite C_simp: com_eq_Cond_redundant)
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(IF b THEN c1 ELSE c3 FI)" \<Rightarrow> \<open>-\<close>)
oops
end
(* Test C_simp_final avoids looping. *)
lemma "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(SKIP ;; Guard f {} (IF b THEN c ELSE c FI) ;; SKIP)"
apply ccorres_rewrite
apply (match conclusion in "ccorres_underlying sr \<Gamma> r xf r' xf' P P' hs H
(Guard f {} SKIP)" \<Rightarrow> \<open>-\<close>)
oops
end

6
lib/clib/CToCRefine.thy
View File

@ -33,7 +33,6 @@ fun mk_meta_eq_safe t = mk_meta_eq t
val unfold_bodies = Simplifier.make_simproc @{context} "unfold constants named *_body"
{lhss = [@{term "v"}],
identifier = [],
proc= fn _ =>
(fn ctxt => (fn t => case head_of (Thm.term_of t) of
Const (s, _) => if String.isSuffix "_body" s
@ -43,14 +42,14 @@ val unfold_bodies = Simplifier.make_simproc @{context} "unfold constants named *
*}
theorem spec_refine:
notes split_if[split del]
notes if_split[split del]
shows
"spec_statefn_simulates id (kernel_all_global_addresses.\<Gamma> symbol_table)
(kernel_all_substitute.\<Gamma> symbol_table domain)"
apply (simp add: kernel_all_global_addresses.\<Gamma>_def kernel_all_substitute.\<Gamma>_def)
apply (intro spec_statefn_simulates_lookup_tree_Node spec_statefn_simulates_lookup_tree_Leaf)
apply (tactic {* ALLGOALS (asm_simp_tac (put_simpset HOL_ss @{context} addsimps @{thms switch.simps fst_conv snd_conv}
addsimprocs [unfold_bodies] |> Splitter.del_split @{thm split_if}))
addsimprocs [unfold_bodies] |> Splitter.del_split @{thm if_split}))
THEN ALLGOALS (TRY o resolve_tac @{context} @{thms exec_statefn_simulates_refl}) *})
apply (tactic {* ALLGOALS (REPEAT_ALL_NEW (resolve_tac @{context} @{thms exec_statefn_simulates_comI
@ -65,6 +64,7 @@ theorem spec_refine:
THEN_ALL_NEW simp_tac @{simpset}
THEN_ALL_NEW K no_tac)) *})
*)
apply (rule bij_id[simplified id_def])+
done (* Woo! *)
end

2
lib/clib/Corres_C.thy
View File

@ -718,7 +718,7 @@ lemma ccorres_trim_return:
apply -
apply (rule ccorres_rhs_assoc2)+
apply (rule ccorres_trim_redundant_throw)
apply (clarsimp split del: split_if)
apply (clarsimp split del: if_split)
apply (rule iffD2 [OF ccorres_semantic_equiv, OF _ cc])
apply (rule semantic_equivI)
apply (case_tac s')

12
lib/clib/Corres_UL_C.thy
View File

@ -420,8 +420,8 @@ lemma exec_handlers_Hoare_from_vcg_nofail:
"\<Gamma> \<turnstile>\<^bsub>/F\<^esub> P c Q \<Longrightarrow> exec_handlers_Hoare \<Gamma> P (c # cs) Q A"
apply (drule hoare_sound)
apply (simp add: cvalid_def HoarePartialDef.valid_def
exec_handlers_Hoare_def split del: split_if)
apply (clarsimp split del: split_if)
exec_handlers_Hoare_def split del: if_split)
apply (clarsimp split del: if_split)
apply (erule exec_handlers.cases, auto)
done
@ -429,8 +429,8 @@ lemma exec_handlers_Hoare_from_vcg_fails:
"\<lbrakk> \<Gamma> \<turnstile>\<^bsub>/F\<^esub> P c {},UNIV; UNIV \<subseteq> A \<rbrakk> \<Longrightarrow> exec_handlers_Hoare \<Gamma> P (c # cs) Q A"
apply (drule hoare_sound)
apply (simp add: cvalid_def HoarePartialDef.valid_def
exec_handlers_Hoare_def split del: split_if)
apply (clarsimp split del: split_if)
exec_handlers_Hoare_def split del: if_split)
apply (clarsimp split del: if_split)
apply (erule exec_handlers.cases, simp_all)
apply (cases cs)
apply (auto elim!: exec_handlers.cases)[1]
@ -987,7 +987,7 @@ lemma ccorres_liftM_simp [simp]:
apply (erule (5) ccorresE)
apply (simp add: liftM_def NonDetMonad.bind_def return_def)
apply (erule bexI [rotated])
apply (simp add: unif_rrel_def split: split_if_asm)
apply (simp add: unif_rrel_def split: if_split_asm)
done
lemma ccorres_cond_weak:
@ -1225,7 +1225,7 @@ lemma ccorres_gen_asm2:
prefer 2
apply (rule ccorres_guard_imp)
apply (erule rl)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
done
lemma ccorres_guard_imp2:

8
lib/clib/Ctac.thy
View File

@ -557,7 +557,7 @@ lemma ccorres_special_trim_guard_DontReach_pis:
end
lemmas ccorres_boilerplace_simp_dels =
Collect_const -- "Avoid getting an implication due to split_if. Should probably just remove split_if"
Collect_const -- "Avoid getting an implication due to if_split. Should probably just remove if_split"
lemma ccorres_introduce_UNIV_Int_when_needed:
"ccorres_underlying sr Gamm r xf ar axf P (UNIV \<inter> {x. Q x}) hs a c
@ -1359,7 +1359,7 @@ lemma ceqv_xpres_rewrite_set_rules:
"\<lbrakk> ceqv_xpres_rewrite_set xf v S S''; ceqv_xpres_rewrite_set xf v S' S''' \<rbrakk>
\<Longrightarrow> ceqv_xpres_rewrite_set xf v (if G then S else S') (if G then S'' else S''')"
by (simp_all add: ceqv_xpres_rewrite_set_def ceqv_xpres_rewrite_basic_def
split: split_if)
split: if_split)
lemma ceqv_xpres_eq_If_rules:
"ceqv_xpres_eq_If False x y y"
@ -1467,7 +1467,7 @@ lemma ceqv_xpres_While_simpl_sequence:
[0 ..< (LEAST n. \<not> CP (v + of_nat n
* (THE offs. \<forall>s v. (xf' (simpl_final_basic (c' v) s) - v = offs))))])
else While {s. CP (xf' s)} c)"
apply (split split_if, simp add: ceqv_xpres_def[where c=c and c'=c for c])
apply (split if_split, simp add: ceqv_xpres_def[where c=c and c'=c for c])
apply (clarsimp simp: ceqv_xpres_eq_ceqv)
apply (rule ceqv_trans)
apply (rule_tac n="LEAST n. \<not> CP (v + of_nat n * offs)"
@ -1993,7 +1993,7 @@ fun tac ctxt =
ceqv_Seq_Skip_cases ceqv_Guard_UNIV[THEN iffD2]
Guard_ceqv[OF impI, OF refl] ceqv_refl
finish_ceqv_Seq_Skip_cases} 1
ORELSE (resolve_tac ctxt [@{thm xpresI}] THEN' simp_tac (ctxt |> Splitter.del_split @{thm "split_if"})) 1
ORELSE (resolve_tac ctxt [@{thm xpresI}] THEN' simp_tac (ctxt |> Splitter.del_split @{thm "if_split"})) 1
))
THEN simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms com.case}) 1
*}

12
lib/crunch-cmd.ML
View File

@ -51,7 +51,7 @@ fun funkysplit [_,b,c] = [b,c]
fun real_base_name name = name |> Long_Name.explode |> funkysplit |> Long_Name.implode (*Handles locales properly-ish*)
fun handle_int exn func = if Exn.is_interrupt exn then reraise exn else func
fun handle_int exn func = if Exn.is_interrupt exn then Exn.reraise exn else func
val wp_sect = "wp";
val wp_del_sect = "wp_del";
@ -236,7 +236,7 @@ fun deep_search_thms ctxt defn const nmspce =
val thys = thy :: Theory.ancestors_of thy;
val filt = filter (const_is_lhs const nmspce ctxt);
fun search [] = error("not found: const: " ^ PolyML.makestring const ^ " defn: " ^ PolyML.makestring defn)
fun search [] = error("not found: const: " ^ @{make_string} const ^ " defn: " ^ @{make_string} defn)
| search (t::ts) = (case (filt (thy_maybe_thms t defn)) of
[] => search ts
| thms => thms);
@ -272,7 +272,7 @@ fun unfold ctxt const triple nmspce =
val const_defn = const |> Long_Name.base_name |> def_of;
val const_def = deep_search_thms ctxt const_defn const_term nmspce
|> hd |> Simpdata.safe_mk_meta_eq;
val _ = Pretty.writeln (Pretty.block [Pretty.str ("const_def: " ^ PolyML.makestring const_defn), Thm.pretty_thm ctxt const_def])
val _ = Pretty.writeln (Pretty.block [Pretty.str ("const_def: " ^ @{make_string} const_defn), Thm.pretty_thm ctxt const_def])
val trivial_rule = Thm.trivial triple
val _ = Pretty.writeln (Pretty.block [Pretty.str "trivial_rule: ", Thm.pretty_thm ctxt trivial_rule])
val unfold_rule = trivial_rule
@ -319,9 +319,9 @@ fun induct_inst ctxt const goal nmspce =
let
val _ = debug_trace "induct_inst"
val base_const = Long_Name.base_name const;
val _ = debug_trace ("base_const: " ^ PolyML.makestring base_const)
val _ = debug_trace ("base_const: " ^ @{make_string} base_const)
val induct_thm = base_const |> induct_of |> get_thm ctxt;
val _ = debug_trace ("induct_thm: " ^ PolyML.makestring induct_thm)
val _ = debug_trace ("induct_thm: " ^ @{make_string} induct_thm)
val const_term = read_const ctxt const |> map_unvarifyT;
val n = const_term |> fastype_of |> num_args;
val t = mk_abs (Instance.magic $ mk_apps const_term n 0) n
@ -358,7 +358,7 @@ fun unfold_data ctxt constn goal nmspce nil = (
val split_if = @{thm "split_if"}
val split_if = @{thm "if_split"}
fun maybe_cheat_tac ctxt thm =
if (Goal.skip_proofs_enabled ())

4
lib/ml-helpers/TermPatternAntiquote.thy
View File

@ -95,7 +95,7 @@ fun term_pattern_antiquote ctxt s =
end;
val _ = Context.>> (Context.map_theory (
ML_Antiquotation.inline @{binding "term_pat"}
((Args.context -- Scan.lift Args.name_inner_syntax)
((Args.context -- Scan.lift Args.embedded_inner_syntax)
>> uncurry Term_Pattern_Antiquote.term_pattern_antiquote)))
*}
@ -103,7 +103,7 @@ text \<open>
Example: evaluate arithmetic expressions in ML.
\<close>
ML_val {*
fun eval_num @{term_pat "numeral ?n"} = HOLogic.dest_num n
fun eval_num @{term_pat "numeral ?n"} = HOLogic.dest_numeral n
| eval_num @{term_pat "Suc ?n"} = eval_num n + 1
| eval_num @{term_pat "0"} = 0
| eval_num @{term_pat "1"} = 1

8
lib/sep_algebra/Map_Extra.thy
View File

@ -118,7 +118,7 @@ subsection {* Properties of map restriction *}
lemma restrict_map_cancel:
"(m |` S = m |` T) = (dom m \<inter> S = dom m \<inter> T)"
by (fastforce dest: fun_cong simp: restrict_map_def None_not_eq split: split_if_asm)
by (fastforce dest: fun_cong simp: restrict_map_def None_not_eq split: if_split_asm)
lemma map_add_restricted_self [simp]:
"m ++ m |` S = m"
@ -232,11 +232,11 @@ subsection {* Properties of @{term "sub_restrict_map"} *}
lemma restrict_map_sub_disj: "h |` S \<bottom> h `- S"
by (fastforce simp: sub_restrict_map_def restrict_map_def map_disj_def
split: option.splits split_if_asm)
split: option.splits if_split_asm)
lemma restrict_map_sub_add: "h |` S ++ h `- S = h"
by (fastforce simp: sub_restrict_map_def restrict_map_def map_add_def
split: option.splits split_if)
split: option.splits if_split)
subsection {* Properties of map disjunction *}
@ -493,7 +493,7 @@ lemma map_le_conv:
unfolding map_le_def map_disj_def map_add_def
by (rule iffI,
clarsimp intro!: exI[where x="\<lambda>x. if x \<notin> dom h\<^sub>0' then h\<^sub>0 x else None"])
(fastforce intro: split: option.splits split_if_asm)+
(fastforce intro: split: option.splits if_split_asm)+
lemma map_le_conv2:
"h\<^sub>0' \<subseteq>\<^sub>m h\<^sub>0 = (\<exists>h\<^sub>1. h\<^sub>0 = h\<^sub>0' ++ h\<^sub>1 \<and> h\<^sub>0' \<bottom> h\<^sub>1)"

4
lib/sep_algebra/MonadSep.thy
View File

@ -90,9 +90,9 @@ lemma sep_set_conj_map_singleton_wp:
\<Longrightarrow> \<lbrace><P \<and>* (\<And>* x\<in>xs. I x) \<and>* R>\<rbrace> f \<lbrace>\<lambda>_. <Q \<and>* (\<And>* x\<in>xs. I x) \<and>* R>\<rbrace>"
apply (rule hoare_chain [where P="<P \<and>* I x \<and>* (\<And>* x\<in>xs - {x}. I x) \<and>* R>" and
Q="\<lambda>_. <Q \<and>* I x \<and>* (\<And>* x\<in>xs - {x}. I x) \<and>* R>"], assumption)
apply (subst (asm) sep.setprod.remove, assumption+)
apply (subst (asm) sep.prod.remove, assumption+)
apply sep_solve
apply (subst sep.setprod.remove, assumption+)
apply (subst sep.prod.remove, assumption+)
apply sep_solve
done

21
lib/sep_algebra/Separation_Algebra.thy
View File

@ -17,9 +17,8 @@ chapter "Abstract Separation Algebra"
theory Separation_Algebra
imports
Main
"~~/src/Tools/Adhoc_Overloading"
Arbitrary_Comm_Monoid
"~~/src/Tools/Adhoc_Overloading"
begin
text {* This theory is the main abstract separation algebra development *}
@ -691,11 +690,11 @@ where
abbreviation
sep_map_set_conj :: "('b \<Rightarrow> 'a::sep_algebra \<Rightarrow> bool) \<Rightarrow> 'b set \<Rightarrow> ('a \<Rightarrow> bool)"
where
"sep_map_set_conj g S \<equiv> sep.setprod g S"
"sep_map_set_conj g S \<equiv> sep.prod g S"
definition
sep_set_conj :: "('a::sep_algebra \<Rightarrow> bool) set \<Rightarrow> ('a \<Rightarrow> bool)" where
"sep_set_conj S \<equiv> sep.setprod id S"
"sep_set_conj S \<equiv> sep.prod id S"
(* Notation. *)
consts
@ -857,7 +856,7 @@ lemma sep_map_set_conj_restrict:
sep_map_set_conj P xs =
(sep_map_set_conj P {x \<in> xs. t x} \<and>*
sep_map_set_conj P {x \<in> xs. \<not> t x})"
by (subst sep.setprod.union_disjoint [symmetric], (fastforce simp: union_filter)+)
by (subst sep.prod.union_disjoint [symmetric], (fastforce simp: union_filter)+)
lemma sep_list_conj_map_add:
@ -917,7 +916,7 @@ lemma sep_set_conj_empty [simp]:
lemma sep_map_set_conj_reindex_cong:
"\<lbrakk>inj_on f A; B = f ` A; \<And>a. a \<in> A \<Longrightarrow> g a = h (f a)\<rbrakk>
\<Longrightarrow> sep_map_set_conj h B = sep_map_set_conj g A"
by (simp add: sep.setprod.reindex)
by (simp add: sep.prod.reindex)
lemma sep_list_conj_sep_map_set_conj:
"distinct xs
@ -928,7 +927,7 @@ lemma sep_list_conj_sep_set_conj:
"\<lbrakk>distinct xs; inj_on P (set xs)\<rbrakk>
\<Longrightarrow> \<And>* (map P xs) = \<And>* (P ` set xs)"
apply (subst sep_list_conj_sep_map_set_conj, assumption)
apply (clarsimp simp: sep_set_conj_def sep.setprod.reindex)
apply (clarsimp simp: sep_set_conj_def sep.prod.reindex)
done
lemma sep_map_set_conj_sep_list_conj:
@ -985,7 +984,7 @@ lemma set_sub_sub:
lemma sep_map_set_conj_sub_sub_disjoint:
"\<lbrakk>finite xs; zs \<subseteq> ys; ys \<subseteq> xs\<rbrakk>
\<Longrightarrow> sep_map_set_conj P (xs - zs) = (sep_map_set_conj P (xs - ys) \<and>* sep_map_set_conj P (ys - zs))"
apply (cut_tac sep.setprod.subset_diff [where A="xs-zs" and B="ys-zs" and g=P])
apply (cut_tac sep.prod.subset_diff [where A="xs-zs" and B="ys-zs" and g=P])
apply (subst (asm) set_sub_sub, fast+)
done
@ -1001,7 +1000,7 @@ lemma sep_list_conj_filter_map:
lemma sep_map_set_conj_restrict_predicate:
"finite A \<Longrightarrow> (\<And>* x\<in>A. if T x then P x else \<box>) = (\<And>* x\<in>(Set.filter T A). P x)"
by (simp add: Set.filter_def sep.setprod.inter_filter)
by (simp add: Set.filter_def sep.prod.inter_filter)
lemma distinct_filters:
"\<lbrakk>distinct xs; \<And>x. (f x \<and> g x) = False\<rbrakk> \<Longrightarrow>
@ -1013,14 +1012,14 @@ lemma sep_list_conj_distinct_filters:
\<And>* map P [x\<leftarrow>xs . f x \<or> g x] = (\<And>* map P [x\<leftarrow>xs . f x] \<and>* \<And>* map P [x\<leftarrow>xs . g x])"
apply (subst sep_list_conj_sep_map_set_conj, simp)+
apply (subst distinct_filters, simp+)
apply (subst sep.setprod.union_disjoint, auto)
apply (subst sep.prod.union_disjoint, auto)
done
lemma sep_map_set_conj_set_disjoint:
"\<lbrakk>finite {x. P x}; finite {x. Q x}; \<And>x. (P x \<and> Q x) = False\<rbrakk>
\<Longrightarrow> sep_map_set_conj g {x. P x \<or> Q x} =
(sep_map_set_conj g {x. P x} \<and>* sep_map_set_conj g {x. Q x})"
apply (subst sep.setprod.union_disjoint [symmetric], simp+)
apply (subst sep.prod.union_disjoint [symmetric], simp+)
apply blast
apply simp
by (metis Collect_disj_eq)

6
lib/sep_algebra/ex/capDL/Abstract_Separation_D.thy
View File

@ -617,11 +617,11 @@ lemma add_to_slots_comm:
lemma cdl_heap_add_none1:
"cdl_heap_add x y obj_id = None \<Longrightarrow> (sep_heap x) obj_id = None"
by (clarsimp simp: cdl_heap_add_def Let_unfold split:option.splits split_if_asm)
by (clarsimp simp: cdl_heap_add_def Let_unfold split:option.splits if_split_asm)
lemma cdl_heap_add_none2:
"cdl_heap_add x y obj_id = None \<Longrightarrow> (sep_heap y) obj_id = None"
by (clarsimp simp: cdl_heap_add_def Let_unfold split:option.splits split_if_asm)
by (clarsimp simp: cdl_heap_add_def Let_unfold split:option.splits if_split_asm)
lemma object_type_object_addL:
"object_type obj = object_type obj'
@ -700,7 +700,7 @@ instance
apply (case_tac x)
apply (clarsimp simp: cdl_heap_add_def)
apply (rule ext)
apply (clarsimp simp: cdl_ghost_state_add_def split:split_if_asm)
apply (clarsimp simp: cdl_ghost_state_add_def split:if_split_asm)
(* x ## y \<Longrightarrow> x + y = y + x *)
apply (clarsimp simp: plus_sep_state_def sep_disj_sep_state_def)
apply (erule sep_state_add_comm)

2
lib/sep_algebra/ex/capDL/Separation_D.thy
View File

@ -47,7 +47,7 @@ lemma sep_map_general_def2:
apply clarsimp
apply (clarsimp simp: fun_upd_def)
apply (rule ext)
apply (fastforce simp: dom_def split:split_if)
apply (fastforce simp: dom_def split:if_split)
done
(* There is an object there. *)

2
misc/scripts/check_theory_imports
View File

@ -25,7 +25,7 @@ if [ $? != 0 ]; then
fi
# Whitelist: bare names are ok for Isabelle theory imports
BUILTINS='-i Pure -i List -i HOL -i Main -i GCD'
BUILTINS='-i Pure -i List -i HOL -i Main -i Complex_Main -i GCD'
# Exclude design skeleton, which is stashed in inner directories
EXCLUDE_THYS='design/(m-)?skel'

4
proof/access-control/Access.thy
View File

@ -1089,7 +1089,7 @@ lemma auth_ipc_buffers_tro:
apply (drule_tac x = p in spec)
apply (erule integrity_obj.cases,
simp_all add: tcb_states_of_state_def get_tcb_def auth_ipc_buffers_def
split: cap.split_asm arch_cap.split_asm split_if_asm bool.splits)
split: cap.split_asm arch_cap.split_asm if_split_asm bool.splits)
apply fastforce
done
@ -1100,7 +1100,7 @@ lemma auth_ipc_buffers_tro_fwd:
apply (drule_tac x = p in spec)
apply (erule integrity_obj.cases,
simp_all add: tcb_states_of_state_def get_tcb_def auth_ipc_buffers_def
split: cap.split_asm arch_cap.split_asm split_if_asm bool.splits)
split: cap.split_asm arch_cap.split_asm if_split_asm bool.splits)
apply fastforce
done

44
proof/access-control/Arch_AC.thy
View File

@ -253,7 +253,7 @@ where
definition
authorised_page_inv :: "'a PAS \<Rightarrow> page_invocation \<Rightarrow> bool"
where
"authorised_page_inv aag pi \<equiv> case pi of
"authorised_page_inv aag pgi \<equiv> case pgi of
PageMap asid cap ptr slots \<Rightarrow>
pas_cap_cur_auth aag cap \<and> is_subject aag (fst ptr) \<and> authorised_slots aag slots
| PageRemap asid slots \<Rightarrow> authorised_slots aag slots
@ -304,7 +304,7 @@ lemma lookup_pt_slot_authorised:
apply (simp add: aag_has_auth_to_Control_eq_owns)
apply (drule_tac f="\<lambda>pde. valid_pde pde s" in arg_cong, simp)
apply (clarsimp simp: obj_at_def a_type_def less_kernel_base_mapping_slots)
apply (clarsimp split: Structures_A.kernel_object.split_asm split_if_asm
apply (clarsimp split: Structures_A.kernel_object.split_asm if_split_asm
arch_kernel_obj.split_asm)
apply (erule pspace_alignedE, erule domI)
apply (simp add: pt_bits_def pageBits_def)
@ -517,10 +517,10 @@ lemma set_mrs_state_vrefs[wp]:
apply (simp add: set_mrs_def split_def set_object_def)
apply (wp gets_the_wp get_wp put_wp mapM_x_wp'
| wpc
| simp split del: split_if add: zipWithM_x_mapM_x split_def store_word_offs_def)+
| simp split del: if_split add: zipWithM_x_mapM_x split_def store_word_offs_def)+
apply (auto simp: obj_at_def state_vrefs_def get_tcb_ko_at
elim!: rsubst[where P=P, OF _ ext]
split: split_if_asm simp: vs_refs_no_global_pts_def)
split: if_split_asm simp: vs_refs_no_global_pts_def)
done
(* FIXME: move *)
@ -529,7 +529,7 @@ lemma set_mrs_thread_states[wp]:
apply (simp add: set_mrs_def split_def set_object_def)
apply (wp gets_the_wp get_wp put_wp mapM_x_wp'
| wpc
| simp split del: split_if add: zipWithM_x_mapM_x split_def store_word_offs_def)+
| simp split del: if_split add: zipWithM_x_mapM_x split_def store_word_offs_def)+
apply (clarsimp simp: fun_upd_def[symmetric] thread_states_preserved)
done
@ -538,7 +538,7 @@ lemma set_mrs_thread_bound_ntfns[wp]:
apply (simp add: set_mrs_def split_def set_object_def)
apply (wp gets_the_wp get_wp put_wp mapM_x_wp' dmo_wp
| wpc
| simp split del: split_if add: zipWithM_x_mapM_x split_def store_word_offs_def no_irq_storeWord)+
| simp split del: if_split add: zipWithM_x_mapM_x split_def store_word_offs_def no_irq_storeWord)+
apply (clarsimp simp: fun_upd_def[symmetric] thread_bound_ntfns_preserved )
done
@ -616,8 +616,8 @@ lemma set_mrs_integrity_autarch:
apply (simp add: set_mrs_def)
apply (wp gets_the_wp get_wp put_wp mapM_x_wp' store_word_offs_integrity_autarch [where aag = aag and thread = thread]
| wpc
| simp split del: split_if add: split_def zipWithM_x_mapM_x )+
apply (clarsimp elim!: in_set_zipE split: split_if_asm)
| simp split del: if_split add: split_def zipWithM_x_mapM_x )+
apply (clarsimp elim!: in_set_zipE split: if_split_asm)
apply (rule order_le_less_trans [where y = msg_max_length])
apply (fastforce simp add: le_eq_less_or_eq)
apply (simp add: msg_max_length_def msg_align_bits)
@ -627,8 +627,8 @@ lemma set_mrs_integrity_autarch:
done
lemma perform_page_invocation_respects:
"\<lbrace>integrity aag X st and pas_refined aag and K (authorised_page_inv aag pi) and valid_page_inv pi and valid_arch_objs and pspace_aligned and is_subject aag \<circ> cur_thread\<rbrace>
perform_page_invocation pi
"\<lbrace>integrity aag X st and pas_refined aag and K (authorised_page_inv aag pgi) and valid_page_inv pgi and valid_arch_objs and pspace_aligned and is_subject aag \<circ> cur_thread\<rbrace>
perform_page_invocation pgi
\<lbrace>\<lambda>s. integrity aag X st\<rbrace>"
proof -
(* does not work as elim rule with clarsimp, which hammers Ball in concl. *)
@ -664,8 +664,8 @@ proof -
qed
lemma perform_page_invocation_pas_refined [wp]:
"\<lbrace>pas_refined aag and K (authorised_page_inv aag pi) and valid_page_inv pi\<rbrace>
perform_page_invocation pi
"\<lbrace>pas_refined aag and K (authorised_page_inv aag pgi) and valid_page_inv pgi\<rbrace>
perform_page_invocation pgi
\<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
apply (simp add: perform_page_invocation_def mapM_discarded
valid_page_inv_def valid_unmap_def swp_def
@ -680,7 +680,7 @@ lemma perform_page_invocation_pas_refined [wp]:
| strengthen clas_update_map_data_strg
| wpc
| simp)+
apply (case_tac pi)
apply (case_tac pgi)
apply (clarsimp simp: valid_slots_def pte_ref_def
pde_ref2_def auth_graph_map_mem pas_refined_refl split:sum.splits)
apply (clarsimp simp: pte_ref_def pde_ref2_def pte_ref_def
@ -763,7 +763,7 @@ lemma pas_refined_set_asid_strg:
\<longrightarrow>
pas_refined aag (s\<lparr>arch_state := arch_state s \<lparr>arm_asid_table := (arm_asid_table (arch_state s))(base \<mapsto> pool)\<rparr>\<rparr>)"
apply (clarsimp simp: pas_refined_def state_objs_to_policy_def)
apply (erule state_asids_to_policy_aux.cases, simp_all split: split_if_asm)
apply (erule state_asids_to_policy_aux.cases, simp_all split: if_split_asm)
apply (auto intro: state_asids_to_policy_aux.intros auth_graph_map_memI[OF sbta_vref] pas_refined_refl[simplified pas_refined_def state_objs_to_policy_def])
done
@ -984,7 +984,7 @@ lemma perform_asid_pool_invocation_pas_refined [wp]:
apply (clarsimp simp: cap_auth_conferred_def is_cap_simps is_page_cap_def auth_graph_map_mem
pas_refined_all_auth_is_owns pas_refined_refl cli_no_irqs
dest!: graph_ofD)
apply (clarsimp split: split_if_asm)
apply (clarsimp split: if_split_asm)
apply (clarsimp simp add: pas_refined_refl auth_graph_map_def2
mask_asid_low_bits_ucast_ucast[symmetric]
valid_apinv_def obj_at_def)
@ -1013,7 +1013,7 @@ where
"authorised_arch_inv aag ai \<equiv> case ai of
InvokePageTable pti \<Rightarrow> authorised_page_table_inv aag pti
| InvokePageDirectory pdi \<Rightarrow> authorised_page_directory_inv aag pdi
| InvokePage pi \<Rightarrow> authorised_page_inv aag pi
| InvokePage pgi \<Rightarrow> authorised_page_inv aag pgi
| InvokeASIDControl aci \<Rightarrow> authorised_asid_control_inv aag aci
| InvokeASIDPool api \<Rightarrow> authorised_asid_pool_inv aag api"
@ -1105,7 +1105,7 @@ lemma decode_arch_invocation_authorised:
unfolding arch_decode_invocation_def authorised_arch_inv_def aag_cap_auth_def
apply (rule hoare_pre)
apply (simp add: split_def Let_def
cong: cap.case_cong arch_cap.case_cong if_cong option.case_cong split del: split_if)
cong: cap.case_cong arch_cap.case_cong if_cong option.case_cong split del: if_split)
apply (wp select_wp whenE_throwError_wp check_vp_wpR
find_pd_for_asid_authority2
@ -1113,7 +1113,7 @@ lemma decode_arch_invocation_authorised:
| simp add: authorised_asid_control_inv_def authorised_page_inv_def
authorised_page_directory_inv_def
del: hoare_post_taut hoare_True_E_R
split del: split_if)+
split del: if_split)+
apply (clarsimp simp: authorised_asid_pool_inv_def authorised_page_table_inv_def
neq_Nil_conv invs_psp_aligned invs_arch_objs cli_no_irqs)
apply (drule diminished_cte_wp_at_valid_cap, clarsimp+)
@ -1158,7 +1158,7 @@ lemma decode_arch_invocation_authorised:
apply (clarsimp simp: vspace_cap_rights_to_auth_def mask_vm_rights_def
validate_vm_rights_def vm_read_write_def vm_read_only_def
vm_kernel_only_def
split: split_if_asm)
split: if_split_asm)
-- "Unmap"
apply (simp add: aag_cap_auth_def cli_no_irqs)
-- "PageTableCap"
@ -1174,7 +1174,7 @@ lemma decode_arch_invocation_authorised:
pde_ref2_def pas_refined_all_auth_is_owns pas_refined_refl )
apply (subgoal_tac "x && ~~ mask pt_bits = word")
apply simp
apply (clarsimp simp: valid_cap_simps cap_aligned_def split: split_if_asm)
apply (clarsimp simp: valid_cap_simps cap_aligned_def split: if_split_asm)
apply (subst (asm) upto_enum_step_subtract)
apply (subgoal_tac "is_aligned word pt_bits")
apply (simp add: is_aligned_no_overflow)
@ -1207,11 +1207,11 @@ lemma delete_asid_pas_refined[wp]:
apply (clarsimp dest!: auth_graph_map_memD graph_ofD)
apply (erule pas_refined_mem[OF sta_vref, rotated])
apply (fastforce simp: state_vrefs_def vs_refs_no_global_pts_def
image_def graph_of_def split: split_if_asm)
image_def graph_of_def split: if_split_asm)
apply (clarsimp simp: pas_refined_def dest!: graph_ofD)
apply (erule subsetD, erule state_asids_to_policy_aux.intros)
apply (fastforce simp: state_vrefs_def vs_refs_no_global_pts_def
graph_of_def image_def split: split_if_asm)
graph_of_def image_def split: if_split_asm)
done
lemma delete_asid_pool_pas_refined [wp]:

82
proof/access-control/CNode_AC.thy
View File

@ -154,7 +154,7 @@ proof (induct arbitrary: s rule: resolve_address_bits'.induct)
by wp
show ?case
apply (subst resolve_address_bits'.simps)
apply (cases cap', simp_all add: P split del: split_if)
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)
@ -174,15 +174,15 @@ lemma resolve_address_bits_authorised[wp]:
done
lemma lookup_slot_for_cnode_op_authorised[wp]:
"\<lbrace>pas_refined aag and K (is_cnode_cap root \<longrightarrow> (\<forall>x \<in> obj_refs root. is_subject aag x))\<rbrace>
lookup_slot_for_cnode_op is_source root ptr depth
"\<lbrace>pas_refined aag and K (is_cnode_cap croot \<longrightarrow> (\<forall>x \<in> obj_refs croot. is_subject aag x))\<rbrace>
lookup_slot_for_cnode_op is_source croot ptr depth
\<lbrace>\<lambda>rv s. is_subject aag (fst rv)\<rbrace>, -"
apply (simp add: lookup_slot_for_cnode_op_def split del: split_if)
apply (simp add: lookup_slot_for_cnode_op_def split del: if_split)
apply (rule hoare_pre)
apply (wp whenE_throwError_wp hoare_drop_imps
resolve_address_bits_authorised[THEN hoare_post_imp_R[where Q'="\<lambda>x s. is_subject aag (fst (fst x))"]]
| wpc
| simp add: split_def authorised_cnode_inv_def split del: split_if
| simp add: split_def authorised_cnode_inv_def split del: if_split
del: resolve_address_bits'.simps split_paired_All | clarsimp)+
done
@ -218,7 +218,7 @@ lemma decode_cnode_inv_authorised:
decode_cnode_invocation label args cap excaps
\<lbrace>\<lambda>rv s. authorised_cnode_inv aag rv s\<rbrace>,-"
apply (simp add: authorised_cnode_inv_def decode_cnode_invocation_def split_def whenE_def unlessE_def set_eq_iff
cong: if_cong Invocations_A.cnode_invocation.case_cong split del: split_if)
cong: if_cong Invocations_A.cnode_invocation.case_cong split del: if_split)
apply (rule hoare_pre)
apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift_R hoare_vcg_all_lift_R
lsfco_cte_at
@ -245,7 +245,7 @@ lemma set_cap_state_vrefs[wp]:
apply (wp get_object_wp | wpc)+
apply (auto simp: obj_at_def state_vrefs_def
elim!: rsubst[where P=P, OF _ ext]
split: split_if_asm simp: vs_refs_no_global_pts_def)
split: if_split_asm simp: vs_refs_no_global_pts_def)
done
lemma set_cap_thread_states[wp]:
@ -279,7 +279,7 @@ lemma sita_caps_update:
state_irqs_to_policy_aux aag (\<lambda>a. if a = ptr then Some cap else caps a) \<subseteq> pasPolicy aag"
apply clarsimp
apply (erule state_irqs_to_policy_aux.cases)
apply (fastforce intro: state_irqs_to_policy_aux.intros simp: cap_links_irq_def split: split_if_asm)+
apply (fastforce intro: state_irqs_to_policy_aux.intros simp: cap_links_irq_def split: if_split_asm)+
done
lemma sata_update:
@ -289,7 +289,7 @@ lemma sata_update:
state_asids_to_policy_aux aag ((caps_of_state s) (ptr \<mapsto> cap)) asid_tab vrefs \<subseteq> pasPolicy aag"
apply clarsimp
apply (erule state_asids_to_policy_aux.cases)
apply (fastforce intro: state_asids_to_policy_aux.intros simp: cap_links_asid_slot_def label_owns_asid_slot_def split: split_if_asm)+
apply (fastforce intro: state_asids_to_policy_aux.intros simp: cap_links_asid_slot_def label_owns_asid_slot_def split: if_split_asm)+
done
lemma cli_caps_of_state:
@ -335,7 +335,7 @@ lemma set_cap_pas_refined [wp]:
apply (intro conjI) -- "auth_graph_map"
apply (clarsimp dest!: auth_graph_map_memD)
apply (erule state_bits_to_policy.cases, auto simp: cap_links_asid_slot_def label_owns_asid_slot_def intro: auth_graph_map_memI state_bits_to_policy.intros
split: split_if_asm)[1]
split: if_split_asm)[1]
apply (erule (2) sata_update[unfolded fun_upd_def])
apply (erule (2) sita_caps_update)
done
@ -350,7 +350,7 @@ lemma cap_move_respects[wp]:
apply (rule hoare_pre)
apply (wp get_cap_wp set_cap_integrity_autarch set_original_integrity_autarch
cap_move_ext.list_integ_lift[where Q="\<top>"] cap_move_list_integrity
| simp add: set_cdt_def split del: split_if)+
| simp add: set_cdt_def split del: if_split)+
apply (rule_tac Q="\<lambda>rv s. integrity aag X st s \<and> (\<forall>v. cdt s v = Some src \<longrightarrow> is_subject aag (fst v))"
in hoare_post_imp)
apply (simp add: integrity_def)
@ -378,12 +378,12 @@ lemma cap_swap_respects[wp]:
apply (wp get_cap_wp set_cap_integrity_autarch
cap_swap_ext_extended.list_integ_lift[where Q="\<top>"] cap_swap_list_integrity
set_original_integrity_autarch[unfolded pred_conj_def K_def]
| simp add: set_cdt_def split del: split_if)+
| simp add: set_cdt_def split del: if_split)+
apply (rule_tac Q="\<lambda>rv s. integrity aag X st s
\<and> (\<forall>v. cdt s v = Some slot \<or> cdt s v = Some slot'
\<longrightarrow> is_subject aag (fst v))"
in hoare_post_imp)
apply (simp add: fun_upd_def[symmetric] split del: split_if)
apply (simp add: fun_upd_def[symmetric] split del: if_split)
apply (intro integrity_cdt_fun_upd, simp_all)[1]
apply (simp add: integrity_def)
apply (clarsimp simp: integrity_cdt_def)
@ -491,7 +491,7 @@ lemma set_cdt_pas_refined:
apply (thin_tac "\<forall>a b aa. P a b aa" for P)
apply (erule state_bits_to_policy.cases)
apply (auto intro: auth_graph_map_memI state_bits_to_policy.intros
split: split_if_asm | blast)+
split: if_split_asm | blast)+
done
lemma pas_refined_original_cap_update[simp]:
@ -585,12 +585,12 @@ lemma cap_insert_pas_refined:
hoare_weak_lift_imp hoare_vcg_all_lift set_cap_caps_of_state2
set_untyped_cap_as_full_cdt_is_original_cap get_cap_wp
tcb_domain_map_wellformed_lift
| simp split del: split_if del: split_paired_All fun_upd_apply
| simp split del: if_split del: split_paired_All fun_upd_apply
| strengthen update_one_strg)+
apply (clarsimp simp: pas_refined_refl split del: split_if)
apply (clarsimp simp: pas_refined_refl split del: if_split)
apply (erule impE)
apply(clarsimp simp: cap_cur_auth_caps_of_state cte_wp_at_caps_of_state)
apply (auto split: split_if_asm simp: pas_refined_refl dest: aag_cdt_link_Control)
apply (auto split: if_split_asm simp: pas_refined_refl dest: aag_cdt_link_Control)
done
lemma cap_links_irq_Nullcap [simp]:
@ -628,8 +628,8 @@ lemma cap_swap_pas_refined[wp]:
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: cap_swap_def)
apply (rule hoare_pre)
apply (wp set_cdt_pas_refined tcb_domain_map_wellformed_lift | simp split del: split_if)+
apply (clarsimp simp: pas_refined_refl split: split_if_asm split del: split_if)
apply (wp set_cdt_pas_refined tcb_domain_map_wellformed_lift | simp split del: if_split)+
apply (clarsimp simp: pas_refined_refl split: if_split_asm split del: if_split)
apply (fastforce dest: sta_cdt pas_refined_mem)+
done
@ -690,7 +690,7 @@ lemma sts_thread_bound_ntfns[wp]:
apply (simp add: set_thread_state_def set_object_def)
apply (wp dxo_wp_weak |simp)+
apply (clarsimp simp: thread_bound_ntfns_def get_tcb_def
split: split_if option.splits kernel_object.splits
split: if_split option.splits kernel_object.splits
elim!: rsubst[where P=P, OF _ ext])
done
@ -728,7 +728,7 @@ lemma set_thread_state_pas_refined:
apply (clarsimp dest!: auth_graph_map_memD)
apply (erule state_bits_to_policy.cases)
apply (auto intro: state_bits_to_policy.intros auth_graph_map_memI
split: split_if_asm)
split: if_split_asm)
done
lemma set_ep_vrefs[wp]:
@ -955,14 +955,14 @@ lemma store_pte_pas_refined[wp]:
apply (wp tcb_domain_map_wellformed_lift | wps)+
apply clarsimp
apply (rule conjI)
apply (clarsimp dest!: auth_graph_map_memD split del: split_if)
apply (clarsimp dest!: auth_graph_map_memD split del: if_split)
apply (erule state_bits_to_policy.cases,
auto intro: state_bits_to_policy.intros auth_graph_map_memI
split: split_if_asm)[1]
split: if_split_asm)[1]
apply (erule_tac B="state_asids_to_policy aag s" for s in subset_trans[rotated])
apply (auto intro: state_asids_to_policy_aux.intros
elim!: state_asids_to_policy_aux.cases
split: split_if_asm)
split: if_split_asm)
done
lemma store_pde_st_vrefs[wp]:
@ -973,7 +973,7 @@ lemma store_pde_st_vrefs[wp]:
(\<Union>(p', sz, auth)\<in>set_option (pde_ref2 pde).
(\<lambda>(p'', a). (p'', VSRef ((p && mask pd_bits) >> 2) (Some APageDirectory), a)) ` (ptr_range p' sz \<times> auth)))))\<rbrace>
store_pde p pde \<lbrace>\<lambda>rv s. P (state_vrefs s)\<rbrace>"
apply (simp add: store_pde_def set_pd_def set_object_def split del: split_if)
apply (simp add: store_pde_def set_pd_def set_object_def split del: if_split)
apply (wp get_object_wp)
apply (clarsimp simp: obj_at_def)
apply (erule all_rsubst[where P=P], subst fun_eq_iff)
@ -1011,16 +1011,16 @@ lemma store_pde_pas_refined[wp]:
apply (simp add: pas_refined_def state_objs_to_policy_def)
apply (rule hoare_pre)
apply (wp tcb_domain_map_wellformed_lift | wps)+
apply (clarsimp split del: split_if)
apply (clarsimp split del: if_split)
apply (rule conjI)
apply (clarsimp dest!: auth_graph_map_memD split del: split_if)
apply (clarsimp dest!: auth_graph_map_memD split del: if_split)
apply (erule state_bits_to_policy.cases,
auto intro: state_bits_to_policy.intros auth_graph_map_memI
split: split_if_asm)[1]
split: if_split_asm)[1]
apply (erule_tac B="state_asids_to_policy aag s" for s in subset_trans[rotated])
apply (auto intro: state_asids_to_policy_aux.intros
elim!: state_asids_to_policy_aux.cases
split: split_if_asm)
split: if_split_asm)
done
lemmas pde_ref_simps = pde_ref_def[split_simps pde.split]
@ -1079,11 +1079,11 @@ lemma set_asid_pool_pas_refined[wp]:
apply (clarsimp dest!: auth_graph_map_memD)
apply (erule state_bits_to_policy.cases,
auto intro: state_bits_to_policy.intros auth_graph_map_memI
split: split_if_asm)[1]
split: if_split_asm)[1]
apply (auto intro: state_asids_to_policy_aux.intros
simp: subsetD[OF _ state_asids_to_policy_aux.intros(2)]
elim!: state_asids_to_policy_aux.cases
split: split_if_asm)
split: if_split_asm)
apply fastforce+
done
@ -1095,7 +1095,7 @@ lemma pas_refined_clear_asid:
"pas_refined aag s \<Longrightarrow> pas_refined aag (s\<lparr>arch_state := arch_state s\<lparr>arm_asid_table := \<lambda>a. if a = asid then None else arm_asid_table (arch_state s) a\<rparr>\<rparr>)"
unfolding pas_refined_def
apply (auto simp: state_objs_to_policy_def elim!: state_asids_to_policy_aux.cases
split: split_if_asm intro: state_asids_to_policy_aux.intros)
split: if_split_asm intro: state_asids_to_policy_aux.intros)
apply (fastforce elim: state_asids_to_policy_aux.intros)+
done
@ -1262,18 +1262,18 @@ lemma auth_derived_mask_cap:
apply (rule conjI | clarsimp
| erule subsetD subsetD[OF cap_rights_to_auth_mono, rotated]
| simp add: cap_auth_conferred_def vspace_cap_rights_to_auth_def
is_page_cap_def split: split_if_asm)+
is_page_cap_def split: if_split_asm)+
done
lemma auth_derived_update_cap_data:
"\<lbrakk> auth_derived cap cap'; update_cap_data pres w cap \<noteq> cap.NullCap \<rbrakk>
\<Longrightarrow> auth_derived (update_cap_data pres w cap) cap'"
apply (simp add: update_cap_data_def is_cap_simps arch_update_cap_data_def
split del: split_if cong: if_cong)
split del: if_split cong: if_cong)
apply (clarsimp simp: badge_update_def Let_def split_def is_cap_simps
is_page_cap_def
split: split_if_asm
split del: split_if)
split: if_split_asm
split del: if_split)
apply (simp_all add: auth_derived_def the_cnode_cap_def)
apply (simp_all add: cap_auth_conferred_def)
done
@ -1298,7 +1298,7 @@ lemma decode_cnode_invocation_auth_derived:
"\<lbrace>\<top>\<rbrace> decode_cnode_invocation label args cap excaps
\<lbrace>cnode_inv_auth_derivations\<rbrace>,-"
apply (simp add: decode_cnode_invocation_def split_def whenE_def unlessE_def
split del: split_if)
split del: if_split)
apply (rule hoare_pre)
apply (wp derive_cap_auth_derived get_cap_auth_derived
hoare_vcg_all_lift
@ -1306,7 +1306,7 @@ lemma decode_cnode_invocation_auth_derived:
| simp add: cnode_inv_auth_derivations_If_Insert_Move[unfolded cnode_inv_auth_derivations_def]
cnode_inv_auth_derivations_def split_def whenE_def
del: hoare_post_taut hoare_True_E_R
split del: split_if
split del: if_split
| strengthen cte_wp_at_auth_derived_mask_cap_strg
cte_wp_at_auth_derived_update_cap_data_strg
| wp_once hoare_drop_imps)+
@ -1375,7 +1375,7 @@ lemma update_cap_obj_refs_subset:
"x \<in> obj_refs (update_cap_data P dt cap) \<Longrightarrow> x \<in> obj_refs cap"
apply (case_tac cap,
simp_all add: update_cap_data_closedform
split: split_if_asm)
split: if_split_asm)
done
(* FIXME: move *)
@ -1383,7 +1383,7 @@ lemma update_cap_untyped_range_subset:
"x \<in> untyped_range (update_cap_data P dt cap) \<Longrightarrow> x \<in> untyped_range cap"
apply (case_tac cap,
simp_all add: update_cap_data_closedform
split: split_if_asm)
split: if_split_asm)
done
lemmas derive_cap_aag_caps = derive_cap_obj_refs_auth derive_cap_untyped_range_subset derive_cap_clas derive_cap_cli
@ -1410,7 +1410,7 @@ lemma clas_update_cap_data [simp]:
lemma update_cap_cap_auth_conferred_subset:
"x \<in> cap_auth_conferred (update_cap_data b w cap) \<Longrightarrow> x \<in> cap_auth_conferred cap"
unfolding update_cap_data_def
apply (clarsimp split: split_if_asm simp: is_cap_simps cap_auth_conferred_def cap_rights_to_auth_def badge_update_def the_cnode_cap_def
apply (clarsimp split: if_split_asm simp: is_cap_simps cap_auth_conferred_def cap_rights_to_auth_def badge_update_def the_cnode_cap_def
Let_def vspace_cap_rights_to_auth_def arch_update_cap_data_def)
done

10
proof/access-control/Deterministic_AC.thy
View File

@ -89,7 +89,7 @@ lemma cap_move_list_integrity:
notes split_paired_All[simp del]
shows
"\<lbrace>list_integ P st and K(P src) and K(P dest)\<rbrace> cap_move_ext src dest src_p dest_p \<lbrace>\<lambda>_. list_integ P st\<rbrace>"
apply (simp add: cap_move_ext_def split del: split_if)
apply (simp add: cap_move_ext_def split del: if_split)
apply (wp update_cdt_list_wp)
apply (intro impI conjI allI | simp add: list_filter_replace list_filter_remove split: option.splits | elim conjE | simp add: list_integ_def)+
done
@ -98,7 +98,7 @@ lemma cap_insert_list_integrity:
notes split_paired_All[simp del]
shows
"\<lbrace>list_integ P st and K(P src) and K(P dest)\<rbrace> cap_insert_ext src_parent src dest src_p dest_p \<lbrace>\<lambda>_. list_integ P st\<rbrace>"
apply (simp add: cap_insert_ext_def split del: split_if)
apply (simp add: cap_insert_ext_def split del: if_split)
apply (wp update_cdt_list_wp)
apply (intro impI conjI allI | simp add: list_filter_insert_after list_filter_remove split: option.splits | elim conjE | simp add: list_integ_def)+
done
@ -107,7 +107,7 @@ lemma create_cap_list_integrity:
notes split_paired_All[simp del]
shows
"\<lbrace>list_integ P st and K(P dest)\<rbrace> create_cap_ext untyped dest dest_p \<lbrace>\<lambda>_. list_integ P st\<rbrace>"
apply (simp add: create_cap_ext_def split del: split_if)
apply (simp add: create_cap_ext_def split del: if_split)
apply (wp update_cdt_list_wp)
apply (intro impI conjI allI | simp add: list_filter_replace list_filter_remove split: option.splits | elim conjE | simp add: list_integ_def)+
done
@ -117,7 +117,7 @@ lemma empty_slot_list_integrity:
notes split_paired_All[simp del]
shows
"\<lbrace>list_integ P st and (\<lambda>s. valid_list_2 (cdt_list s) m) and K(P slot) and K( all_children P m)\<rbrace> empty_slot_ext slot slot_p \<lbrace>\<lambda>_. list_integ P st\<rbrace>"
apply (simp add: empty_slot_ext_def split del: split_if)
apply (simp add: empty_slot_ext_def split del: if_split)
apply (wp update_cdt_list_wp)
apply (intro impI conjI allI | simp add: list_filter_replace_list list_filter_remove split: option.splits | elim conjE | simp add: list_integ_def)+
apply (drule_tac x="the slot_p" in spec)
@ -130,7 +130,7 @@ lemma cap_swap_list_integrity:
notes split_paired_All[simp del]
shows
"\<lbrace>list_integ P st and K(P slot1) and K(P slot2)\<rbrace> cap_swap_ext slot1 slot2 slot1_p slot2_p \<lbrace>\<lambda>_. list_integ P st\<rbrace>"
apply (simp add: cap_swap_ext_def split del: split_if)
apply (simp add: cap_swap_ext_def split del: if_split)
apply (wp update_cdt_list_wp)
apply (intro impI conjI allI | simp add: list_filter_replace list_filter_swap split: option.splits | elim conjE | simp add: list_integ_def)+ (* slow *)
done

40
proof/access-control/DomainSepInv.thy
View File

@ -214,7 +214,7 @@ lemma weak_derived_DomainCap:
"weak_derived c' c \<Longrightarrow> (c' = cap.DomainCap) = (c = cap.DomainCap)"
apply (clarsimp simp: weak_derived_def)
apply (erule disjE)
apply (clarsimp simp: copy_of_def split: split_if_asm)
apply (clarsimp simp: copy_of_def split: if_split_asm)
apply (auto simp: is_cap_simps same_object_as_def
split: cap.splits arch_cap.splits)[1]
apply simp
@ -277,7 +277,7 @@ lemma cap_insert_domain_sep_inv:
cap_insert cap slot dest_slot
\<lbrace> \<lambda>_. domain_sep_inv irqs st \<rbrace>"
apply(simp add: cap_insert_def)
apply(wp set_cap_domain_sep_inv get_cap_wp set_original_wp dxo_wp_weak | simp split del: split_if)+
apply(wp set_cap_domain_sep_inv get_cap_wp set_original_wp dxo_wp_weak | simp split del: if_split)+
apply(blast dest: cte_wp_at_is_derived_domain_sep_inv_cap)
done
@ -291,7 +291,7 @@ lemma cap_move_domain_sep_inv:
cap_move cap slot dest_slot
\<lbrace> \<lambda>_. domain_sep_inv irqs st \<rbrace>"
apply(simp add: cap_move_def)
apply(wp set_cap_domain_sep_inv get_cap_wp set_original_wp dxo_wp_weak | simp split del: split_if | blast dest: cte_wp_at_weak_derived_domain_sep_inv_cap)+
apply(wp set_cap_domain_sep_inv get_cap_wp set_original_wp dxo_wp_weak | simp split del: if_split | blast dest: cte_wp_at_weak_derived_domain_sep_inv_cap)+
done
lemma domain_sep_inv_machine_state_update[simp]:
@ -487,7 +487,7 @@ crunch domain_sep_inv[wp]: finalise_cap "domain_sep_inv irqs st"
lemma finalise_cap_domain_sep_inv_cap:
"\<lbrace>\<lambda>s. domain_sep_inv_cap irqs cap\<rbrace> finalise_cap cap b \<lbrace>\<lambda>rv s. domain_sep_inv_cap irqs (fst rv)\<rbrace>"
apply(case_tac cap)
apply(wp | simp add: o_def split del: split_if split: cap.splits arch_cap.splits | fastforce split: if_splits simp: domain_sep_inv_cap_def)+
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)
apply(rule hoare_pre, simp, wp, fastforce simp: domain_sep_inv_cap_def)
apply(simp add: arch_finalise_cap_def)
@ -509,7 +509,7 @@ lemma finalise_cap_returns_None:
finalise_cap cap b
\<lbrace>\<lambda>rv s. \<not> irqs \<longrightarrow> snd rv = None\<rbrace>"
apply(case_tac cap)
apply(simp add: o_def split del: split_if | wp | fastforce simp: domain_sep_inv_cap_def | rule hoare_pre)+
apply(simp add: o_def split del: if_split | wp | fastforce simp: domain_sep_inv_cap_def | rule hoare_pre)+
done
lemma rec_del_domain_sep_inv':
@ -528,10 +528,10 @@ lemma rec_del_domain_sep_inv':
done
next
case (2 slot exposed s) show ?case
apply(simp add: rec_del.simps split del: split_if)
apply(simp add: rec_del.simps split del: if_split)
apply(rule hoare_pre_spec_validE)
apply(wp drop_spec_validE[OF returnOk_wp] drop_spec_validE[OF liftE_wp] set_cap_domain_sep_inv
|simp add: split_def split del: split_if)+
|simp add: split_def split del: if_split)+
apply(rule spec_strengthen_postE)
apply(rule "2.hyps", fastforce+)
apply(rule drop_spec_validE, (wp preemption_point_inv| simp)+)[1]
@ -541,7 +541,7 @@ lemma rec_del_domain_sep_inv':
apply(wp finalise_cap_domain_sep_inv_cap get_cap_wp
finalise_cap_returns_None
drop_spec_validE[OF liftE_wp] set_cap_domain_sep_inv
|simp add: without_preemption_def split del: split_if
|simp add: without_preemption_def split del: if_split
|wp_once hoare_drop_imps)+
apply(blast dest: cte_wp_at_domain_sep_inv_cap)
done
@ -668,7 +668,7 @@ lemma invoke_cnode_domain_sep_inv:
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
unfolding invoke_cnode_def
apply(case_tac ci)
apply(wp cap_insert_domain_sep_inv cap_move_domain_sep_inv | simp split del: split_if)+
apply(wp cap_insert_domain_sep_inv cap_move_domain_sep_inv | simp split del: if_split)+
apply(rule hoare_pre)
apply(wp cap_move_domain_sep_inv cap_move_cte_wp_at_other get_cap_wp | simp | blast dest: cte_wp_at_weak_derived_domain_sep_inv_cap | wpc)+
apply(fastforce dest: cte_wp_at_weak_derived_ReplyCap)
@ -807,8 +807,8 @@ crunch domain_sep_inv[wp]: copy_mrs, set_message_info, invalidate_tlb_by_asid "d
(wp: crunch_wps)
lemma perform_page_invocation_domain_sep_inv:
"\<lbrace>domain_sep_inv irqs st and valid_page_inv pi\<rbrace>
perform_page_invocation pi
"\<lbrace>domain_sep_inv irqs st and valid_page_inv pgi\<rbrace>
perform_page_invocation pgi
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(rule hoare_pre)
apply(wp mapM_wp[OF _ subset_refl] set_cap_domain_sep_inv
@ -820,8 +820,8 @@ lemma perform_page_invocation_domain_sep_inv:
done
lemma perform_page_table_invocation_domain_sep_inv:
"\<lbrace>domain_sep_inv irqs st and valid_pti pi\<rbrace>
perform_page_table_invocation pi
"\<lbrace>domain_sep_inv irqs st and valid_pti pgi\<rbrace>
perform_page_table_invocation pgi
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(rule hoare_pre)
apply(simp add: perform_page_table_invocation_def)
@ -847,7 +847,7 @@ lemma cap_insert_domain_sep_inv':
cap_insert cap slot dest_slot
\<lbrace> \<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(simp add: cap_insert_def)
apply(wp set_cap_domain_sep_inv get_cap_wp dxo_wp_weak | simp split del: split_if)+
apply(wp set_cap_domain_sep_inv get_cap_wp dxo_wp_weak | simp split del: if_split)+
done
lemma domain_sep_inv_cap_max_free_index_update[simp]:
@ -1044,7 +1044,7 @@ lemma receive_ipc_base_domain_sep_inv:
apply (clarsimp cong: endpoint.case_cong thread_get_def get_thread_state_def)
apply (rule hoare_pre)
apply (wp setup_caller_cap_domain_sep_inv dxo_wp_weak
| wpc | simp split del: split_if)+
| wpc | simp split del: if_split)+
apply(rule_tac Q="\<lambda> r s. domain_sep_inv irqs st s" in hoare_strengthen_post)
apply(wp do_ipc_transfer_domain_sep_inv hoare_vcg_all_lift | wpc | simp)+
apply(wp hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift get_endpoint_wp
@ -1064,7 +1064,7 @@ lemma receive_ipc_domain_sep_inv:
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, simp)
apply (wp receive_ipc_base_domain_sep_inv get_ntfn_wp | simp split: split_if option.splits)+
apply (wp receive_ipc_base_domain_sep_inv get_ntfn_wp | simp split: if_split option.splits)+
done
lemma send_fault_ipc_domain_sep_inv:
@ -1077,7 +1077,7 @@ lemma send_fault_ipc_domain_sep_inv:
apply(wp send_ipc_domain_sep_inv thread_set_valid_objs thread_set_tcb_fault_update_valid_mdb
thread_set_refs_trivial thread_set_obj_at_impossible
hoare_vcg_ex_lift
| wpc| simp add: Let_def split_def lookup_cap_def valid_tcb_fault_update split del: split_if)+
| wpc| simp add: Let_def split_def lookup_cap_def valid_tcb_fault_update split del: if_split)+
apply (wpe get_cap_inv[where P="domain_sep_inv irqs st and valid_objs and valid_mdb
and sym_refs o state_refs_of"])
apply (wp | simp)+
@ -1210,7 +1210,7 @@ lemma invoke_tcb_domain_sep_inv:
apply(case_tac tinv)
apply((wp restart_domain_sep_inv hoare_vcg_if_lift mapM_x_wp[OF _ subset_refl]
| wpc
| simp split del: split_if add: check_cap_at_def
| simp split del: if_split add: check_cap_at_def
| clarsimp)+)[3]
defer
apply((wp | simp )+)[2]
@ -1275,10 +1275,10 @@ lemma handle_invocation_domain_sep_inv:
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply (simp add: handle_invocation_def ts_Restart_case_helper split_def
liftE_liftM_liftME liftME_def bindE_assoc
split del: split_if)
split del: if_split)
apply(wp syscall_valid perform_invocation_domain_sep_inv
set_thread_state_runnable_valid_sched
| simp split del: split_if)+
| simp split del: if_split)+
apply(rule_tac E="\<lambda>ft. domain_sep_inv irqs st and
valid_objs and
sym_refs \<circ> state_refs_of and

86
proof/access-control/Dpolicy.thy
View File

@ -243,11 +243,11 @@ lemma transform_cslot_pre_onto:
"snd ptr < 2 ^ word_bits \<Longrightarrow> \<exists>ptr'. ptr = transform_cslot_ptr ptr'"
apply (rule_tac x="transform_cslot_ptr_rev ptr" in exI)
apply (case_tac ptr)
apply (clarsimp simp:transform_cslot_ptr_def transform_cslot_ptr_rev_def)
apply (clarsimp simp:nat_to_bl_def bin_bl_bin' bintrunc_mod2p)
apply (clarsimp simp: transform_cslot_ptr_def transform_cslot_ptr_rev_def)
apply (clarsimp simp: nat_to_bl_def bin_bl_bin' bintrunc_mod2p)
apply (subst int_mod_eq')
apply (clarsimp simp: not_le_imp_less)
apply (drule iffD2[OF zless_int])
apply (drule iffD2[OF of_nat_less_iff[where 'a=int]])
apply (clarsimp)
apply simp
done
@ -315,7 +315,7 @@ lemma caps_of_state_transform_opt_cap_rev:
apply (clarsimp simp:valid_objs_def dom_def)
apply (drule_tac x=a in spec, clarsimp)
apply (case_tac aa, simp_all add: object_slots_def caps_of_state_def2 nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
apply (clarsimp simp:valid_obj_def valid_cs_def valid_cs_size_def)
apply (clarsimp simp:transform_cnode_contents_def)
apply (rule_tac x=z in exI, simp)
@ -331,7 +331,7 @@ lemma caps_of_state_transform_opt_cap_rev:
apply (rule nat_to_bl_to_bin, simp+)
apply (drule valid_etcbs_tcb_etcb [rotated], fastforce)
apply clarsimp
apply (clarsimp simp:transform_tcb_def tcb_slot_defs split:split_if_asm)
apply (clarsimp simp:transform_tcb_def tcb_slot_defs split:if_split_asm)
apply (clarsimp simp: is_null_cap_def is_bound_ntfn_cap_def infer_tcb_bound_notification_def
split: option.splits)
apply (simp add:is_thread_state_cap_def infer_tcb_pending_op_def is_null_cap_def is_real_cap_def
@ -344,13 +344,13 @@ lemma caps_of_state_transform_opt_cap_rev:
apply (subst bl_to_bin_tcb_cnode_index_le0; simp)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj; simp)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:is_real_cap_def is_null_cap_def transform_asid_pool_entry_def
split:option.splits)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:is_real_cap_def is_null_cap_def transform_pte_def
split:ARM_A.pte.splits)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:is_real_cap_def is_null_cap_def transform_pde_def
split:ARM_A.pde.splits)
done
@ -371,7 +371,7 @@ lemma opt_cap_None_word_bits:
apply (drule invs_valid_objs)
apply (simp add:object_slots_def valid_objs_def)
apply (case_tac aa, simp_all add: nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
apply (clarsimp simp:transform_cnode_contents_def object_slots_def)
apply (drule_tac x=a in bspec)
apply (simp add:dom_def)+
@ -438,9 +438,9 @@ lemma thread_states_transform:
apply simp
apply (rule notI, drule invs_valid_idle, simp add:valid_idle_def pred_tcb_def2)
apply (simp add:infer_tcb_pending_op_def, case_tac "tcb_state a",
(simp add:split_if_asm| erule disjE)+)
(simp add:if_split_asm| erule disjE)+)
apply (simp add:infer_tcb_pending_op_def cdl_cap_auth_conferred_def,
case_tac "tcb_state a", (simp add:split_if_asm| erule disjE)+)
case_tac "tcb_state a", (simp add:if_split_asm| erule disjE)+)
done
lemma thread_bound_ntfns_transform:
@ -473,23 +473,23 @@ lemma thread_state_cap_transform_tcb:
apply (clarsimp simp: map_add_def object_slots_def)
apply (simp add:get_tcb_def object_slots_def)
apply (case_tac aa, simp_all add: nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
apply (clarsimp simp:transform_cnode_contents_def)
apply (case_tac z, simp_all add:is_thread_state_cap_def split:split_if_asm)
apply (case_tac z, simp_all add:is_thread_state_cap_def split:if_split_asm)
apply (rename_tac arch_cap)
apply (case_tac arch_cap; simp)
apply (clarsimp simp:transform_cnode_contents_def)
apply (case_tac z, simp_all add:is_thread_state_cap_def split:split_if_asm)
apply (case_tac z, simp_all add:is_thread_state_cap_def split:if_split_asm)
apply (rename_tac arch_cap)
apply (case_tac arch_cap; simp)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj; simp)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def transform_asid_pool_entry_def
split:split_if_asm option.splits)
split:if_split_asm option.splits)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def transform_pte_def
split:split_if_asm ARM_A.pte.splits)
split:if_split_asm ARM_A.pte.splits)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def transform_pde_def
split:split_if_asm ARM_A.pde.splits)
split:if_split_asm ARM_A.pde.splits)
done
@ -514,12 +514,12 @@ lemma thread_bound_ntfn_cap_transform_tcb:
apply (clarsimp simp:transform_cnode_contents_def)
apply (clarsimp simp:transform_cnode_contents_def)
apply (rename_tac arch_obj)
apply (case_tac arch_obj;clarsimp simp:transform_asid_pool_contents_def unat_map_def split:split_if_asm)
apply (case_tac arch_obj;clarsimp simp:transform_asid_pool_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:transform_asid_pool_entry_def is_bound_ntfn_cap_def split:option.splits)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def transform_pte_def is_bound_ntfn_cap_def
split:split_if_asm ARM_A.pte.splits)
split:if_split_asm ARM_A.pte.splits)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def transform_pde_def is_bound_ntfn_cap_def
split:split_if_asm ARM_A.pde.splits)
split:if_split_asm ARM_A.pde.splits)
done
@ -532,10 +532,10 @@ lemma thread_states_transform_rev:
apply (clarsimp simp:thread_states_def tcb_states_of_state_def)
apply (frule valid_etcbs_get_tcb_get_etcb[rotated], fastforce)
apply (frule_tac sl=b in opt_cap_tcb, assumption, simp)
apply (clarsimp split:split_if_asm)
apply (case_tac "aa tcb", simp_all add:is_thread_state_cap_def split:split_if_asm)
apply (clarsimp split:if_split_asm)
apply (case_tac "aa tcb", simp_all add:is_thread_state_cap_def split:if_split_asm)
apply (rename_tac arch_cap)
apply (case_tac "arch_cap", simp_all split:split_if_asm)
apply (case_tac "arch_cap", simp_all split:if_split_asm)
apply (case_tac "tcb_state tcb", auto simp:infer_tcb_pending_op_def cdl_cap_auth_conferred_def
infer_tcb_bound_notification_def split: option.splits)
done
@ -549,10 +549,10 @@ lemma thread_bound_ntfns_transform_rev:
apply (clarsimp simp:thread_bound_ntfns_def)
apply (frule valid_etcbs_get_tcb_get_etcb[rotated], fastforce)
apply (frule_tac sl=b in opt_cap_tcb, assumption, simp)
apply (clarsimp split:split_if_asm)
apply (case_tac "tcb"; simp add:is_thread_state_cap_def is_bound_ntfn_cap_def split:split_if_asm)
apply (clarsimp split:if_split_asm)
apply (case_tac "tcb"; simp add:is_thread_state_cap_def is_bound_ntfn_cap_def split:if_split_asm)
apply (rename_tac arch_cap)
apply (case_tac "arch_cap", simp_all split:split_if_asm)
apply (case_tac "arch_cap", simp_all split:if_split_asm)
apply (clarsimp simp: infer_tcb_pending_op_def split: Structures_A.thread_state.splits)
apply (case_tac "tcb_bound_notification tcb",
auto simp: infer_tcb_pending_op_def cdl_cap_auth_conferred_def
@ -704,16 +704,16 @@ lemma state_vrefs_transform_rev:
apply (clarsimp simp:state_vrefs_def transform_def transform_objects_def
opt_cap_def slots_of_def opt_object_def)
apply (case_tac aa, simp_all add: transform_object_def object_slots_def nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
apply (clarsimp simp:transform_cnode_contents_def is_real_cap_transform)
apply (clarsimp simp:transform_cnode_contents_def is_real_cap_transform)
apply (frule valid_etcbs_tcb_etcb [rotated], fastforce)
apply (clarsimp simp: transform_tcb_def is_real_cap_transform is_real_cap_infer_tcb_pending_op
is_real_cap_infer_tcb_bound_notification
split:split_if_asm)
split:if_split_asm)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add:vs_refs_no_global_pts_def graph_of_def)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:if_split_asm)
apply (rule exI)
apply (rename_tac "fun")
apply (case_tac "fun (of_nat b)")
@ -722,7 +722,7 @@ lemma state_vrefs_transform_rev:
apply (clarsimp simp:transform_asid_pool_entry_def cdl_cap_auth_conferred_def)
apply simp
apply (clarsimp simp:transform_asid_pool_entry_def)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:if_split_asm)
apply (rule exI)+
apply (drule pte_ref_transform_rev)
apply safe[1]
@ -730,7 +730,7 @@ lemma state_vrefs_transform_rev:
apply (rule_tac x="(ptr', auth)" in image_eqI)
apply simp
apply simp
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:if_split_asm)
apply (subgoal_tac "(of_nat b :: 12 word) < ucast (kernel_base >> 20)")
prefer 2
apply (subst word_not_le[symmetric])
@ -752,7 +752,7 @@ lemma cdl_cdt_transform_rev:
"\<lbrakk> invs s; cdl_cdt (transform s) slot' = Some slot \<rbrakk> \<Longrightarrow>
\<exists>ptr' ptr. slot' = transform_cslot_ptr ptr' \<and> slot = transform_cslot_ptr ptr \<and>
cdt s ptr' = Some ptr"
apply (clarsimp simp:cdt_transform map_lift_over_def split:split_if_asm)
apply (clarsimp simp:cdt_transform map_lift_over_def split:if_split_asm)
apply (rule_tac x=a in exI, rule_tac x=b in exI)
apply (subst (asm) inv_into_f_f)
apply (rule subset_inj_on)
@ -832,7 +832,7 @@ lemma state_objs_transform_rev:
apply simp
apply (subst (asm) untyped_range_transform[symmetric])
apply (simp add:is_untyped_cap_def transform_cap_def
split:cap.splits arch_cap.splits split_if_asm)
split:cap.splits arch_cap.splits if_split_asm)
apply simp
apply (simp add:cdl_cap_auth_conferred_def is_untyped_cap_def split:cdl_cap.splits)
apply clarsimp
@ -841,7 +841,7 @@ lemma state_objs_transform_rev:
apply simp
apply (subst (asm) obj_refs_transform[symmetric])
apply (simp add:is_untyped_cap_def transform_cap_def
split:cap.splits arch_cap.splits split_if_asm)
split:cap.splits arch_cap.splits if_split_asm)
apply simp
apply (simp add:cap_auth_conferred_transform)
apply (drule cdl_cdt_transform_rev [rotated], simp+)
@ -952,20 +952,20 @@ lemma opt_cap_Some_asid_real:
apply (case_tac "kheap s a")
apply (clarsimp simp: map_add_def object_slots_def)
apply (case_tac aa, simp_all add:object_slots_def valid_objs_def nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
apply (clarsimp simp:transform_cnode_contents_def is_real_cap_transform)
apply (clarsimp simp:transform_cnode_contents_def is_real_cap_transform)
apply (frule valid_etcbs_tcb_etcb[rotated], fastforce)
apply (clarsimp simp: transform_tcb_def tcb_slot_defs is_real_cap_infer_tcb_bound_notification
is_real_cap_transform is_real_cap_infer_tcb_pending_op
split: split_if_asm)
split: if_split_asm)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj; simp)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_asid_pool_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:transform_asid_pool_entry_def split:option.splits)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:transform_pte_def split:ARM_A.pte.splits)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:split_if_asm)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def split:if_split_asm)
apply (clarsimp simp:transform_pde_def split:ARM_A.pde.splits)
done
@ -994,11 +994,11 @@ lemma state_vrefs_asid_pool_transform_rev:
apply (drule bspec)
apply fastforce
apply (case_tac a, simp_all add:transform_object_def object_slots_def)
apply (clarsimp simp:obj_at_def a_type_def split:split_if_asm)+
apply (clarsimp simp:obj_at_def a_type_def split:if_split_asm)+
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj; simp add:vs_refs_no_global_pts_def graph_of_def)
apply (simp add:transform_asid_pool_contents_def unat_map_def transform_asid_low_bits_of
split:split_if_asm)
split:if_split_asm)
apply (rule_tac x="(ucast asid, cap_object pdcap)" in image_eqI)
apply (simp add:mask_asid_low_bits_ucast_ucast)
apply (clarsimp simp:transform_asid_pool_entry_def split:option.splits)
@ -1114,9 +1114,9 @@ proof -
apply (cases)
using e
apply (clarsimp simp: transform_def transform_objects_def restrict_map_def
split: split_if_asm Structures_A.kernel_object.splits)
split: if_split_asm Structures_A.kernel_object.splits)
apply (case_tac z, simp_all add: nat_split_conv_to_if
split: split_if_asm)
split: if_split_asm)
prefer 2
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj; simp)

4
proof/access-control/ExampleSystem.thy
View File

@ -519,7 +519,7 @@ lemma s1_caps_of_state :
apply (case_tac p, clarsimp)
apply (clarsimp split: if_splits)
apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def
split: split_if_asm)+
split: if_split_asm)+
apply (clarsimp simp: caps1_7_def split: if_splits)
apply (clarsimp simp: caps1_6_def cte_wp_at_cases split: if_splits)
done
@ -1089,7 +1089,7 @@ lemma "pas_refined Sys2PAS s2"
Sys2AgentMap_simps
Sys2AuthGraph_def Sys2AuthGraph_aux_def
complete_AuthGraph_def
split: split_if_asm)[1]
split: if_split_asm)[1]
apply (drule s2_caps_of_state, clarsimp)
apply (elim disjE, simp_all)[1]
apply (clarsimp simp: state_refs_of_def s2_def kh2_def kh2_obj_def

42
proof/access-control/Finalise_AC.thy
View File

@ -166,7 +166,7 @@ lemma sbn_pas_refined[wp]:
apply (clarsimp dest!: auth_graph_map_memD)
apply (erule state_bits_to_policy.cases)
apply (auto intro: state_bits_to_policy.intros auth_graph_map_memI
split: split_if_asm)
split: if_split_asm)
done
lemma unbind_notification_pas_refined[wp]:
@ -320,7 +320,7 @@ lemma fast_finalise_respects[wp]:
apply (wp unbind_maybe_notification_valid_objs get_ntfn_wp unbind_maybe_notification_respects
| wpc
| simp add: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def when_def
split: split_if_asm
split: if_split_asm
| fastforce)+
apply (clarsimp simp: obj_at_def valid_cap_def is_ntfn invs_def valid_state_def valid_pspace_def
split: option.splits)+
@ -440,7 +440,7 @@ lemma finalise_cap_respects[wp]:
apply ((wp unbind_maybe_notification_valid_objs get_ntfn_wp
unbind_maybe_notification_respects
| wpc
| simp add: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def split: split_if_asm
| simp add: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def split: if_split_asm
| fastforce)+)[3]
apply (clarsimp simp: obj_at_def valid_cap_def is_ntfn invs_def
valid_state_def valid_pspace_def
@ -455,18 +455,18 @@ lemma finalise_cap_respects[wp]:
| clarsimp simp: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def
unbind_maybe_notification_def
elim!: pas_refined_Control[symmetric]
| simp add: if_apply_def2 split del: split_if )+
| simp add: if_apply_def2 split del: if_split )+
apply (clarsimp simp: valid_cap_def pred_tcb_at_def obj_at_def is_tcb
dest!: tcb_at_ko_at)
apply (clarsimp split: option.splits elim!: pas_refined_Control[symmetric])
apply (frule bound_tcb_at_implies_reset, fastforce simp add: pred_tcb_at_def obj_at_def)
apply (drule pas_refined_Control, simp, simp)
(* other caps *)
apply (wp | simp add: if_apply_def2 split del: split_if
apply (wp | simp add: if_apply_def2 split del: if_split
| clarsimp simp: cap_auth_conferred_def cap_rights_to_auth_def is_cap_simps
pas_refined_all_auth_is_owns aag_cap_auth_def
deleting_irq_handler_def cap_links_irq_def invs_valid_objs
split del: split_if
split del: if_split
elim!: pas_refined_Control [symmetric])+
done
@ -502,16 +502,16 @@ lemma finalise_cap_auth':
finalise_cap cap final
\<lbrace>\<lambda>rv s. pas_cap_cur_auth aag (fst rv)\<rbrace>"
apply (rule hoare_gen_asm)
apply (cases cap, simp_all add: arch_finalise_cap_def split del: split_if)
apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split)
apply (wp
| simp add: comp_def hoare_post_taut [where P = \<top>] del: hoare_post_taut split del: split_if
| simp add: comp_def hoare_post_taut [where P = \<top>] del: hoare_post_taut split del: if_split
| fastforce simp: aag_cap_auth_Zombie aag_cap_auth_CNode aag_cap_auth_Thread
)+
apply (rule hoare_pre)
apply (wp | simp)+
apply (rule hoare_pre)
apply (wp | wpc
| simp add: comp_def hoare_post_taut [where P = \<top>] del: hoare_post_taut split del: split_if)+
| simp add: comp_def hoare_post_taut [where P = \<top>] del: hoare_post_taut split del: if_split)+
done
lemma finalise_cap_obj_refs:
@ -581,9 +581,9 @@ lemma rec_del_respects'_pre':
and einvs and simple_sched_action and valid_rec_del_call call and emptyable (slot_rdcall call)
and (\<lambda>s. \<not> exposed_rdcall call \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) (slot_rdcall call) s)
and K (is_subject aag (fst (slot_rdcall call)))
and K (case call of ReduceZombieCall cap sl exp \<Rightarrow> \<forall>x \<in> obj_refs cap. is_subject aag x | _ \<Rightarrow> True)\<rbrace>
and K (case call of ReduceZombieCall cap sl _ \<Rightarrow> \<forall>x \<in> obj_refs cap. is_subject aag x | _ \<Rightarrow> True)\<rbrace>
rec_del call
\<lbrace>\<lambda>rv. (\<lambda>s. trp \<longrightarrow> (case call of FinaliseSlotCall sl exp \<Rightarrow> (\<forall> irq. snd rv = Some irq \<longrightarrow> is_subject_irq aag irq) | _ \<Rightarrow> True) \<and> integrity aag X st s) and pas_refined aag\<rbrace>,\<lbrace>\<lambda>_. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>"
\<lbrace>\<lambda>rv. (\<lambda>s. trp \<longrightarrow> (case call of FinaliseSlotCall sl _ \<Rightarrow> (\<forall> irq. snd rv = Some irq \<longrightarrow> is_subject_irq aag irq) | _ \<Rightarrow> True) \<and> integrity aag X st s) and pas_refined aag\<rbrace>,\<lbrace>\<lambda>_. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>"
proof (induct arbitrary: st rule: rec_del.induct,
simp_all only: rec_del_fails)
case (1 slot exposed s)
@ -699,7 +699,7 @@ lemma rec_del_respects'_pre:
and einvs and simple_sched_action and valid_rec_del_call call and emptyable (slot_rdcall call)
and (\<lambda>s. \<not> exposed_rdcall call \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) (slot_rdcall call) s)
and K (is_subject aag (fst (slot_rdcall call)))
and K (case call of ReduceZombieCall cap sl exp \<Rightarrow> \<forall>x \<in> obj_refs cap. is_subject aag x | _ \<Rightarrow> True)\<rbrace>
and K (case call of ReduceZombieCall cap sl _ \<Rightarrow> \<forall>x \<in> obj_refs cap. is_subject aag x | _ \<Rightarrow> True)\<rbrace>
rec_del call
\<lbrace>\<lambda>rv. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>,\<lbrace>\<lambda>_. (\<lambda>s. trp \<longrightarrow> integrity aag X st s) and pas_refined aag\<rbrace>"
apply (rule spec_strengthen_postE[OF rec_del_respects'_pre'])
@ -789,7 +789,7 @@ lemma pas_refined_set_asid_table_empty_strg:
pas_refined aag (s\<lparr>arch_state := arch_state s \<lparr>arm_asid_table := (arm_asid_table (arch_state s))(base \<mapsto> pool)\<rparr>\<rparr>)"
apply (clarsimp simp: pas_refined_def state_objs_to_policy_def)
apply (erule state_asids_to_policy_aux.cases)
apply(simp_all split: split_if_asm)
apply(simp_all split: if_split_asm)
prefer 2
apply (clarsimp simp: state_vrefs_def obj_at_def vs_refs_no_global_pts_def)
apply (auto intro: state_asids_to_policy_aux.intros auth_graph_map_memI[OF sbta_vref] pas_refined_refl[simplified pas_refined_def state_objs_to_policy_def])[3]
@ -843,7 +843,7 @@ proof (induct rule: cap_revoke.induct[where ?a1.0=s])
apply (wp "1.hyps", assumption+)
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: split_if | wp_once hoare_vcg_const_imp_lift hoare_drop_imps)+
| simp split del: if_split | wp_once hoare_vcg_const_imp_lift hoare_drop_imps)+
apply (auto simp: emptyable_def dest: descendants_of_owned reply_slot_not_descendant)
done
qed
@ -882,14 +882,14 @@ lemma finalise_cap_caps_of_state_nullinv:
"\<lbrace>\<lambda>s. P (caps_of_state s) \<and> (\<forall>p. P (caps_of_state s(p \<mapsto> cap.NullCap)))\<rbrace>
finalise_cap cap final
\<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
apply (cases cap, simp_all split del: split_if)
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
hoare_vcg_all_lift hoare_drop_imps
| simp split del: split_if
| simp split del: if_split
| fastforce simp: fun_upd_def )+
apply (rule hoare_pre)
apply (wp deleting_irq_handler_caps_of_state_nullinv | clarsimp split del: split_if | fastforce simp: fun_upd_def)+
apply (wp deleting_irq_handler_caps_of_state_nullinv | clarsimp split del: if_split | fastforce simp: fun_upd_def)+
done
lemma finalise_cap_cte_wp_at_nullinv:
@ -903,8 +903,8 @@ lemma finalise_cap_cte_wp_at_nullinv:
lemma finalise_cap_fst_ret:
"\<lbrace>\<lambda>s. P cap.NullCap \<and> (\<forall>a b c. P (cap.Zombie a b c)) \<rbrace> finalise_cap cap is_final\<lbrace>\<lambda>rv s. P (fst rv)\<rbrace>"
apply (cases cap, simp_all add: arch_finalise_cap_def split del: split_if)
apply (wp | simp add: comp_def split del: split_if | fastforce)+
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)
apply (wp | simp | (rule hoare_pre, wpc))+
done
@ -914,7 +914,7 @@ lemma rec_del_preserves_cte_zombie_null:
assumes P_Zombie: "\<And>word x y. P (Zombie word x y)"
shows "s \<turnstile> \<lbrace>\<lambda>s. ((slot_rdcall call \<noteq> p \<or> exposed_rdcall call)
\<longrightarrow> cte_wp_at P p s)
\<and> (case call of ReduceZombieCall remove slot exp
\<and> (case call of ReduceZombieCall remove slot _
\<Rightarrow> cte_wp_at (op = remove) slot s | _ \<Rightarrow> True)\<rbrace>
rec_del call
\<lbrace>\<lambda>_ s. (slot_rdcall call \<noteq> p \<or> exposed_rdcall call)
@ -1057,7 +1057,7 @@ lemma invoke_cnode_pas_refined:
apply (wp cap_insert_pas_refined cap_delete_pas_refined cap_revoke_pas_refined
get_cap_wp
| wpc
| simp split del: split_if)+
| simp split del: if_split)+
apply (cases ci, simp_all add: authorised_cnode_inv_def
cnode_inv_auth_derivations_def integrity_def)
apply (clarsimp simp: cte_wp_at_caps_of_state pas_refined_refl cap_links_irq_def

4
proof/access-control/Interrupt_AC.thy
View File

@ -87,7 +87,7 @@ lemma decode_irq_control_invocation_authorised [wp]:
unfolding decode_irq_control_invocation_def authorised_irq_ctl_inv_def arch_check_irq_def
apply (rule hoare_gen_asmE)
apply (rule hoare_pre)
apply (simp add: Let_def split del: split_if cong: if_cong)
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)+
@ -105,7 +105,7 @@ lemma decode_irq_handler_invocation_authorised [wp]:
\<lbrace>\<lambda>x s. authorised_irq_hdl_inv aag x\<rbrace>, -"
unfolding decode_irq_handler_invocation_def authorised_irq_hdl_inv_def
apply (rule hoare_pre)
apply (simp add: Let_def split_def split del: split_if cong: if_cong)
apply (simp add: Let_def split_def split del: if_split cong: if_cong)
apply wp
apply (auto dest!: hd_in_set)
done

64
proof/access-control/Ipc_AC.thy
View File

@ -183,10 +183,10 @@ lemma dmo_storeWord_respects_ipc:
apply (simp add: storeWord_def)
apply (wp dmo_wp)
apply clarsimp
apply (simp add: integrity_def split del: split_if)
apply (clarsimp split del: split_if)
apply (simp add: integrity_def split del: if_split)
apply (clarsimp split del: if_split)
apply (case_tac "x \<in> ptr_range (buf + of_nat p * of_nat word_size) 2")
apply (clarsimp simp add: st_tcb_at_tcb_states_of_state split del: split_if)
apply (clarsimp simp add: st_tcb_at_tcb_states_of_state split del: if_split)
apply (rule trm_ipc [where p' = thread])
apply simp
apply assumption
@ -263,7 +263,7 @@ lemma lookup_ipc_buffer_has_auth [wp]:
apply simp
apply (drule (1) cap_auth_caps_of_state)
apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def vspace_cap_rights_to_auth_def
vm_read_write_def is_page_cap_def split: split_if_asm)
vm_read_write_def is_page_cap_def split: if_split_asm)
apply (drule bspec)
apply (erule (3) ipcframe_subset_page)
apply simp
@ -331,13 +331,13 @@ lemma set_mrs_respects_in_signalling':
apply (simp add: set_mrs_def split_def set_object_def)
apply (wp gets_the_wp get_wp put_wp
| wpc
| simp split del: split_if
| simp split del: if_split
add: zipWithM_x_mapM_x split_def store_word_offs_def fun_upd_def[symmetric])+
apply (rule hoare_post_imp [where Q = "\<lambda>rv. st_tcb_at (op = Structures_A.Running) thread and integrity aag X st"])
apply simp
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: split_if_asm)
split: if_split_asm)
apply wp
apply (rule impI)
apply (subgoal_tac "\<forall>c'. integrity aag X st
@ -382,7 +382,7 @@ lemma lookup_ipc_buffer_ptr_range:
apply (drule get_tcb_SomeD)+
apply (erule(1) valid_objsE)
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def case_bool_if
split: split_if_asm)
split: if_split_asm)
apply (erule integrity_obj.cases, simp_all add: get_tcb_def vm_read_write_def)
apply auto
done
@ -699,10 +699,10 @@ next
thus ?case
apply (cases m)
apply (clarsimp simp add: Let_def split_def whenE_def
cong: if_cong list.case_cong split del: split_if)
cong: if_cong list.case_cong split del: if_split)
apply (rule hoare_pre)
apply (wp eb [OF nN] hoare_vcg_const_imp_lift hoare_vcg_const_Ball_lift
| assumption | simp split del: split_if)+
| 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)
@ -721,7 +721,7 @@ next
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
split del: split_if)
split del: if_split)
apply (clarsimp simp: remove_rights_def caps_of_state_valid
neq_Nil_conv cte_wp_at_caps_of_state
imp_conjR[symmetric] cap_master_cap_masked_as_full
@ -817,7 +817,7 @@ lemma remove_rights_clas [simp]:
lemma remove_rights_cap_auth_conferred_subset:
"x \<in> cap_auth_conferred (remove_rights R cap) \<Longrightarrow> x \<in> cap_auth_conferred cap"
unfolding remove_rights_def cap_rights_update_def
apply (clarsimp split: split_if_asm cap.splits arch_cap.splits
apply (clarsimp split: if_split_asm cap.splits arch_cap.splits
simp: cap_auth_conferred_def vspace_cap_rights_to_auth_def acap_rights_update_def
validate_vm_rights_def vm_read_only_def vm_kernel_only_def)
apply (erule set_mp [OF cap_rights_to_auth_mono, rotated], clarsimp)+
@ -857,7 +857,7 @@ next
case (Cons c caps')
show ?case using Cons.prems
apply (cases c)
apply (simp split del: split_if cong: if_cong)
apply (simp split del: if_split cong: if_cong)
apply (rule hoare_pre)
apply (wp)
apply (elim conjE, erule subst, rule Cons.hyps)
@ -866,7 +866,7 @@ next
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: split_if add: if_apply_def2)+
| simp split del: if_split add: if_apply_def2)+
done
qed
@ -1018,7 +1018,7 @@ lemma send_ipc_pas_refined:
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:split_if)
apply (simp add: hoare_if_r_and split del:if_split)
apply (rename_tac list x xs recv_state)
apply (rule_tac Q="\<lambda>rv. pas_refined aag and K (can_grant \<longrightarrow> is_subject aag (hd list))"
in hoare_strengthen_post[rotated])
@ -1115,7 +1115,7 @@ lemma receive_ipc_base_pas_refined:
apply (clarsimp simp: thread_get_def cong: endpoint.case_cong)
apply (rule hoare_pre)
apply (wp static_imp_wp set_thread_state_pas_refined get_endpoint_wp
| wpc | simp add: thread_get_def do_nbrecv_failed_transfer_def split del: split_if)+
| wpc | simp add: thread_get_def do_nbrecv_failed_transfer_def split del: if_split)+
apply (simp add:aag_cap_auth_def clas_no_asid cli_no_irqs)
apply (rename_tac list sss data)
apply (rule_tac Q="\<lambda>rv s. pas_refined aag s \<and> (sender_can_grant data \<longrightarrow> is_subject aag (hd list))"
@ -1254,7 +1254,7 @@ lemma copy_mrs_integrity_autarch:
store_word_offs_integrity_autarch [where aag = aag and thread = receiver]
| wpc
| simp
| fastforce simp: length_msg_registers msg_align_bits split: split_if_asm)+
| fastforce simp: length_msg_registers msg_align_bits split: if_split_asm)+
done
(* FIXME: Why was the [wp] attribute clobbered by interpretation of the Arch locale? *)
@ -1520,7 +1520,7 @@ lemma auth_ipc_buffers_mem_Write:
apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def
vspace_cap_rights_to_auth_def vm_read_write_def
is_page_cap_def
split: split_if_asm)
split: if_split_asm)
apply (auto dest: ipcframe_subset_page)
done
@ -1550,7 +1550,7 @@ lemma integrity_tcb_in_ipc_final:
apply (simp add: tcb_states_of_state_def get_tcb_def)
apply (simp add: tcb_states_of_state_def get_tcb_def)
apply (simp add: auth_ipc_buffers_def get_tcb_def
split: option.split_asm cap.split_asm arch_cap.split_asm split_if_asm split del: split_if)
split: option.split_asm cap.split_asm arch_cap.split_asm if_split_asm split del: if_split)
apply simp
done
@ -1594,7 +1594,7 @@ lemma as_user_respects_in_ipc:
apply (simp add: as_user_def set_object_def)
apply (wp gets_the_wp get_wp put_wp mapM_x_wp'
| wpc
| simp split del: split_if add: zipWithM_x_mapM_x split_def store_word_offs_def)+
| simp split del: if_split add: zipWithM_x_mapM_x split_def store_word_offs_def)+
apply (clarsimp simp: st_tcb_def2 tcb_at_def fun_upd_def[symmetric])
apply (auto elim: update_tcb_context_in_ipc)
done
@ -1681,7 +1681,7 @@ lemma set_original_respects_in_ipc_autarch:
apply (clarsimp simp: integrity_tcb_in_ipc_def)
apply (simp add: integrity_def
tcb_states_of_state_def get_tcb_def map_option_def
split del: split_if cong: if_cong)
split del: if_split cong: if_cong)
apply simp
apply (clarsimp simp: integrity_cdt_def)
done
@ -1695,7 +1695,7 @@ lemma update_cdt_fun_upd_respects_in_ipc_autarch:
apply wp
apply (clarsimp simp: integrity_tcb_in_ipc_def integrity_def
tcb_states_of_state_def get_tcb_def
split del: split_if cong: if_cong)
split del: if_split cong: if_cong)
apply simp
apply (clarsimp simp add: integrity_cdt_def)
done
@ -1721,13 +1721,13 @@ lemma cap_insert_ext_integrity_in_ipc:
src_slot dest_slot src_p dest_p)
\<lbrace>\<lambda>yd. integrity_tcb_in_ipc aag X receiver epptr ctxt st\<rbrace>"
apply (rule hoare_gen_asm)+
apply (simp add: integrity_tcb_in_ipc_def split del: split_if)
apply (simp add: integrity_tcb_in_ipc_def split del: if_split)
apply (unfold integrity_def)
apply (simp only: integrity_cdt_list_as_list_integ)
apply (rule hoare_lift_Pf[where f="ekheap"])
apply (clarsimp simp: integrity_tcb_in_ipc_def integrity_def
tcb_states_of_state_def get_tcb_def
split del: split_if cong: if_cong)
split del: if_split cong: if_cong)
apply wp
apply (rule hoare_vcg_conj_lift)
apply (simp add: list_integ_def del: split_paired_All)
@ -1748,7 +1748,7 @@ lemma cap_inserintegrity_in_ipc_autarch:
update_cdt_fun_upd_respects_in_ipc_autarch
set_cap_respects_in_ipc_autarch get_cap_wp
cap_insert_ext_integrity_in_ipc
| simp split del: split_if)+
| simp split del: if_split)+
done
lemma transfer_caps_loop_respects_in_ipc_autarch:
@ -1812,7 +1812,7 @@ lemma copy_mrs_respects_in_ipc:
mapM_wp'
hoare_vcg_const_imp_lift hoare_vcg_all_lift
| wpc
| fastforce split: split_if_asm simp: length_msg_registers)+
| fastforce split: if_split_asm simp: length_msg_registers)+
done
lemma do_normal_transfer_respects_in_ipc:
@ -1849,9 +1849,9 @@ lemma set_mrs_respects_in_ipc:
apply (simp add: set_mrs_def set_object_def)
apply (wp mapM_x_wp' store_word_offs_respects_in_ipc
| wpc
| simp split del: split_if add: zipWithM_x_mapM_x split_def)+
| simp split del: if_split add: zipWithM_x_mapM_x split_def)+
apply (clarsimp simp add: set_zip nth_append simp: msg_align_bits msg_max_length_def
split: split_if_asm)
split: if_split_asm)
apply (simp add: length_msg_registers)
apply arith
apply simp
@ -1886,7 +1886,7 @@ lemma lookup_ipc_buffer_ptr_range_in_ipc:
apply (drule get_tcb_SomeD)
apply (erule(1) valid_objsE)
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def case_bool_if
split: split_if_asm)
split: if_split_asm)
apply (erule tcb_in_ipc.cases, simp_all)
apply (clarsimp simp: get_tcb_def vm_read_write_def)
apply (clarsimp simp: get_tcb_def vm_read_write_def)
@ -2039,7 +2039,7 @@ lemma send_ipc_integrity_autarch:
apply simp+
apply (wp set_thread_state_integrity_autarch thread_get_wp' do_ipc_transfer_integrity_autarch
hoare_vcg_all_lift hoare_drop_imps set_endpoinintegrity
| wpc | simp add: get_thread_state_def split del: split_if
| wpc | simp add: get_thread_state_def split del: if_split
del: hoare_post_taut hoare_True_E_R)+
apply clarsimp
apply (intro conjI)
@ -2139,7 +2139,7 @@ lemma send_fault_ipc_pas_refined:
hoare_vcg_conj_lift hoare_vcg_ex_lift hoare_vcg_all_lift
| wpc
| rule hoare_drop_imps
| simp add: split_def del: split_if)+
| simp add: split_def del: if_split)+
apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s
\<and> is_subject aag (cur_thread s)
\<and> valid_objs s \<and> sym_refs (state_refs_of s)
@ -2281,7 +2281,7 @@ lemma do_reply_transfer_pas_refined:
apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined
thread_set_pas_refined_triv K_valid
| wpc
| simp add: thread_get_def split del: split_if)+
| simp add: thread_get_def split del: if_split)+
(* otherwise simp does too much *)
apply (rule hoare_strengthen_post, rule gts_inv)
apply (rule impI)
@ -2303,7 +2303,7 @@ lemma do_reply_transfer_respects:
do_ipc_transfer_integrity_autarch do_ipc_transfer_pas_refined
thread_set_integrity_autarch
handle_fault_reply_respects
| wpc | simp split del: split_if)+
| wpc | simp split del: if_split)+
apply (clarsimp simp: tcb_at_def invs_mdb invs_valid_objs)
done

24
proof/access-control/Retype_AC.thy
View File

@ -237,7 +237,7 @@ lemma init_arch_objects_integrity:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply(rule hoare_gen_asm)+
apply(cases new_type)
apply(simp_all add: init_arch_objects_def split del: split_if)
apply(simp_all add: init_arch_objects_def split del: if_split)
apply(rule hoare_pre)
apply(wpc
| wp mapM_x_wp[OF _ subset_refl]
@ -334,21 +334,21 @@ lemma sta_detype:
"state_objs_to_policy (detype R s) \<subseteq> state_objs_to_policy s"
apply (clarsimp simp add: state_objs_to_policy_def state_refs_of_detype)
apply (erule state_bits_to_policy.induct)
apply (auto intro: state_bits_to_policy.intros split: split_if_asm)
apply (auto intro: state_bits_to_policy.intros split: if_split_asm)
done
lemma sita_detype:
"state_irqs_to_policy aag (detype R s) \<subseteq> state_irqs_to_policy aag s"
apply (clarsimp)
apply (erule state_irqs_to_policy_aux.induct)
apply (auto simp: detype_def intro: state_irqs_to_policy_aux.intros split: split_if_asm)
apply (auto simp: detype_def intro: state_irqs_to_policy_aux.intros split: if_split_asm)
done
lemma sata_detype:
"state_asids_to_policy aag (detype R s) \<subseteq> state_asids_to_policy aag s"
apply (clarsimp)
apply (erule state_asids_to_policy_aux.induct)
apply (auto intro: state_asids_to_policy_aux.intros split: split_if_asm)
apply (auto intro: state_asids_to_policy_aux.intros split: if_split_asm)
done
(* FIXME: move *)
@ -760,7 +760,7 @@ lemma use_retype_region_proofs_ext':
\<and> caps_no_overlap ptr sz s \<and> pspace_no_overlap_range_cover ptr sz s
\<and> (\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) \<and>
P s \<and> R (retype_addrs ptr ty n us) s\<rbrace> retype_region ptr n us ty dev \<lbrace>Q\<rbrace>"
apply (simp add: retype_region_def split del: split_if)
apply (simp add: retype_region_def split del: if_split)
apply (rule hoare_pre, (wp|simp)+)
apply (rule retype_region_ext_kheap_update[OF y])
apply (wp|simp)+
@ -796,7 +796,7 @@ lemma retype_region_ext_pas_refined:
apply (simp add: retype_region_ext_def, wp)
apply (clarsimp simp: tcb_domain_map_wellformed_aux_def)
apply (erule domains_of_state_aux.cases)
apply (clarsimp simp: foldr_upd_app_if' fun_upd_def[symmetric] split: split_if_asm)
apply (clarsimp simp: foldr_upd_app_if' fun_upd_def[symmetric] split: if_split_asm)
apply (clarsimp simp: default_ext_def default_etcb_def split: apiobject_type.splits)
defer
apply (force intro: domtcbs)
@ -1017,7 +1017,7 @@ lemma descendants_range_in_detype:
apply(simp add: descendants_range_in_def)
apply(rule ballI)
apply(drule_tac x=p' in bspec, assumption)
apply(clarsimp simp: null_filter_def split: split_if_asm)
apply(clarsimp simp: null_filter_def split: if_split_asm)
apply(rule conjI)
apply(simp add: cte_wp_at_caps_of_state)
apply(rule_tac t=a in ssubst[OF fst_conv[symmetric]])
@ -1376,7 +1376,7 @@ lemma invoke_untyped_pas_refined:
apply (clarsimp simp: retype_addrs_aligned_range_cover
cte_wp_at_caps_of_state)
apply (drule valid_global_refsD[rotated 2])
apply (clarsimp simp: post_retype_invs_def split: split_if_asm)
apply (clarsimp simp: post_retype_invs_def split: if_split_asm)
apply (erule caps_of_state_cteD)
apply (erule notE, erule subsetD[rotated])
apply (rule order_trans, erule retype_addrs_subset_ptr_bits)
@ -1400,9 +1400,9 @@ lemma invoke_untyped_pas_refined:
subsection{* decode *}
lemma data_to_obj_type_ret_not_asid_pool:
"\<lbrace> \<top> \<rbrace> data_to_obj_type arg \<lbrace> \<lambda>r s. r \<noteq> ArchObject ASIDPoolObj \<rbrace>,-"
"\<lbrace> \<top> \<rbrace> data_to_obj_type v \<lbrace> \<lambda>r s. r \<noteq> ArchObject ASIDPoolObj \<rbrace>,-"
apply(clarsimp simp: validE_R_def validE_def valid_def)
apply(auto simp: data_to_obj_type_def arch_data_to_obj_type_def throwError_def simp: returnOk_def bindE_def return_def bind_def lift_def split: split_if_asm)
apply(auto simp: data_to_obj_type_def arch_data_to_obj_type_def throwError_def simp: returnOk_def bindE_def return_def bind_def lift_def split: if_split_asm)
done
crunch inv[wp]: data_to_obj_type "P"
@ -1462,11 +1462,11 @@ lemma decode_untyped_invocation_authorised:
apply(wp dui_inv_wf | simp)+
apply (clarsimp simp: decode_untyped_invocation_def split_def
authorised_untyped_inv'_def
split del: split_if split: untyped_invocation.splits)
split del: if_split split: untyped_invocation.splits)
(* need to hoist the is_cnode_cap assumption into postcondition later on *)
apply (simp add: unlessE_def[symmetric] whenE_def[symmetric] unlessE_whenE
split del: split_if)
split del: if_split)
apply (wp whenE_throwError_wp hoare_vcg_all_lift mapME_x_inv_wp
| simp split: untyped_invocation.splits
| (auto)[1])+

24
proof/access-control/Syscall_AC.thy
View File

@ -100,7 +100,7 @@ lemma perform_invocation_respects:
| wp_once hoare_pre_cont)+
apply (clarsimp simp: authorised_invocation_def split: Invocations_A.invocation.splits)
-- "EP case"
apply (fastforce simp: obj_at_def is_tcb split: split_if_asm)
apply (fastforce simp: obj_at_def is_tcb split: if_split_asm)
-- "NTFN case"
apply fastforce
done
@ -157,7 +157,7 @@ lemma decode_invocation_authorised:
decode_arch_invocation_authorised
| strengthen cnode_diminished_strg
| wpc | simp add: comp_def authorised_invocation_def decode_invocation_def
split del: split_if del: hoare_post_taut hoare_True_E_R
split del: if_split del: hoare_post_taut hoare_True_E_R
| wp_once hoare_FalseE_R)+
apply (clarsimp simp: aag_has_Control_iff_owns split_def aag_cap_auth_def)
@ -312,7 +312,7 @@ lemma handle_invocation_pas_refined:
hoare_vcg_conj_lift hoare_vcg_all_lift
| wpc
| rule hoare_drop_imps
| simp add: if_apply_def2 conj_comms split del: split_if
| simp add: if_apply_def2 conj_comms split del: if_split
del: hoare_True_E_R)+),
((wp lookup_extra_caps_auth lookup_extra_caps_authorised
decode_invocation_authorised
@ -320,7 +320,7 @@ lemma handle_invocation_pas_refined:
lookup_cap_and_slot_cur_auth
as_user_pas_refined
lookup_cap_and_slot_valid_fault3
| simp add: split comp_def runnable_eq_active del: split_if)+),
| simp add: split comp_def runnable_eq_active del: if_split)+),
(auto intro: guarded_to_cur_domain simp: ct_in_state_def st_tcb_at_def intro: if_live_then_nonz_capD)[1])+
done
@ -340,8 +340,8 @@ lemma handle_invocation_respects:
| rule hoare_drop_imps
| wpc | simp add: if_apply_def2
del: hoare_post_taut hoare_True_E_R
split del: split_if)+
apply (simp add: conj_comms pred_conj_def comp_def if_apply_def2 split del: split_if
split del: if_split)+
apply (simp add: conj_comms pred_conj_def comp_def if_apply_def2 split del: if_split
| wp perform_invocation_respects set_thread_state_pas_refined
set_thread_state_authorised
set_thread_state_runnable_valid_sched
@ -449,7 +449,7 @@ lemma ethread_set_time_slice_pas_refined[wp]:
apply (erule_tac x="(a, b)" in ballE)
apply force
apply (erule notE)
apply (erule domains_of_state_aux.cases, simp add: get_etcb_def split: split_if_asm)
apply (erule domains_of_state_aux.cases, simp add: get_etcb_def split: if_split_asm)
apply (force intro: domtcbs)+
done
@ -495,7 +495,7 @@ lemma timer_tick_integrity[wp]:
\<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
apply (simp add: timer_tick_def)
apply (wp ethread_set_integrity_autarch gts_wp
| wpc | simp add: thread_set_time_slice_def split del: split_if)+
| wpc | simp add: thread_set_time_slice_def split del: if_split)+
apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def)
done
@ -539,7 +539,7 @@ lemma handle_interrupt_integrity:
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (rule_tac s = s in hacky_ipc_Send [where irq = irq])
apply (drule (1) cap_auth_caps_of_state)
apply (clarsimp simp: aag_cap_auth_def is_cap_simps cap_auth_conferred_def cap_rights_to_auth_def split: split_if_asm)
apply (clarsimp simp: aag_cap_auth_def is_cap_simps cap_auth_conferred_def cap_rights_to_auth_def split: if_split_asm)
apply assumption+
done
@ -1557,7 +1557,7 @@ crunch cur_thread[wp]: cancel_badged_sends "\<lambda>s. P (cur_thread s)" (wp: c
lemma invoke_cnode_cur_thread[wp]: "\<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (cur_thread s)\<rbrace>"
apply (simp add: invoke_cnode_def)
apply (rule hoare_pre)
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: split_if)+
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: if_split)+
done
crunch cur_thread[wp]: handle_event "\<lambda>s. P (cur_thread s)"
@ -1603,7 +1603,7 @@ lemma cap_revoke_idle_thread[wp]:"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace
lemma invoke_cnode_idle_thread[wp]: "\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (simp add: invoke_cnode_def)
apply (rule hoare_pre)
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: split_if)+
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: if_split)+
done
crunch idle_thread[wp]: handle_event "\<lambda>s::det_state. P (idle_thread s)"
@ -1619,7 +1619,7 @@ crunch cur_domain[wp]: transfer_caps_loop, ethread_set, thread_set_priority, se
lemma invoke_cnode_cur_domain[wp]: "\<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (cur_domain s)\<rbrace>"
apply (simp add: invoke_cnode_def)
apply (rule hoare_pre)
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: split_if)+
apply (wp hoare_drop_imps hoare_vcg_all_lift | wpc | simp add: without_preemption_def split del: if_split)+
done
crunch cur_domain[wp]: handle_event "\<lambda>s. P (cur_domain s)" (wp: syscall_valid select_wp crunch_wps check_cap_inv cap_revoke_preservation simp: crunch_simps filterM_mapM unless_def ignore: without_preemption check_cap_at filterM getActiveIRQ resetTimer ackInterrupt const_on_failure getFAR getDFSR getIFSR)

16
proof/access-control/Tcb_AC.thy
View File

@ -176,7 +176,7 @@ lemma set_priority_pas_refined[wp]:
apply (erule_tac x="(a, b)" in ballE)
apply simp
apply (erule domains_of_state_aux.cases)
apply (force intro: domtcbs split: split_if_asm)
apply (force intro: domtcbs split: if_split_asm)
done
lemma gts_test[wp]: "\<lbrace>\<top>\<rbrace> get_thread_state t \<lbrace>\<lambda>rv s. test rv = st_tcb_at test t s\<rbrace>"
@ -360,7 +360,7 @@ lemma invoke_tcb_respects:
apply (cases ti, simp_all add: hoare_conjD1 [OF invoke_tcb_tc_respects_aag [simplified simp_thms]]
del: invoke_tcb.simps Tcb_AI.tcb_inv_wf.simps K_def)
apply (safe intro!: hoare_gen_asm)
apply ((wp itr_wps mapM_x_wp' | simp add: if_apply_def2 split del: split_if
apply ((wp itr_wps mapM_x_wp' | simp add: if_apply_def2 split del: if_split
| wpc | clarsimp simp: authorised_tcb_inv_def
| rule conjI | subst(asm) idle_no_ex_cap)+)
done
@ -436,9 +436,9 @@ lemma decode_set_ipc_buffer_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>, -"
unfolding decode_set_ipc_buffer_def authorised_tcb_inv_def
apply (cases "excaps ! 0")
apply (clarsimp cong: list.case_cong split del: split_if)
apply (clarsimp cong: list.case_cong split del: if_split)
apply (rule hoare_pre)
apply (clarsimp simp: ball_Un aag_cap_auth_def split del: split_if split add: prod.split
apply (clarsimp simp: ball_Un aag_cap_auth_def split del: if_split split: prod.split
| strengthen stupid_strg
| wp_once derive_cap_obj_refs_auth derive_cap_untyped_range_subset derive_cap_clas derive_cap_cli
hoare_vcg_all_lift_R whenE_throwError_wp slot_long_running_inv
@ -454,8 +454,8 @@ lemma decode_set_space_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>, -"
unfolding decode_set_space_def authorised_tcb_inv_def
apply (rule hoare_pre)
apply (simp cong: list.case_cong split del: split_if)
apply (clarsimp simp: ball_Un split del: split_if
apply (simp cong: list.case_cong split del: if_split)
apply (clarsimp simp: ball_Un split del: if_split
| wp_once derive_cap_obj_refs_auth derive_cap_untyped_range_subset derive_cap_clas derive_cap_cli
hoare_vcg_const_imp_lift_R hoare_vcg_all_lift_R whenE_throwError_wp slot_long_running_inv)+
apply (clarsimp simp: not_less all_set_conv_all_nth dest!: P_0_1_spec)
@ -475,10 +475,10 @@ lemma decode_set_space_authorised':
apply (cases set_param)
apply (simp_all add: is_thread_control_def decode_set_space_def authorised_tcb_inv_def
cong: list.case_cong option.case_cong prod.case_cong
split: prod.split_asm split del: split_if)
split: prod.split_asm split del: if_split)
apply (cases "excaps!0")
apply (cases "excaps!Suc 0")
apply (clarsimp simp: ball_Un split del: split_if split add: prod.split
apply (clarsimp simp: ball_Un split del: if_split split: prod.split
| strengthen stupid_strg
| wp_once derive_cap_obj_refs_auth derive_cap_untyped_range_subset derive_cap_clas derive_cap_cli
hoare_vcg_all_lift_R whenE_throwError_wp slot_long_running_inv)+

70
proof/asmrefine/SEL4GlobalsSwap.thy
View File

@ -11,11 +11,14 @@
theory SEL4GlobalsSwap
imports "../../tools/asmrefine/GlobalsSwap"
"../../tools/asmrefine/AsmSemanticsRespects"
"../../tools/asmrefine/FieldAccessors"
"../../spec/cspec/Substitute"
begin
declare Char_eq_Char_iff [simp del]
lemma globals_update_id:
"globals_update id = id"
by (rule ext, simp)
@ -38,17 +41,23 @@ locale graph_refine_locale = kernel_all_substitute
"globals_list_distinct domain symbol_table globals_list"
assumes globals_list_ok:
"\<forall>g \<in> set globals_list. global_data_ok symbol_table g"
assumes asm_semantics_respects:
"asm_ops_are_swap t_hrs_' t_hrs_'_update
phantom_machine_state_' phantom_machine_state_'_update
symbol_table (\<lambda>s. (ghost'state_' s, hrs_htd (t_hrs_' s))) globals_list"
begin
lemmas globals_list_def = kernel_all_global_addresses.global_data_list_def
lemmas global_data_defs = kernel_all_global_addresses.global_data_defs
declare asm_semantics_respects[unfolded Let_def, simp]
lemma globals_list_valid:
"globals_list_valid symbol_table t_hrs_' t_hrs_'_update globals_list"
apply (rule globals_list_valid_optimisation[OF _ _ globals_list_ok])
apply (simp_all add: globals_list_def globals_list_valid_def
global_data_defs
del: distinct_prop.simps split del: split_if)
del: distinct_prop.simps split del: if_split)
apply (simp add: global_data_swappable_def global_data_def)
apply (simp_all add: global_data_valid)
apply (simp_all add: global_data_valid_def addressed_global_data_def
@ -62,17 +71,44 @@ lemma global_acc_valid:
abbreviation "gswap == globals_swap t_hrs_' t_hrs_'_update symbol_table globals_list"
lemma globals_swap_twice:
"globals_list_distinct D symbol_table globals_list
\<Longrightarrow> gswap (gswap gs) = gs"
by (intro globals_swap_twice_helper globals_list_valid global_acc_valid)
lemma globals_swap_ex_swap:
"\<forall>x \<in> set gxs. is_global_data x \<longrightarrow> (case x of GlobalData nm sz tg g' s'
\<Rightarrow> (\<forall>v v' gs. s' v (s v' gs) = s v' (s' v gs))
\<and> (\<forall>v gs. g' (s v gs) = g' gs)
\<and> (\<forall>v gs. g (s' v gs) = g gs))
\<Longrightarrow> (\<forall>v v' gs. th_s v (s v' gs) = s v' (th_s v gs))
\<and> (\<forall>v gs. g (th_s v gs) = g gs)
\<and> (\<forall>v gs. th_g (s v gs) = th_g gs)
\<Longrightarrow> g (globals_swap th_g th_s symt gxs gs) = g gs
\<and> globals_swap th_g th_s symt gxs (s v gs) = s v (globals_swap th_g th_s symt gxs gs)"
apply (simp add: globals_swap_def)
apply (rule conjI)
apply (rule foldr_does_nothing_to_xf)
apply (drule(1) bspec)
apply (case_tac x, simp_all add: global_swap_def is_global_data_def K_def)
apply (rule foldr_update_commutes[symmetric])
apply (drule(1) bspec)
apply (case_tac x, simp_all add: global_swap_def is_global_data_def K_def)
done
lemma ghost'state_update_globals_swap:
"gswap (ghost'state_'_update f gs) = ghost'state_'_update f (gswap gs)"
apply (simp add: globals_swap_def)
apply (rule foldr_update_commutes[symmetric])
apply (auto simp: globals_list_def global_data_defs global_swap_def
global_data_def const_global_data_def addressed_global_data_def)
"ghost'state_' (gswap gs) = ghost'state_' gs
\<and> gswap (ghost'state_'_update f gs) = ghost'state_'_update f (gswap gs)"
apply (rule globals_swap_ex_swap)
apply (simp only: globals_list_def global_data_defs list.simps ball_simps
is_global_data_simps simp_thms)
apply (simp add: global_data_def)
apply simp
done
lemma phantom_machine_state_'_update_globals_swap[simp]:
"phantom_machine_state_' (gswap gs) = phantom_machine_state_' gs
\<and> gswap (phantom_machine_state_'_update f gs) = phantom_machine_state_'_update f (gswap gs)"
apply (rule globals_swap_ex_swap)
apply (simp only: globals_list_def global_data_defs list.simps ball_simps
is_global_data_simps simp_thms)
apply (simp add: global_data_def)
apply simp
done
(* FIXME: this has to be done and should be standardised *)
@ -80,6 +116,20 @@ lemma t_hrs_ghost'state_update_globals_swap[simp]:
"t_hrs_' (gswap (ghost'state_'_update f gs)) = t_hrs_' (gswap gs)"
by (simp add: ghost'state_update_globals_swap)
lemma t_hrs_phantom_machine_state_'_update_globals_swap[simp]:
"t_hrs_' (gswap (phantom_machine_state_'_update f gs)) = t_hrs_' (gswap gs)"
by (simp add: phantom_machine_state_'_update_globals_swap)
lemma globals_swap_twice[simp]:
"gswap (gswap gs) = gs"
by (metis globals_swap_twice_helper globals_list_distinct
globals_list_valid global_acc_valid)
lemma t_hrs_'_update_hmu_triv[simp]:
"f (hrs_mem (t_hrs_' gs)) = hrs_mem (t_hrs_' gs)
\<Longrightarrow> t_hrs_'_update (hrs_mem_update f) gs = gs"
by (cases gs, auto simp add: hrs_mem_update_def hrs_mem_def)
end
end

3
proof/asmrefine/SEL4GraphRefine.thy
View File

@ -16,7 +16,8 @@ imports
"SEL4SimplExport"
begin
declare ptr_add_assertion_uint[simp del]
declare Char_eq_Char_iff [simp del]
declare ptr_add_assertion_uint [simp del]
ML {*
val funs = ParseGraph.funs @{theory} "CFunDump.txt"

2
proof/asmrefine/SEL4SimplExport.thy
View File

@ -16,6 +16,8 @@ imports
begin
declare Char_eq_Char_iff [simp del]
ML {*
val csenv = let
val the_csenv = CalculateState.get_csenv @{theory} "c/kernel_all.c_pp" |> the

47
proof/asmrefine/TestGraphRefine.thy
View File

@ -53,10 +53,20 @@ where
(hrs_mem (t_hrs_' (globals s)))
\<and> htd_safe domain (hrs_htd (t_hrs_' (globals s)))}"
ML {* ProveSimplToGraphGoals.test_all_graph_refine_proofs_after
funs (csenv ()) @{context} (SOME "Kernel_C.lookupPTSlot") *}
abbreviation(input) "ghost_assns_from_globals
\<equiv> (snd o snd o ghost'state_' :: globals \<Rightarrow> _)"
ML {* val nm = "Kernel_C.lookupPTSlot" *}
lemma snd_snd_gs_new_frames_new_cnodes[simp]:
"snd (snd (gs_new_frames sz ptr bits gs)) = snd (snd gs)"
"snd (snd (gs_new_cnodes sz' ptr bits gs)) = snd (snd gs)"
"snd (snd (gs_clear_region ptr sz' gs)) = snd (snd gs)"
"snd (snd ((if P then f else g) gs)) = (if P then snd (snd (f gs)) else snd (snd (g gs)))"
by (simp_all add: gs_new_frames_def gs_new_cnodes_def gs_clear_region_def)
(* ML {* ProveSimplToGraphGoals.test_all_graph_refine_proofs_after
funs (csenv ()) @{context} NONE *} *)
ML {* val nm = "Kernel_C.idle_thread" *}
local_setup {* define_graph_fun_short funs nm *}
@ -69,6 +79,8 @@ val init_thm = SimplToGraphProof.simpl_to_graph_upto_subgoals funs hints nm
@{context}
*}
declare [[show_types]]
ML {*
ProveSimplToGraphGoals.simpl_to_graph_thm funs (csenv ()) @{context} nm;
*}
@ -80,32 +92,15 @@ val full_tac = ProveSimplToGraphGoals.graph_refine_proof_full_tac
(csenv ())
val full_goal_tac = ProveSimplToGraphGoals.graph_refine_proof_full_goal_tac
(csenv ())
val debug_tac = ProveSimplToGraphGoals.debug_tac
(csenv ())
*}
schematic_lemma "PROP ?P"
apply (tactic {* rtac init_thm 1 *})
apply (tactic {* ALLGOALS (fn i => fn t =>
let val res = try ((full_goal_tac @{context} THEN_ALL_NEW K no_tac) i #> Seq.hd) t
in case res of NONE => Seq.single t | SOME r => Seq.single r
end) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 0) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 1) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 2) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 3) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 4) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 5) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 6) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 7) *})
apply (tactic {* ALLGOALS (nth (tacs @{context}) 8) *})
schematic_goal "PROP ?P"
apply (tactic {* resolve_tac @{context} [init_thm] 1 *})
apply (tactic {* ALLGOALS (debug_tac @{context}) *})
oops
end

4
proof/bisim/Separation.thy
View File

@ -8,7 +8,7 @@
* @TAG(NICTA_GPL)
*)
header "Restricted capabilities in the Separation Kernel Abstract Specification"
chapter "Restricted capabilities in the Separation Kernel Abstract Specification"
theory Separation
imports
@ -93,7 +93,7 @@ lemma separate_cnode_cap_rab:
(throwError (GuardMismatch (length cref) guard))
| _ \<Rightarrow> throwError InvalidRoot)"
unfolding separate_cnode_cap_def resolve_address_bits_def
by (auto simp: word_bits_def split: cap.split_asm split_if)
by (auto simp: word_bits_def split: cap.split_asm)
definition
"separate_state s \<equiv> \<forall>p. tcb_at p s \<longrightarrow> separate_tcb p (caps_of_state s)"

28
proof/bisim/Syscall_S.thy
View File

@ -106,7 +106,7 @@ lemma bisim_rab:
apply (auto intro!: bisim_underlyingI
elim!: separate_cnode_capE
simp: whenE_def in_monad Bex_def in_bindE word_bits_def in_get_cap_cte_wp_at cte_wp_at_caps_of_state
simp del: add_is_0 split: split_if_asm)[1]
simp del: add_is_0 split: if_split_asm)[1]
apply simp
apply (rule bisim_underlyingI)
apply (clarsimp )
@ -117,14 +117,14 @@ lemma bisim_rab:
apply (drule (2) valid_sep_cap_not_cnode [where cref = cref])
apply simp
apply (fastforce simp: in_monad Bex_def in_bindE word_bits_def in_get_cap_cte_wp_at cte_wp_at_caps_of_state whenE_def
simp del: add_is_0 split: split_if_asm)
simp del: add_is_0 split: if_split_asm)
apply clarsimp
apply (erule separate_cnode_capE)
apply (fastforce simp: word_bits_def in_monad)
apply (drule (2) valid_sep_cap_not_cnode [where cref = cref])
apply simp
apply (fastforce simp: in_monad Bex_def in_bindE word_bits_def in_get_cap_cte_wp_at cte_wp_at_caps_of_state whenE_def
simp del: add_is_0 split: split_if_asm)
simp del: add_is_0 split: if_split_asm)
done
@ -199,7 +199,7 @@ lemma not_empty_returnOk [wp]:
lemma not_empty_if [wp_split]:
"\<lbrakk> not_empty Pt m; not_empty Pf m' \<rbrakk> \<Longrightarrow> not_empty (\<lambda>s. (b \<longrightarrow> Pt s) \<and> ( \<not> b \<longrightarrow> Pf s)) (if b then m else m')"
by (clarsimp split: split_if)
by clarsimp
lemma not_empty_lsft:
shows "not_empty (tcb_at t and valid_objs and separate_state) (lookup_slot_for_thread t cptr)"
@ -359,9 +359,9 @@ lemma decode_invocation_bisim:
unfolding decode_invocation_def Decode_A.decode_invocation_def
apply (rule bisim_guard_imp)
apply (rule bisim_separate_cap_cases [where cap = cap])
apply (simp split del: split_if)
apply (simp split del: if_split)
apply (rule bisim_throwError, simp)
apply (simp split del: split_if)
apply (simp split del: if_split)
apply (rule bisim_reflE)
apply (fastforce intro!: bisim_throwError bisim_returnOk simp: AllowRecv_def AllowSend_def)
apply simp
@ -386,7 +386,7 @@ lemma decode_separate_inv:
unfolding Decode_A.decode_invocation_def
apply (rule hoare_gen_asmE)
apply clarify
apply (erule separate_capE, simp_all split del: split_if)
apply (erule separate_capE, simp_all split del: if_split)
apply (rule hoare_pre, (wp | simp add: comp_def)+)[1]
apply (rule hoare_pre)
apply (wp | simp)+
@ -516,18 +516,14 @@ lemma separate_cap_NullCap [simp]: "separate_cap NullCap" by (simp add: separate
lemma set_cap_NullCap_separate_state [wp]:
"\<lbrace>separate_state\<rbrace> set_cap NullCap cptr \<lbrace>\<lambda>_. separate_state\<rbrace>"
unfolding separate_state_def[abs_def] separate_tcb_def separate_cnode_cap_def
apply (simp add: separate_state_def[abs_def] tcb_at_typ)
unfolding separate_state_def separate_tcb_def separate_cnode_cap_def
apply (simp add: tcb_at_typ)
apply (rule hoare_pre)
apply wps
apply (wp set_cap_typ_at hoare_vcg_all_lift)
apply (subst separate_cnode_cap_def)
apply (clarsimp simp: separate_cap_def)
apply (clarsimp simp: separate_cap_def)
apply (drule spec, drule (1) mp)
apply (clarsimp cong: option.case_cong cap.case_cong split: option.split_asm)
apply (erule separate_cnode_capE)
apply (simp add: separate_cnode_cap_def)
apply (clarsimp simp add: separate_cnode_cap_def split: option.splits)
apply (clarsimp split: cap.splits option.splits)
done
lemma separate_state_pres:
@ -626,7 +622,7 @@ lemma handle_recv_bisim:
apply (rule bisim_split_reflE)
apply (rule_tac cap = rb in bisim_separate_cap_cases)
apply (simp, rule bisim_throwError, rule refl)+
apply (simp split del: split_if)
apply (simp split del: if_split)
apply (rule bisim_refl [where P = \<top> and P' = \<top>])
apply (case_tac rc, simp_all)[1]
apply (wp get_cap_wp' lsft_sep | simp add: lookup_cap_def split_def del: hoare_True_E_R)+

50
proof/capDL-api/Arch_DP.thy
View File

@ -63,7 +63,7 @@ lemma decode_page_map_intent_rv_20_24:
"\<lbrakk>n = 20 \<or> n = 24 \<rbrakk>
\<Longrightarrow> \<lbrace>\<lambda>s. R (InvokePage (PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) ref [cdl_lookup_pd_slot ptr vaddr])) \<rbrace>
decode_invocation (FrameCap dev frame_ptr rights n real asid) ref
decode_invocation (FrameCap dev frame_ptr rights n real_type asid) ref
[(PageDirectoryCap ptr real' asid',pdref)]
(PageIntent (PageMapIntent vaddr perms vmattr))
\<lbrace>\<lambda>r s. R r\<rbrace>, -"
@ -85,7 +85,7 @@ lemma decode_page_map_intent_rv_16_12:
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) ref
[(p, unat ((vaddr >> 12) && 0xFF))]))
\<and> <(ptr, unat (vaddr >> 20)) \<mapsto>c PageTableCap p Fake None \<and>* (\<lambda>s. True)> s\<rbrace>
decode_invocation (FrameCap dev frame_ptr rights n real asid) ref
decode_invocation (FrameCap dev frame_ptr rights n real_type asid) ref
[(PageDirectoryCap ptr real' asid',pdref)]
(PageIntent (PageMapIntent vaddr perms vmattr))
\<lbrace>\<lambda>r s. R r\<rbrace>, -"
@ -179,7 +179,7 @@ lemma seL4_Page_Table_Map:
\<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
\<and>* (cnode_id, pt_offset) \<mapsto>c (PageTableCap ptr Real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
@ -189,7 +189,7 @@ lemma seL4_Page_Table_Map:
\<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c (PageTableCap ptr Fake None)
\<and>* (cnode_id, pt_offset) \<mapsto>c (PageTableCap ptr Real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
@ -223,7 +223,7 @@ lemma seL4_Page_Table_Map:
apply (sep_solve )
apply wp
apply (rule_tac P = "\<exists>asid asid'. (c = (PageTableCap ptr Real asid)
\<and> cs = [(PageDirectoryCap pd_ptr real asid',(cnode_id,pd_offset))]
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
\<and> ref = (cnode_id,pt_offset))"
in hoare_gen_asmEx)
apply (elim conjE exE)
@ -234,7 +234,7 @@ lemma seL4_Page_Table_Map:
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
\<and>* (cnode_id, pt_offset) \<mapsto>c PageTableCap ptr Real None
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real None
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
\<and>* root_tcb_id \<mapsto>f Tcb tcb
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
iv = InvokePageTable (PageTableMap (PageTableCap ptr Real (get_mapped_asid asid' (vaddr && ~~ mask 20))) (PageTableCap ptr Fake None)
@ -256,7 +256,7 @@ lemma seL4_Page_Table_Map:
apply (rule wp_no_exception_seq)
apply wp[1]
apply (rule lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageDirectoryCap pd_ptr real None"])
and cap' = "PageDirectoryCap pd_ptr real_type None"])
apply (rule hoare_pre)
apply (wp lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageTableCap ptr Real None"])[1]
@ -292,7 +292,7 @@ lemma seL4_Page_Table_Map:
apply (drule_tac x = "PageTableCap ptr Real None" in spec)
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd_ptr real None" in exI)
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
apply simp
apply clarsimp
apply (sep_solve)
@ -314,7 +314,7 @@ lemma seL4_Section_Map_wp:
\<and>* (root_tcb_id,tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None \<and>* R \<guillemotright> \<rbrace>
seL4_Page_Map sel_page sel4_page_directory vaddr perms vmattr
\<lbrace>\<lambda>r s. \<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
@ -323,7 +323,7 @@ lemma seL4_Section_Map_wp:
FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
\<and>* R \<guillemotright> s \<rbrace>"
apply (simp add:seL4_Page_Map_def sep_state_projection2_def
@ -360,7 +360,7 @@ lemma seL4_Section_Map_wp:
apply (sep_solve)
apply wp
apply (rule_tac P = "\<exists>asid asid'. (c = (FrameCap dev frame_ptr rights n Real asid)
\<and> cs = [(PageDirectoryCap pd_ptr real asid',(cnode_id,pd_offset))]
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
\<and> ref = (cnode_id,frame_offset))"
in hoare_gen_asmEx)
apply (elim exE)+
@ -371,7 +371,7 @@ lemma seL4_Section_Map_wp:
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
\<and>* (cnode_id, frame_offset) \<mapsto>c -
\<and>* root_tcb_id \<mapsto>f Tcb tcb \<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real None
\<and>* root_tcb_id \<mapsto>f Tcb tcb \<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
iv = InvokePage
(PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
@ -393,7 +393,7 @@ lemma seL4_Section_Map_wp:
apply (rule wp_no_exception_seq)
apply wp[1]
apply (rule lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageDirectoryCap pd_ptr real None"])
and cap' = "PageDirectoryCap pd_ptr real_type None"])
apply (rule hoare_pre)
apply (wp lookup_cap_and_slot_rvu[where r = root_size
and cap' = "FrameCap dev frame_ptr rights n Real None"])[1]
@ -428,7 +428,7 @@ lemma seL4_Section_Map_wp:
apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec)
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd_ptr real None" in exI)
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
apply simp
apply clarsimp
apply (sep_solve)
@ -451,7 +451,7 @@ lemma seL4_Page_Map_wp:
\<and>* (root_tcb_id,tcb_cspace_slot) \<mapsto>c cnode_cap
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c PageTableCap pt_ptr Fake None
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
\<and>* (pt_ptr, unat ((vaddr >> 12) && 0xFF)) \<mapsto>c -
\<and>* R \<guillemotright> \<rbrace>
@ -462,7 +462,7 @@ lemma seL4_Page_Map_wp:
FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real None)
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c PageTableCap pt_ptr Fake None
\<and>* R \<guillemotright> s \<rbrace>"
@ -499,7 +499,7 @@ lemma seL4_Page_Map_wp:
apply (sep_solve)
apply wp
apply (rule_tac P = "\<exists>asid asid'. (c = (FrameCap dev frame_ptr rights n Real asid)
\<and> cs = [(PageDirectoryCap pd_ptr real asid',(cnode_id,pd_offset))]
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
\<and> ref = (cnode_id,frame_offset))"
in hoare_gen_asmEx)
apply (elim exE)+
@ -511,7 +511,7 @@ lemma seL4_Page_Map_wp:
\<and>* (pt_ptr, unat ((vaddr >> 12) && 0xFF)) \<mapsto>c -
\<and>* (cnode_id, frame_offset) \<mapsto>c -
\<and>* root_tcb_id \<mapsto>f Tcb tcb
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real None
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c PageTableCap pt_ptr Fake None
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
iv = InvokePage
@ -534,7 +534,7 @@ lemma seL4_Page_Map_wp:
apply (rule wp_no_exception_seq)
apply wp[1]
apply (rule lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageDirectoryCap pd_ptr real None"])
and cap' = "PageDirectoryCap pd_ptr real_type None"])
apply (rule hoare_pre)
apply (wp lookup_cap_and_slot_rvu[where r = root_size
and cap' = "FrameCap dev frame_ptr rights n Real None"])[1]
@ -564,7 +564,7 @@ lemma seL4_Page_Map_wp:
apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec)
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd_ptr real None" in exI)
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
apply simp
apply clarsimp
apply (sep_solve)
@ -612,7 +612,7 @@ lemma invoke_asid_pool_wp:
apply (rule hoare_strengthen_post[OF set_cap_wp])
apply (subst set_split_single[where A = "(Collect (\<lambda>off. off < 2 ^ asid_low_bits))"])
apply simp
apply (subst sep.setprod.union_disjoint)
apply (subst sep.prod.union_disjoint)
apply simp+
apply (clarsimp simp: sep_conj_assoc)
apply (sep_erule_concl sep_any_imp, sep_solve)
@ -627,7 +627,7 @@ lemma invoke_asid_pool_wp:
apply (safe,fastforce+)
apply (subst (asm) set_split_single[where A = "(Collect (\<lambda>off. off < 2 ^ asid_low_bits))"])
apply simp
apply (subst (asm) sep.setprod.union_disjoint)
apply (subst (asm) sep.prod.union_disjoint)
apply simp+
apply (simp add:sep_conj_assoc)
apply sep_solve
@ -637,9 +637,9 @@ lemma invoke_asid_pool_wp:
done
lemma sep_map_c_asid_simp:
"(slot \<mapsto>c FrameCap dev ptr rights sz real option) = (slot \<mapsto>c FrameCap dev ptr rights sz real None)"
"(slot \<mapsto>c PageTableCap ptr real option) = (slot \<mapsto>c PageTableCap ptr real None)"
"(slot \<mapsto>c PageDirectoryCap ptr real option') = (slot \<mapsto>c PageDirectoryCap ptr real None)"
"(slot \<mapsto>c FrameCap dev ptr rights sz real_type option) = (slot \<mapsto>c FrameCap dev ptr rights sz real_type None)"
"(slot \<mapsto>c PageTableCap ptr real_type option) = (slot \<mapsto>c PageTableCap ptr real_type None)"
"(slot \<mapsto>c PageDirectoryCap ptr real_type option') = (slot \<mapsto>c PageDirectoryCap ptr real_type None)"
by (simp_all add:sep_map_c_asid_reset)

14
proof/capDL-api/IRQ_DP.thy
View File

@ -154,7 +154,7 @@ done
lemma seL4_IRQHandler_IRQControl_Get_helper:
assumes unify : "irq_cap = IrqHandlerCap irq \<and>
target_index = offset node_index root_size \<and>
root_index = offset root root_size \<and>
root_index = offset croot root_size \<and>
control_index = offset control_cap root_size \<and>
target_ptr = (cap_object root_cap, target_index) \<and>
control_ptr = (cap_object root_cap, control_index) \<and>
@ -167,12 +167,12 @@ shows "\<lbrace>\<guillemotleft>root_tcb_id \<mapsto>f root_tcb \<and>* (root_t
and K ( \<not> ep_related_cap c_cap \<and> one_lvl_lookup root_cap word_bits root_size \<and>
one_lvl_lookup root_cap (unat node_depth) root_size \<and>
guard_equal root_cap node_index (unat node_depth) \<and>
guard_equal root_cap root word_bits \<and>
guard_equal root_cap croot word_bits \<and>
guard_equal root_cap control_cap word_bits \<and>
guard_equal root_cap node_index word_bits \<and>
unat node_depth \<le> word_bits \<and> 0 < unat node_depth \<and>
is_irqcontrol_cap c_cap \<and> is_cnode_cap root_cap \<and> is_cnode_cap root_cap)\<rbrace>
seL4_IRQControl_Get control_cap irq root node_index node_depth
seL4_IRQControl_Get control_cap irq croot node_index node_depth
\<lbrace>\<lambda>fail s. \<guillemotleft> root_tcb_id \<mapsto>f root_tcb \<and>*
(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap \<and>*
(* Root CNode. *)
@ -184,7 +184,7 @@ shows "\<lbrace>\<guillemotleft>root_tcb_id \<mapsto>f root_tcb \<and>* (root_t
apply (rule hoare_pre)
apply (wp do_kernel_op_pull_back)
apply (rule call_kernel_with_intent_allow_error_helper
[where check = True and Perror = \<top> and intent_op = "(IrqControlIntent (IrqControlIssueIrqHandlerIntent irq node_index node_depth))" and tcb = t and intent_cptr = control_cap and intent_extra = "[root]" ,simplified])
[where check = True and Perror = \<top> and intent_op = "(IrqControlIntent (IrqControlIssueIrqHandlerIntent irq node_index node_depth))" and tcb = t and intent_cptr = control_cap and intent_extra = "[croot]" ,simplified])
apply (clarsimp)
apply (rule set_cap_wp[sep_wand_wp])
apply (rule mark_tcb_intent_error_sep_inv)
@ -269,16 +269,16 @@ lemma seL4_IRQHandler_IRQControl_Get:
is_cnode_cap cnode_cap \<and>
cnode_id = cap_object cnode_cap \<and>
target_index = offset node_index root_size \<and>
root_index = offset root root_size \<and>
root_index = offset croot root_size \<and>
control_index = offset control_cap root_size \<and>
one_lvl_lookup cnode_cap word_bits root_size \<and>
one_lvl_lookup cnode_cap (unat node_depth) root_size \<and>
guard_equal cnode_cap node_index (unat node_depth) \<and>
guard_equal cnode_cap root word_bits \<and>
guard_equal cnode_cap croot word_bits \<and>
guard_equal cnode_cap control_cap word_bits \<and>
guard_equal cnode_cap node_index word_bits \<and>
unat node_depth \<le> word_bits \<and> 0 < unat node_depth)\<rbrace>
seL4_IRQControl_Get control_cap irq root node_index node_depth
seL4_IRQControl_Get control_cap irq croot node_index node_depth
\<lbrace>\<lambda>fail.
\<guillemotleft>root_tcb_id \<mapsto>f root_tcb \<and>*
(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap \<and>*

2
proof/capDL-api/Invocation_DP.thy
View File

@ -86,7 +86,7 @@ lemma sep_nonimpact_valid_lift:
sep_state_add_def sep_disj_sep_state_def
sep_state_disj_def
map_option_case
split: split_if_asm option.splits sep_state.splits)
split: if_split_asm option.splits sep_state.splits)
apply (erule rsubst [where P=Q])
apply clarsimp
apply (rule conjI)

26
proof/capDL-api/KHeap_DP.thy
View File

@ -80,7 +80,7 @@ lemma reset_cap_asid_simps2:
"reset_cap_asid cap = (IOPageTableCap a2) \<Longrightarrow> cap = (IOPageTableCap a2)"
"reset_cap_asid cap = (ZombieCap a3) \<Longrightarrow> cap = (ZombieCap a3)"
"reset_cap_asid cap = (BoundNotificationCap a4) \<Longrightarrow> cap = (BoundNotificationCap a4)"
"reset_cap_asid cap = (FrameCap dev aa real sz rset ma) \<Longrightarrow> \<exists>asid. cap = FrameCap dev aa real sz rset asid"
"reset_cap_asid cap = (FrameCap dev aa rghts sz rset ma) \<Longrightarrow> \<exists>asid. cap = FrameCap dev aa rghts sz rset asid"
"reset_cap_asid cap = (PageTableCap aa rights ma) \<Longrightarrow> \<exists>asid. cap = PageTableCap aa rights asid"
"reset_cap_asid cap = (PageDirectoryCap aa rights as) \<Longrightarrow> \<exists>asid. cap = PageDirectoryCap aa rights asid"
by (clarsimp simp: reset_cap_asid_def split: cdl_cap.splits)+
@ -470,10 +470,10 @@ lemma resolve_cap_rv1:
apply (wp gets_the_wpE)
apply (clarsimp simp: one_lvl_lookup_def offset_def)
apply (clarsimp simp: split_def split: sum.splits option.splits)
apply (simp add: split_def resolve_cap.simps split: split_if_asm)
apply (simp add: split_def resolve_cap.simps split: if_split_asm)
apply (simp add: obind_def split:option.splits)
apply (drule sep_f_size_opt_cnode)
apply (simp split: split_if_asm)+
apply (simp split: if_split_asm)+
done
lemma resolve_cap_u:
@ -485,10 +485,10 @@ lemma resolve_cap_u:
apply (clarsimp simp:
user_pointer_at_def Let_unfold one_lvl_lookup_def
offset_def split:option.splits sum.splits)
apply (simp add: split_def resolve_cap.simps split: split_if_asm)
apply (simp add: split_def resolve_cap.simps split: if_split_asm)
apply (simp add: obind_def sep_conj_assoc split:option.splits)
apply (sep_drule (direct) sep_f_size_opt_cnode)
apply (fastforce split: split_if_asm)+
apply (fastforce split: if_split_asm)+
done
lemma resolve_cap_u_nf:
@ -501,14 +501,14 @@ lemma resolve_cap_u_nf:
offset_def sep.mult_assoc)
apply (clarsimp simp: split_def split: sum.splits option.splits)
apply (safe)
apply (simp add: split_def resolve_cap.simps split: split_if_asm)
apply (simp add: split_def resolve_cap.simps split: if_split_asm)
apply (simp add: obind_def split:option.splits)
apply (sep_drule (direct) sep_f_size_opt_cnode)
apply (fastforce)+
apply (simp add: split_def resolve_cap.simps split: split_if_asm)
apply (simp add: split_def resolve_cap.simps split: if_split_asm)
apply (simp add: obind_def split:option.splits)
apply (sep_drule (direct) sep_f_size_opt_cnode)
apply (fastforce split: split_if_asm)+
apply (fastforce split: if_split_asm)+
done
lemma resolve_cap_rv:
@ -911,10 +911,10 @@ lemma is_exclusive_cap_update_cap_data:
apply (rule iffI)
apply (simp_all add: safe_for_derive_def update_cap_data_def update_cap_data_det_def)
apply (case_tac cap, simp_all add: safe_for_derive_def badge_update_def
split: split_if_asm)
split: if_split_asm)
apply (case_tac cap, simp_all add: badge_update_def guard_update_def
update_cap_badge_def
split: split_if_asm)
split: if_split_asm)
done
lemma cap_object_update_cap_rights:
@ -928,13 +928,13 @@ lemma derived_cap_update_cap_data_det_NullCap [simp]:
= (derived_cap cap = NullCap)"
by (clarsimp simp: derived_cap_def update_cap_data_det_def
badge_update_def update_cap_badge_def guard_update_def
split: cdl_cap.splits split_if_asm)
split: cdl_cap.splits if_split_asm)
lemma derived_cap_update_cap_rights_NullCap [simp]:
"(derived_cap (update_cap_rights rights cap) = NullCap)
= (derived_cap cap = NullCap)"
by (clarsimp simp: derived_cap_def update_cap_rights_def
split: cdl_cap.splits split_if_asm)
split: cdl_cap.splits if_split_asm)
lemma derived_cap_reset_cap_asid_NullCap:
"\<lbrakk>reset_cap_asid cap = reset_cap_asid cap'; derived_cap cap = NullCap\<rbrakk>
@ -1043,7 +1043,7 @@ lemma update_cap_data_non:
by (rule iffI,
simp_all add: update_cap_data_det_def badge_update_def
guard_update_def update_cap_badge_def
split: cdl_cap.splits split_if_asm)
split: cdl_cap.splits if_split_asm)
lemma decode_cnode_mutate_rvu:
"\<lbrace>\<lambda>s. caps \<noteq> []

8
proof/capDL-api/Kernel_DP.thy
View File

@ -164,22 +164,22 @@ where
definition seL4_Untyped_Retype :: "cdl_cptr \<Rightarrow> cdl_object_type \<Rightarrow> word32 \<Rightarrow> cdl_cptr \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> bool u_monad"
where
"seL4_Untyped_Retype untyped_cap type size_bits root node_index node_depth node_offset node_window \<equiv>
"seL4_Untyped_Retype untyped_cap type size_bits croot node_index node_depth node_offset node_window \<equiv>
do_kernel_op $ call_kernel_with_intent
\<lparr>cdl_intent_op = Some $ UntypedIntent $ UntypedRetypeIntent type size_bits node_index node_depth node_offset node_window,
cdl_intent_error = False,
cdl_intent_cap = untyped_cap,
cdl_intent_extras = [root],
cdl_intent_extras = [croot],
cdl_intent_recv_slot = None\<rparr> False"
definition seL4_IRQControl_Get :: "cdl_cptr \<Rightarrow> 10 word \<Rightarrow> cdl_cptr \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> bool u_monad"
where
"seL4_IRQControl_Get control_cap irq root node_index node_depth \<equiv>
"seL4_IRQControl_Get control_cap irq croot node_index node_depth \<equiv>
do_kernel_op $ call_kernel_with_intent
\<lparr>cdl_intent_op = Some $ IrqControlIntent $ IrqControlIssueIrqHandlerIntent irq node_index node_depth,
cdl_intent_error = False,
cdl_intent_cap = control_cap,
cdl_intent_extras = [root],
cdl_intent_extras = [croot],
cdl_intent_recv_slot = None\<rparr> True"
definition seL4_IRQHandler_SetEndpoint :: "cdl_cptr \<Rightarrow> cdl_cptr \<Rightarrow> bool u_monad"

6
proof/capDL-api/RWHelper_DP.thy
View File

@ -203,7 +203,7 @@ lemma sep_irq_node_dom_sep_map_predicate:
"sep_irq_node_dom (sep_map_predicate ptr P cmps) {}"
apply (clarsimp simp: sep_map_general_def object_to_sep_state_def
sep_irq_node_dom_def sep_map_predicate_def
split:sep_state.splits split_if_asm)
split:sep_state.splits if_split_asm)
done
lemma sep_map_rewrite_spec:
@ -262,7 +262,7 @@ lemma sep_spec_simps:
apply (clarsimp simp:object_to_sep_state_def)
apply (rule ext)
apply (clarsimp simp: object_project_def object_slots_object_clean
split: split_if_asm)
split: if_split_asm)
done
lemma sep_conj_spec:
@ -472,7 +472,7 @@ lemma set_cap_all_scheduable_tcbs:
apply (drule in_singleton)
apply (intro set_eqI iffI)
apply (clarsimp simp: sep_all_scheduable_tcbs_def sep_state_projection_def
split: split_if_asm option.splits)
split: if_split_asm option.splits)
apply (fastforce simp: sep_all_scheduable_tcbs_def map_add_def
sep_state_projection_def scheduable_cap_def
split: option.splits)

40
proof/capDL-api/Retype_DP.thy
View File

@ -152,7 +152,7 @@ lemma retype_region_wp:
apply (rule_tac P="current_domain = minBound" in hoare_gen_asm)
apply (wp create_objects_wp | simp)+
apply (subst sep_conj_assoc[symmetric])
apply (subst sep.setprod.union_disjoint [symmetric])
apply (subst sep.prod.union_disjoint [symmetric])
apply simp+
apply (simp add:Un_absorb1)
done
@ -204,7 +204,7 @@ lemma dummy_detype_if_untyped:
apply (case_tac s,clarsimp simp:detype_def sep_set_conj_def)
apply (rule ext)
apply (clarsimp simp:sep_state_projection_def sep_conj_def)
apply (subst (asm) sep.setprod.remove)
apply (subst (asm) sep.prod.remove)
apply simp+
apply (clarsimp simp:sep_map_o_conj image_def)
apply (drule_tac f = sep_heap in arg_cong)
@ -276,7 +276,7 @@ lemma reset_untyped_cap_wp:
apply (clarsimp dest!: reset_cap_asid_untyped_cap_eqD)
apply (subgoal_tac "tot_free_range = obj_range \<union> (tot_free_range - obj_range)")
apply simp
apply (subst (asm) sep.setprod.subset_diff)
apply (subst (asm) sep.prod.subset_diff)
apply simp+
apply (sep_select_asm 2)
apply (simp add:sep_conj_assoc)
@ -355,18 +355,18 @@ lemma invoke_untyped_wp:
\<and> distinct (map pick new_obj_refs) \<and>
new_obj_refs = map ((\<lambda>x. {x}) \<circ> pick) new_obj_refs \<and>
pick ` set new_obj_refs \<subseteq> tot_free_range" in hoare_gen_asm)
apply (simp del:set_map split del:split_if)
apply (simp del:set_map split del:if_split)
apply (rule hoare_strengthen_post[OF update_available_range_wp])
apply clarsimp
apply (rule_tac x = nfr in exI)
apply (rule conjI)
apply (clarsimp split:if_splits)
apply (sep_select 3,sep_select 2,simp)
apply (wp|simp split del:split_if)+
apply (wp|simp split del:if_split)+
apply (rule_tac P = "untyped_cap = UntypedCap dev obj_range free_range"
in hoare_gen_asm)
apply (clarsimp simp:conj_comms split del: split_if)
apply (simp add: conj_assoc[symmetric] del:conj_assoc split del: split_if)+
apply (clarsimp simp:conj_comms split del: if_split)
apply (simp add: conj_assoc[symmetric] del:conj_assoc split del: if_split)+
apply (rule hoare_vcg_conj_lift)
apply wp
apply (rule hoare_strengthen_post[OF generate_object_ids_rv])
@ -580,7 +580,7 @@ lemma seL4_Untyped_Retype_sep:
unat ncptr_slot_nat = ncptr_slot;
one_lvl_lookup root_cnode_cap 32 root_size;
guard_equal root_cnode_cap ucptr 32;
guard_equal root_cnode_cap root 32\<rbrakk>
guard_equal root_cnode_cap croot 32\<rbrakk>
\<Longrightarrow> \<lbrace> K (nt\<noteq> UntypedType \<and> default_object nt (unat ts) minBound = Some obj
\<and> free_range\<subseteq> tot_free_range) and
\<guillemotleft>root_tcb_id \<mapsto>f (Tcb tcb)
@ -590,11 +590,11 @@ lemma seL4_Untyped_Retype_sep:
\<and>* (root_cnode, ncptr_slot ) \<mapsto>c NullCap
\<and>* (\<And>* ptr\<in>tot_free_range. ptr \<mapsto>o Untyped)
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset root root_size) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset croot root_size) \<mapsto>c root_cnode_cap
\<and>* P\<guillemotright>
and (\<lambda>s. \<not> has_children (root_cnode,ucptr_slot) (kernel_state s) \<longrightarrow> obj_range = free_range)
\<rbrace>
seL4_Untyped_Retype ucptr nt ts root node_index 0 ncptr_slot_nat 1
seL4_Untyped_Retype ucptr nt ts croot node_index 0 ncptr_slot_nat 1
\<lbrace>\<lambda>r s. (\<not> r \<longrightarrow> (\<exists>oid free_range'. (\<guillemotleft>
(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
@ -604,7 +604,7 @@ lemma seL4_Untyped_Retype_sep:
\<and>* (\<And>* ptr\<in>tot_free_range - {oid}. ptr \<mapsto>o Untyped)
\<and>* (root_cnode, ucptr_slot) \<mapsto>c UntypedCap dev obj_range free_range'
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset root root_size) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset croot root_size) \<mapsto>c root_cnode_cap
\<and>* P \<guillemotright> s ) \<and> free_range' \<subseteq> free_range - {oid} \<and> oid \<in> free_range)
\<and> has_children (root_cnode,ucptr_slot) (kernel_state s))
\<and> (r \<longrightarrow> (\<guillemotleft>
@ -615,7 +615,7 @@ lemma seL4_Untyped_Retype_sep:
\<and>* (root_cnode, ncptr_slot) \<mapsto>c NullCap
\<and>* (\<And>* ptr\<in>tot_free_range. ptr \<mapsto>o Untyped)
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset root root_size) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset croot root_size) \<mapsto>c root_cnode_cap
\<and>* P \<guillemotright> s )
\<and> (\<not>has_children (root_cnode,ucptr_slot) (kernel_state s) \<longrightarrow> obj_range = free_range)) \<rbrace>"
apply (simp add:seL4_Untyped_Retype_def sep_state_projection2_def)
@ -660,7 +660,7 @@ lemma seL4_Untyped_Retype_sep:
apply (sep_select 4,assumption)
apply wp[1]
apply (rule_tac P =" nt \<noteq> UntypedType
\<and> c = UntypedCap dev obj_range free_range \<and> cs = [(root_cnode_cap,(root_cnode,offset root root_size))]"
\<and> c = UntypedCap dev obj_range free_range \<and> cs = [(root_cnode_cap,(root_cnode,offset croot root_size))]"
in hoare_gen_asmEx)
apply simp
apply (rule decode_untyped_invocation_rvu)
@ -1055,10 +1055,10 @@ lemma transfer_caps_loop_cdl_parent:
"\<lbrace>\<lambda>s. cdl_cdt s slot = Some parent\<rbrace>
transfer_caps_loop ep rcvr caps dest
\<lbrace>\<lambda>_ s. cdl_cdt s slot = Some parent\<rbrace>"
apply (induct caps arbitrary: dest; clarsimp split del: split_if)
apply (induct caps arbitrary: dest; clarsimp split del: if_split)
apply (rule hoare_pre)
apply (wp alternative_wp crunch_wps | assumption
| simp add: crunch_simps split del: split_if)+
| simp add: crunch_simps split del: if_split)+
done
lemmas reset_untyped_cap_cdl2[wp] = reset_untyped_cap_cdl_parent[THEN valid_validE_E]
@ -1114,7 +1114,7 @@ lemma default_object_no_pending_cap:
apply (case_tac b)
apply (clarsimp simp: default_object_def object_slots_def default_tcb_def is_pending_cap_def
empty_cnode_def empty_cap_map_def empty_irq_node_def
split: split_if_asm)+
split: if_split_asm)+
done
lemma create_objects_no_pending[wp]:
@ -1245,7 +1245,7 @@ lemma seL4_Untyped_Retype_inc_no_preempt:
unat ncptr_slot_nat = ncptr_slot;
one_lvl_lookup root_cnode_cap 32 root_size;
guard_equal root_cnode_cap ucptr 32;
guard_equal root_cnode_cap root 32\<rbrakk>
guard_equal root_cnode_cap croot 32\<rbrakk>
\<Longrightarrow> \<lbrace> K (nt\<noteq> UntypedType \<and> default_object nt (unat ts) minBound = Some obj
\<and> free_range\<subseteq> tot_free_range) and
\<guillemotleft>root_tcb_id \<mapsto>f (Tcb tcb)
@ -1255,12 +1255,12 @@ lemma seL4_Untyped_Retype_inc_no_preempt:
\<and>* (root_cnode, ncptr_slot ) \<mapsto>c NullCap
\<and>* (\<And>* ptr\<in>tot_free_range. ptr \<mapsto>o Untyped)
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset root root_size) \<mapsto>c root_cnode_cap
\<and>* (cap_object root_cnode_cap, offset croot root_size) \<mapsto>c root_cnode_cap
\<and>* P\<guillemotright>
and (\<lambda>s. \<not> has_children (root_cnode,ucptr_slot) (kernel_state s) \<longrightarrow> obj_range = free_range)
and (\<lambda>s. cdl_cdt (kernel_state s) child = Some parent)
\<rbrace>
seL4_Untyped_Retype ucptr nt ts root node_index 0 ncptr_slot_nat 1
seL4_Untyped_Retype ucptr nt ts croot node_index 0 ncptr_slot_nat 1
\<lbrace>\<lambda>rv s. cdl_cdt (kernel_state s) child = Some parent\<rbrace>"
apply (simp add:seL4_Untyped_Retype_def sep_state_projection2_def)
apply (rule hoare_name_pre_state)
@ -1301,7 +1301,7 @@ lemma seL4_Untyped_Retype_inc_no_preempt:
apply (sep_select 4,assumption)
apply wp[1]
apply (rule_tac P =" nt \<noteq> UntypedType
\<and> c = UntypedCap dev obj_range free_range \<and> cs = [(root_cnode_cap,(root_cnode,offset root root_size))]"
\<and> c = UntypedCap dev obj_range free_range \<and> cs = [(root_cnode_cap,(root_cnode,offset croot root_size))]"
in hoare_gen_asmEx)
apply simp
apply (rule decode_untyped_invocation_rvu)

20
proof/crefine/ADT_C.thy
View File

@ -107,8 +107,8 @@ lemma setArchTCB_C_corres:
apply (rule conjI)
defer
apply (erule cready_queues_relation_not_queue_ptrs)
apply (rule ext, simp split: split_if)
apply (rule ext, simp split: split_if)
apply (rule ext, simp split: if_split)
apply (rule ext, simp split: if_split)
apply (drule ko_at_projectKO_opt)
apply (erule (2) cmap_relation_upd_relI)
apply (simp add: ctcb_relation_def carch_tcb_relation_def)
@ -485,7 +485,7 @@ proof -
using vms'[simplified valid_machine_state'_def]
apply (auto simp: user_mem'_def option_to_0_def typ_at'_def ko_wp_at'_def
option_to_ptr_def pointerInUserData_def observable_memory_def
split: option.splits split_if_asm)
split: option.splits if_split_asm)
done
with mach_rel[simplified cmachine_state_relation_def]
user_mem_C_relation[OF um_rel]
@ -566,7 +566,7 @@ lemma the_the_inv_mapI:
lemma eq_restrict_map_None[simp]:
"restrict_map m A x = None \<longleftrightarrow> x ~: (A \<inter> dom m)"
by (auto simp: restrict_map_def split: split_if_asm)
by (auto simp: restrict_map_def split: if_split_asm)
lemma eq_the_inv_map_None[simp]: "the_inv_map m x = None \<longleftrightarrow> x\<notin>ran m"
by (simp add: the_inv_map_def2)
lemma is_inv_unique:
@ -648,7 +648,7 @@ lemma (in kernel_m)
apply (rule conjI)
apply (frule is_inv_inj)
apply (clarsimp simp: the_inv_map_def is_inv_def dom_option_map
split: split_if)
split: if_split)
apply (intro conjI[rotated] impI domI, assumption)
apply (rule the_equality)
apply (clarsimp simp: ran_def dom_def Collect_eq)
@ -730,7 +730,7 @@ lemma tcb_queue_rel'_unique:
"hp NULL = None \<Longrightarrow>
tcb_queue_relation' gn gp hp as pp cp \<Longrightarrow>
tcb_queue_relation' gn gp hp as' pp cp \<Longrightarrow> as' = as"
apply (clarsimp simp: tcb_queue_relation'_def split: split_if_asm)
apply (clarsimp simp: tcb_queue_relation'_def split: if_split_asm)
apply (clarsimp simp: neq_Nil_conv)
apply (clarsimp simp: neq_Nil_conv)
apply (erule(2) tcb_queue_rel_unique)
@ -782,7 +782,7 @@ lemma cready_queues_to_H_correct:
lemma inj_image_inv:
assumes inj_f: "inj f"
shows "f ` A = B \<Longrightarrow> inv f ` B = A"
by (drule sym) (simp add: inv_image_comp[OF inj_f])
by (drule sym) (simp add: image_inv_f_f[OF inj_f])
lemma cmap_relation_unique:
assumes inj_f: "inj f"
@ -829,7 +829,7 @@ lemma ran_tcb_cte_cases:
(Structures_H.tcbReply, tcbReply_update),
(Structures_H.tcbCaller, tcbCaller_update),
(tcbIPCBufferFrame, tcbIPCBufferFrame_update)}"
by (auto simp add: tcb_cte_cases_def split: split_if_asm)
by (auto simp add: tcb_cte_cases_def split: if_split_asm)
(* FIXME: move *)
lemma ps_clear_is_aligned_ksPSpace_None:
@ -924,7 +924,7 @@ lemma map_to_ctes_tcb_ctes:
lemma cfault_rel_imp_eq:
"cfault_rel x a b \<Longrightarrow> cfault_rel y a b \<Longrightarrow> x=y"
by (clarsimp simp: cfault_rel_def is_cap_fault_def
split: split_if_asm seL4_Fault_CL.splits)
split: if_split_asm seL4_Fault_CL.splits)
lemma cthread_state_rel_imp_eq:
"cthread_state_relation x z \<Longrightarrow> cthread_state_relation y z \<Longrightarrow> x=y"
@ -1531,7 +1531,7 @@ lemma (in kernel_m) cstate_to_H_correct:
using cstate_rel
apply (fastforce simp: cstate_relation_def cpspace_relation_def
Let_def ghost_size_rel_def unat_eq_0
split: split_if)
split: if_split)
using valid cstate_rel
apply (rule cDomScheduleIdx_to_H_correct)
using cstate_rel

107
proof/crefine/Arch_C.thy
View File

@ -215,7 +215,7 @@ proof -
apply simp
apply auto[1]
apply (simp add: asid_low_bits_def word_le_nat_alt)
apply (simp split: split_if)
apply (simp split: if_split)
apply (rule conjI)
apply (clarsimp simp: update_ti_t_ptr_0s)
apply (clarsimp simp: asid_low_bits_def word_le_nat_alt)
@ -332,7 +332,7 @@ proof -
apply (rule ccorres_from_vcg_nofail2, rule allI)
apply (rule conseqPre)
apply vcg
apply (clarsimp simp: cte_wp_at_ctes_of split: split_if_asm)
apply (clarsimp simp: cte_wp_at_ctes_of split: if_split_asm)
apply (frule(1) ctes_of_valid', clarsimp)
apply (subst ghost_assertion_size_logic[unfolded o_def, rotated], assumption)
apply (drule(1) valid_global_refsD_with_objSize)
@ -446,7 +446,7 @@ shows
cap_to_H_simps cap_untyped_cap_lift_def
ccap_relation_def modify_map_def
fun_eq_iff
dest!: word_unat.Rep_inverse' split: split_if)
dest!: word_unat.Rep_inverse' split: if_split)
apply (rule exI, strengthen refl)
apply (case_tac cte', simp add: cap_lift_untyped_cap max_free_index_def mask_def)
apply (simp add: mex_def meq_def del: split_paired_Ex)
@ -564,10 +564,10 @@ shows
apply simp+
apply (clarsimp simp:typ_heap_simps' region_is_bytes'_def[where sz=0])
apply (frule ccte_relation_ccap_relation)
apply (clarsimp simp: cap_get_tag_isCap)
apply (clarsimp simp: cap_get_tag_isCap hrs_htd_update)
apply (clarsimp simp: hrs_htd_update_def split_def
pageBits_def
split: split_if)
split: if_split)
apply (clarsimp simp: ARMSmallPageBits_def word_sle_def is_aligned_mask[symmetric]
ghost_assertion_data_get_gs_clear_region[unfolded o_def])
apply (subst ghost_assertion_size_logic_flex[unfolded o_def, rotated])
@ -575,18 +575,17 @@ shows
apply (simp add: ghost_assertion_data_get_gs_clear_region[unfolded o_def])
apply (drule valid_global_refsD_with_objSize, clarsimp)+
apply (clarsimp simp: isCap_simps dest!: ccte_relation_ccap_relation)
apply (cut_tac ptr=frame and bits=12 and s="globals_update (t_hrs_'_update (hrs_htd_update
(typ_region_bytes frame 12))) s'" in typ_region_bytes_actually_is_bytes)
apply (cut_tac ptr=frame and bits=12
and htd="typ_region_bytes frame 12 (hrs_htd (t_hrs_' (globals s')))" in typ_region_bytes_actually_is_bytes)
apply (simp add: hrs_htd_update)
apply clarsimp
apply (clarsimp simp: region_actually_is_bytes'_def[where len=0])
apply (intro conjI)
apply (clarsimp elim!:is_aligned_weaken)
apply (simp add:is_aligned_def)
apply (erule is_aligned_no_wrap',simp)
apply (drule region_actually_is_bytes_dom_s[OF _ order_refl])
apply (simp add: hrs_htd_update_def split_def)
apply (clarsimp simp: region_actually_is_bytes_def hrs_htd_update)
apply (simp add: hrs_htd_def hrs_htd_update_def split_def)
apply (simp add: hrs_htd_def)
apply (erule is_aligned_no_wrap',simp)
apply (drule region_actually_is_bytes_dom_s[OF _ order_refl])
apply (simp add: hrs_htd_def split_def)
apply (clarsimp simp: ccap_relation_def)
apply (clarsimp simp: cap_asid_pool_cap_lift)
apply (clarsimp simp: cap_to_H_def)
@ -613,7 +612,7 @@ lemma slotcap_in_mem_PageDirectory:
apply (simp add: cap_get_tag_isCap_ArchObject2)
done
declare split_if [split del]
declare if_split [split del]
lemma decodeARMPageTableInvocation_ccorres:
notes if_cong[cong] tl_drop_1[simp]
@ -713,7 +712,7 @@ lemma decodeARMPageTableInvocation_ccorres:
apply (frule cap_get_tag_isCap_unfolded_H_cap)
apply (clarsimp simp: cap_lift_page_table_cap cap_page_table_cap_lift_def
cap_to_H_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (simp add: to_bool_def)
apply (simp add: throwError_bind invocationCatch_def)
apply (rule syscall_error_throwError_ccorres_n)
@ -761,7 +760,7 @@ lemma decodeARMPageTableInvocation_ccorres:
apply (clarsimp simp: cap_lift_page_directory_cap
cap_to_H_def cap_page_directory_cap_lift_def
to_bool_def neq_Nil_conv
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (simp add: throwError_bind invocationCatch_def)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
@ -790,7 +789,7 @@ lemma decodeARMPageTableInvocation_ccorres:
apply (frule cap_get_tag_isCap_unfolded_H_cap)
apply (clarsimp simp: cap_lift_page_directory_cap
cap_to_H_def cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
apply (simp add: bindE_assoc del: Collect_const,
@ -916,7 +915,7 @@ lemma decodeARMPageTableInvocation_ccorres:
rule is_aligned_andI2,
simp add: is_aligned_def,
simp)+
apply (clarsimp simp: attribsFromWord_def split: split_if)
apply (clarsimp simp: attribsFromWord_def split: if_split)
apply word_bitwise
apply (clarsimp simp: word_size)
done
@ -930,7 +929,7 @@ lemma checkVPAlignment_spec:
apply (rule conjI)
apply (simp add: pageBitsForSize_def split: vmpage_size.split)
apply (simp add: from_bool_def vmsz_aligned'_def is_aligned_mask
mask_def split: split_if)
mask_def split: if_split)
done
definition
@ -985,7 +984,7 @@ lemma pde_get_tag_alt:
| Pde_pde_coarse _ \<Rightarrow> scast pde_pde_coarse
| Pde_pde_section _ \<Rightarrow> scast pde_pde_section
| Pde_pde_reserved \<Rightarrow> scast pde_pde_reserved)"
by (auto simp add: pde_lift_def Let_def split: split_if_asm)
by (auto simp add: pde_lift_def Let_def split: if_split_asm)
lemma cpde_relation_pde_case:
@ -1114,7 +1113,7 @@ lemma createSafeMappingEntries_PDE_ccorres:
apply (simp add: isPageTablePDE_def isSectionPDE_def
cpde_relation_pde_case from_bool_def)
apply (intro impI conjI disjCI2, simp_all add: array_assertion_shrink_right)[1]
apply (clarsimp simp: pde_tag_defs split: split_if bool.split)
apply (clarsimp simp: pde_tag_defs split: if_split bool.split)
apply (frule pde_pde_section_size_0_1[simplified pde_tag_defs, simplified], simp)
apply ceqv
apply (simp add: from_bool_0 del: Collect_const)
@ -1131,16 +1130,16 @@ lemma createSafeMappingEntries_PDE_ccorres:
apply (frule_tac n3="Suc o unat o i_'" in array_assertion_abs_pde_16_const[where pd=pd and vptr=vaddr,
simplified imp_conjL, THEN spec, THEN spec, THEN mp])
apply (simp add: upto_enum_word unat_of_nat vmsz_aligned_def
vmsz_aligned'_def split: split_if_asm)
vmsz_aligned'_def split: if_split_asm)
apply (clarsimp simp: upto_enum_step_def upto_enum_word
split: split_if)
split: if_split)
apply simp
apply (rule conseqPre, vcg)
apply (clarsimp simp: if_1_0_0)
apply simp
apply (wp getPDE_wp | wpc)+
apply simp
apply (simp add: upto_enum_step_def word_bits_def split: split_if)
apply (simp add: upto_enum_step_def word_bits_def split: if_split)
apply clarsimp
apply ceqv
apply csymbr
@ -1175,7 +1174,7 @@ lemma createSafeMappingEntries_PDE_ccorres:
pageBits_def)
apply (rule conjI)
apply (simp add: cpde_relation_def true_def false_def)
apply (simp add: split: split_if)
apply (simp add: split: if_split)
done
lemma pte_case_isLargePagePTE:
@ -1282,7 +1281,7 @@ lemma createSafeMappingEntries_PTE_ccorres:
apply (clarsimp simp: typ_heap_simps cpte_relation_def Let_def)
apply (simp add: isLargePagePTE_def pte_pte_large_lift_def pte_lift_def Let_def
pte_tag_defs pte_pte_invalid_def
split: ARM_H.pte.split_asm split_if_asm)
split: ARM_H.pte.split_asm if_split_asm)
apply ceqv
apply (simp add: pte_case_isLargePagePTE if_to_top_of_bindE del: Collect_const)
apply (rule ccorres_if_cond_throws[rotated -1, where Q=\<top> and Q'=\<top>])
@ -1361,13 +1360,13 @@ lemma createSafeMappingEntries_PTE_ccorres:
erule ko_at_projectKO_opt)
apply (auto simp: typ_heap_simps cpte_relation_def pte_pte_invalid_def
Let_def pte_lift_def pte_tag_defs
intro: typ_heap_simps split: split_if_asm)[1]
intro: typ_heap_simps split: if_split_asm)[1]
apply (wp getObject_inv loadObject_default_inv | simp)+
apply (simp add: objBits_simps archObjSize_def)
apply (simp add: loadObject_default_inv)
apply (simp add: empty_fail_getObject)
apply (simp add: upto_enum_step_def upto_enum_word
split: split_if)
split: if_split)
apply (rule conseqPre, vcg)
apply (clarsimp simp: pte_tag_defs)
using pte_get_tag_exhaust
@ -1375,7 +1374,7 @@ lemma createSafeMappingEntries_PTE_ccorres:
apply (wp getPTE_wp | simp | wpc)+
apply (simp add: upto_enum_step_def upto_enum_word
word_bits_def
split: split_if)
split: if_split)
apply simp
apply (rule ceqv_refl)
apply csymbr
@ -1497,7 +1496,7 @@ lemma pteCheckIfMapped_ccorres:
apply (case_tac rv, simp_all add: to_bool_def isInvalidPTE_def pte_tag_defs pte_pte_invalid_def
cpte_relation_def pte_pte_large_lift_def pte_get_tag_def
pte_lift_def Let_def
split: split_if_asm)
split: if_split_asm)
done
lemma cpde_relation_invalid:
@ -1523,7 +1522,7 @@ lemma pdeCheckIfMapped_ccorres:
apply (rule conseqPre, vcg)
apply (clarsimp simp: typ_heap_simps' return_def)
apply (case_tac rv, simp_all add: to_bool_def cpde_relation_invalid isInvalidPDE_def
split: split_if)
split: if_split)
done
lemma mapping_two_power_16_64_inequality:
@ -1775,7 +1774,7 @@ lemma createMappingEntries_valid_pde_slots'2:
apply (erule less_kernelBase_valid_pde_offset'[unfolded pdBits_def pageBits_def, simplified],
simp+)
apply (clarsimp simp:upto_enum_step_def
split: split_if)
split: if_split)
apply (clarsimp simp: upto_enum_def upt_conv_Cons[where i=0]
lookup_pd_slot_eq[unfolded pd_bits_def pageBits_def, simplified])
apply (rule context_conjI)
@ -2237,7 +2236,7 @@ lemmas vmsz_aligned_addrFromPPtr
lemma gen_framesize_to_H_eq_from_H':
"v < 4 \<Longrightarrow> (v' = gen_framesize_to_H v) = (framesize_from_H v' = v)"
apply (simp add: gen_framesize_to_H_def framesize_from_H_eqs
split: split_if)
split: if_split)
apply (clarsimp simp: framesize_from_H_eqs[symmetric] vm_page_size_defs)
apply unat_arith
done
@ -2258,7 +2257,7 @@ lemma framesize_from_H_eq_eq:
apply (clarsimp simp: framesize_from_to_H)
apply (simp add: framesize_from_H_def vm_page_size_defs split: vmpage_size.split)
apply (clarsimp simp: gen_framesize_to_H_eq_from_H)
apply (simp add: gen_framesize_to_H_def framesize_from_H_def split: split_if)
apply (simp add: gen_framesize_to_H_def framesize_from_H_def split: if_split)
apply (clarsimp simp: vm_page_size_defs)
apply unat_arith
done
@ -2295,13 +2294,13 @@ lemma generic_frame_cap_set_capFMappedAddress_ccap_relation:
\<Longrightarrow> ccap_relation (capCap_update (capVPMappedAddress_update (\<lambda>_. Some (asid, addr))) c) c''"
apply (clarsimp simp: isCap_simps)
apply (erule ccap_relationE)
apply (clarsimp simp: cap_to_H_def Let_def split: cap_CL.split_asm split_if_asm)
apply (clarsimp simp: cap_to_H_def Let_def split: cap_CL.split_asm if_split_asm)
apply (simp_all add: ccap_relation_def generic_frame_cap_set_capFMappedAddress_CL_def
cap_to_H_def c_valid_cap_def cl_valid_cap_def
generic_frame_cap_get_capFSize_CL_def
shiftr_asid_low_bits_mask_asid_high_bits
and_not_mask[symmetric] shiftr_asid_low_bits_mask_eq_0
split: split_if)
split: if_split)
apply (simp add: vmsz_aligned'_def gen_framesize_to_H_def)
apply (subst field_simps, simp add: word_plus_and_or_coroll2)
apply (simp add: vmsz_aligned'_def gen_framesize_to_H_def)
@ -2309,11 +2308,11 @@ lemma generic_frame_cap_set_capFMappedAddress_ccap_relation:
apply (simp add: vmsz_aligned'_def gen_framesize_to_H_def)
apply (subst field_simps, simp add: word_plus_and_or_coroll2)
apply (rule sym, erule is_aligned_neg_mask)
apply (simp add: pageBitsForSize_def split: split_if)
apply (simp add: pageBitsForSize_def split: if_split)
apply (simp add: vmsz_aligned'_def gen_framesize_to_H_def)
apply (subst field_simps, simp add: word_plus_and_or_coroll2)
apply (rule sym, erule is_aligned_neg_mask)
apply (simp add: pageBitsForSize_def split: split_if)
apply (simp add: pageBitsForSize_def split: if_split)
done
lemma slotcap_in_mem_valid:
@ -2444,7 +2443,7 @@ lemma setVMRootForFlush_ccorres2:
apply (clarsimp simp: isCap_simps(2) cap_get_tag_isCap_ArchObject[symmetric])
apply (clarsimp simp: cap_page_directory_cap_lift cap_to_H_def
elim!: ccap_relationE)
apply (simp add: to_bool_def split: split_if)
apply (simp add: to_bool_def split: if_split)
apply (auto simp: cap_get_tag_isCap_ArchObject2)
done
@ -2473,7 +2472,7 @@ lemma pte_get_tag_alt:
\<Longrightarrow> pte_get_tag v = (case pteC of
Pte_pte_small _ \<Rightarrow> scast pte_pte_small
| Pte_pte_large _ \<Rightarrow> scast pte_pte_large)"
by (auto simp add: pte_lift_def Let_def split: split_if_asm)
by (auto simp add: pte_lift_def Let_def split: if_split_asm)
definition
to_option :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a option"
@ -2834,7 +2833,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply (clarsimp simp: if_1_0_0)
apply (clarsimp simp: cap_lift_page_directory_cap cap_to_H_def
to_bool_def cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (simp add: throwError_bind invocationCatch_def)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
@ -3085,7 +3084,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply (clarsimp simp: if_1_0_0)
apply (clarsimp simp: cap_lift_page_directory_cap cap_to_H_def
to_bool_def cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (simp add: throwError_bind invocationCatch_def)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
@ -3107,7 +3106,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply vcg
apply (clarsimp simp: cap_lift_page_directory_cap cap_to_H_def
to_bool_def cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
apply csymbr+
@ -3261,7 +3260,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply (subgoal_tac "cap_get_tag cap \<in> {scast cap_small_frame_cap, scast cap_frame_cap}")
prefer 2
apply (clarsimp simp: cap_to_H_def cap_lift_def Let_def elim!: ccap_relationE
split: split_if_asm)
split: if_split_asm)
apply (rule conjI)
apply clarsimp
apply (frule ccap_relation_PageCap_generics)
@ -3288,8 +3287,8 @@ lemma decodeARMFrameInvocation_ccorres:
apply simp
apply (simp add: gen_framesize_to_H_def vm_page_size_defs
hd_conv_nth length_ineq_not_Nil
split: split_if)
apply (simp add: vm_page_size_defs split: split_if_asm)
split: if_split)
apply (simp add: vm_page_size_defs split: if_split_asm)
apply (clarsimp simp:signed_shift_guard_simpler_32 pbfs_less)
apply (frule ccap_relation_PageCap_generics)
apply (clarsimp simp:framesize_from_H_eq_eqs)
@ -3321,7 +3320,7 @@ lemma sts_Restart_ct_active [wp]:
apply (clarsimp simp: ct_in_state'_def)
apply (rule hoare_lift_Pf2 [where f=ksCurThread])
apply (wp sts_st_tcb')
apply (simp split: split_if)
apply (simp split: if_split)
apply wp
done
@ -3564,7 +3563,7 @@ lemma decodeARMPageDirectoryInvocation_ccorres:
apply (frule cap_get_tag_isCap_unfolded_H_cap)
apply (clarsimp simp: cap_lift_page_directory_cap
cap_to_H_def cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if)
elim!: ccap_relationE split: if_split)
apply (simp add: injection_handler_throwError)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add:syscall_error_to_H_cases)
@ -3954,7 +3953,7 @@ lemma Arch_decodeInvocation_ccorres:
linorder_not_less
order_antisym[OF inc_le])
apply (clarsimp simp: true_def false_def
split: option.split split_if)
split: option.split if_split)
apply (simp add: asid_high_bits_def word_le_nat_alt
word_less_nat_alt unat_add_lem[THEN iffD1])
apply auto[1]
@ -3975,7 +3974,7 @@ lemma Arch_decodeInvocation_ccorres:
rf_sr_armKSASIDTable[where n=0, simplified])
apply (simp add: asid_high_bits_def option_to_ptr_def option_to_0_def
from_bool_def
split: option.split split_if)
split: option.split if_split)
apply fastforce
apply ceqv
apply (rule ccorres_Guard_Seq)+
@ -4263,7 +4262,7 @@ lemma Arch_decodeInvocation_ccorres:
apply (clarsimp simp: inc_le from_bool_def typ_heap_simps
asid_low_bits_def not_less field_simps
false_def
split: split_if bool.splits)
split: if_split bool.splits)
apply unat_arith
apply (rule iffI)
apply (rule disjCI)
@ -4313,7 +4312,7 @@ lemma Arch_decodeInvocation_ccorres:
word_sless_def word_sle_def)
apply (erule cmap_relationE1[OF rf_sr_cpspace_asidpool_relation],
erule ko_at_projectKO_opt)
apply (clarsimp simp: typ_heap_simps from_bool_def split: split_if)
apply (clarsimp simp: typ_heap_simps from_bool_def split: if_split)
apply (simp add: cap_get_tag_isCap_ArchObject[symmetric])
apply (clarsimp simp: cap_lift_asid_pool_cap cap_to_H_def
cap_asid_pool_cap_lift_def false_def
@ -4473,12 +4472,12 @@ lemma Arch_decodeInvocation_ccorres:
cap_page_directory_cap_lift_def
cap_asid_pool_cap_lift_def mask_def[where n=4]
asid_shiftr_low_bits_less[unfolded mask_def asid_bits_def] word_and_le1
elim!: ccap_relationE split: split_if_asm)
elim!: ccap_relationE split: if_split_asm)
apply (clarsimp split: list.split)
apply (clarsimp simp: cap_lift_asid_pool_cap cap_lift_page_directory_cap
cap_to_H_def to_bool_def
cap_page_directory_cap_lift_def
elim!: ccap_relationE split: split_if_asm)
elim!: ccap_relationE split: if_split_asm)
done
end
end

Some files were not shown because too many files have changed in this diff Show More