Current_prop.thy
changeset 25 259a50be4381
parent 23 25e55731ed01
child 26 b6333712cb02
--- a/Current_prop.thy	Sun Jun 16 08:05:37 2013 +0800
+++ b/Current_prop.thy	Mon Jun 24 09:01:42 2013 +0800
@@ -49,7 +49,66 @@
 
 lemma info_shm_flow_in_procs:
   "\<lbrakk>info_flow_shm s p p'; valid s\<rbrakk> \<Longrightarrow> p \<in> current_procs s \<and> p' \<in> current_procs s"
-by (auto simp:info_flow_shm_def intro:procs_of_shm_prop2)
+apply (induct rule:info_flow_shm.induct )
+by (auto intro:procs_of_shm_prop2)
+
+(*********** simpset for info_flow_shm **************)
+
+lemma info_flow_shm_prop1: 
+  "\<lbrakk>info_flow_shm s p p'; p \<noteq> p'; valid s\<rbrakk> 
+   \<Longrightarrow> \<exists> h h' flag. (p, SHM_RDWR) \<in> procs_of_shm s h \<and> (p', flag) \<in> procs_of_shm s h'"
+by (induct rule: info_flow_shm.induct, auto)
+
+lemma info_flow_shm_cases:
+  "\<lbrakk>info_flow_shm \<tau> pa pb; \<And>p s. \<lbrakk>s = \<tau> ; pa = p; pb = p; p \<in> current_procs s\<rbrakk> \<Longrightarrow> P;
+  \<And>s p p' h p'' flag. \<lbrakk>s = \<tau>; pa = p; pb = p''; info_flow_shm s p p'; (p', SHM_RDWR) \<in> procs_of_shm s h;
+                       (p'', flag) \<in> procs_of_shm s h\<rbrakk>\<Longrightarrow> P\<rbrakk>
+  \<Longrightarrow> P"
+by (erule info_flow_shm.cases, auto)
+
+definition one_flow_shm :: "t_state \<Rightarrow> t_process \<Rightarrow> t_process \<Rightarrow> bool"
+where
+  "one_flow_shm s p p' \<equiv> p \<noteq> p' \<and> (\<exists> h flag. (p, SHM_RDWR) \<in> procs_of_shm s h \<and> (p', flag) \<in> procs_of_shm s h)"
+
+inductive flows_shm :: "t_state \<Rightarrow> t_process \<Rightarrow> t_process \<Rightarrow> bool"
+where
+  "p \<in> current_procs s \<Longrightarrow> flows_shm s p p"
+| "\<lbrakk>flows_shm s p p'; one_flow_shm s p' p''\<rbrakk> \<Longrightarrow> flows_shm s p p''"
+
+definition attached_procs :: "t_state \<Rightarrow> t_shm \<Rightarrow> t_process set"
+where
+  "attached_procs s h \<equiv> {p. \<exists> flag. (p, flag) \<in> procs_of_shm s h}"
+
+definition flowed_procs:: "t_state \<Rightarrow> t_shm \<Rightarrow> t_process set"
+where
+  "flowed_procs s h \<equiv> {p'. \<exists> p \<in> attached_procs s h. flows_shm s p p'}"
+
+fun Info_flow_shm :: "t_state \<Rightarrow> t_process \<Rightarrow> t_process set"
+where
+  "Info_flow_shm [] = (\<lambda> p. {p'. flows_shm [] p p'})"
+| "Info_flow_shm (Attach p h flag # s) = (\<lambda> p'. if (p' = p) then {p''. \<exists> }"
+
+
+lemma info_flow_shm_attach:
+  "valid (Attach p h flag # s) \<Longrightarrow> info_flow_shm (Attach p h flag # s) = (\<lambda> pa pb. (info_flow_shm s pa pb) \<or> 
+     (if (pa = p) 
+      then (if (flag = SHM_RDWR) 
+            then (\<exists> flag. (pb, flag) \<in> procs_of_shm s h)
+            else (pb = p)) 
+      else (if (pb = p) 
+            then (pa, SHM_RDWR) \<in> procs_of_shm s h
+            else info_flow_shm s pa pb)) )"
+apply (frule vd_cons, frule vt_grant_os, rule ext, rule ext)
+apply (case_tac "info_flow_shm s pa pb", simp)
+
+thm info_flow_shm.cases
+apply (auto split:if_splits intro:info_flow_shm.intros elim:info_flow_shm_cases)
+apply (erule info_flow_shm_cases, simp, simp split:if_splits)
+apply (rule_tac p = pa and p' = p' in info_flow_shm.intros(2), simp+)
+apply (rule notI, erule info_flow_shm.cases, simp+)
+pr 5
+
+lemmas info_flow_shm_simps = info_flow_shm_other
 
 lemma has_same_inode_in_current:
   "\<lbrakk>has_same_inode s f f'; valid s\<rbrakk> \<Longrightarrow> f \<in> current_files s \<and> f' \<in> current_files s"