HoareParallel Theories
authorprensani
Tue Mar 05 17:11:25 2002 +0100 (2002-03-05)
changeset 13020791e3b4c4039
parent 13019 98f0a09a33c3
child 13021 cd0075346431
HoareParallel Theories
src/HOL/HoareParallel/Gar_Coll.thy
src/HOL/HoareParallel/Graph.thy
src/HOL/HoareParallel/Mul_Gar_Coll.thy
src/HOL/HoareParallel/OG_Com.thy
src/HOL/HoareParallel/OG_Examples.thy
src/HOL/HoareParallel/OG_Hoare.thy
src/HOL/HoareParallel/OG_Syntax.thy
src/HOL/HoareParallel/OG_Tactics.thy
src/HOL/HoareParallel/OG_Tran.thy
src/HOL/HoareParallel/Quote_Antiquote.thy
src/HOL/HoareParallel/RG_Com.thy
src/HOL/HoareParallel/RG_Examples.thy
src/HOL/HoareParallel/RG_Hoare.thy
src/HOL/HoareParallel/RG_Syntax.thy
src/HOL/HoareParallel/RG_Tran.thy
src/HOL/HoareParallel/ROOT.ML
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/HoareParallel/Gar_Coll.thy	Tue Mar 05 17:11:25 2002 +0100
     1.3 @@ -0,0 +1,880 @@
     1.4 +
     1.5 +header {* \section{The Single Mutator Case} *}
     1.6 +
     1.7 +theory Gar_Coll = Graph + OG_Syntax:
     1.8 +
     1.9 +text {* Declaration of variables: *}
    1.10 +
    1.11 +record gar_coll_state =
    1.12 +  M :: nodes
    1.13 +  E :: edges
    1.14 +  bc :: "nat set"
    1.15 +  obc :: "nat set"
    1.16 +  Ma :: nodes
    1.17 +  ind :: nat 
    1.18 +  k :: nat
    1.19 +  z :: bool
    1.20 +
    1.21 +subsection {* The Mutator *}
    1.22 +
    1.23 +text {* The mutator first redirects an arbitrary edge @{text "R"} from
    1.24 +an arbitrary accessible node towards an arbitrary accessible node
    1.25 +@{text "T"}.  It then colors the new target @{text "T"} black. 
    1.26 +
    1.27 +We declare the arbitrarily selected node and edge as constants:*}
    1.28 +
    1.29 +consts R :: nat  T :: nat
    1.30 +
    1.31 +text {* \noindent The following predicate states, given a list of
    1.32 +nodes @{text "m"} and a list of edges @{text "e"}, the conditions
    1.33 +under which the selected edge @{text "R"} and node @{text "T"} are
    1.34 +valid: *}
    1.35 +
    1.36 +constdefs
    1.37 +  Mut_init :: "gar_coll_state \<Rightarrow> bool"
    1.38 +  "Mut_init \<equiv> \<guillemotleft> T \<in> Reach \<acute>E \<and> R < length \<acute>E \<and> T < length \<acute>M \<guillemotright>"
    1.39 +
    1.40 +text {* \noindent For the mutator we
    1.41 +consider two modules, one for each action.  An auxiliary variable
    1.42 +@{text "\<acute>z"} is set to false if the mutator has already redirected an
    1.43 +edge but has not yet colored the new target.   *}
    1.44 +
    1.45 +constdefs
    1.46 +  Redirect_Edge :: "gar_coll_state ann_com"
    1.47 +  "Redirect_Edge \<equiv> .{\<acute>Mut_init \<and> \<acute>z}. \<langle>\<acute>E:=\<acute>E[R:=(fst(\<acute>E!R), T)],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
    1.48 +
    1.49 +  Color_Target :: "gar_coll_state ann_com"
    1.50 +  "Color_Target \<equiv> .{\<acute>Mut_init \<and> \<not>\<acute>z}. \<langle>\<acute>M:=\<acute>M[T:=Black],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
    1.51 +
    1.52 +  Mutator :: "gar_coll_state ann_com"
    1.53 +  "Mutator \<equiv>
    1.54 +  .{\<acute>Mut_init \<and> \<acute>z}. 
    1.55 +  WHILE True INV .{\<acute>Mut_init \<and> \<acute>z}. 
    1.56 +  DO  Redirect_Edge ;; Color_Target  OD"
    1.57 +
    1.58 +subsubsection {* Correctness of the mutator *}
    1.59 +
    1.60 +lemmas mutator_defs = Mut_init_def Redirect_Edge_def Color_Target_def
    1.61 +
    1.62 +lemma Redirect_Edge: 
    1.63 +  "\<turnstile> Redirect_Edge pre(Color_Target)"
    1.64 +apply (unfold mutator_defs)
    1.65 +apply annhoare
    1.66 +apply(simp_all)
    1.67 +apply(force elim:Graph2)
    1.68 +done
    1.69 +
    1.70 +lemma Color_Target:
    1.71 +  "\<turnstile> Color_Target .{\<acute>Mut_init \<and> \<acute>z}."
    1.72 +apply (unfold mutator_defs)
    1.73 +apply annhoare
    1.74 +apply(simp_all)
    1.75 +done
    1.76 +
    1.77 +lemma Mutator: 
    1.78 + "\<turnstile> Mutator .{False}."
    1.79 +apply(unfold Mutator_def)
    1.80 +apply annhoare
    1.81 +apply(simp_all add:Redirect_Edge Color_Target)
    1.82 +apply(simp add:mutator_defs Redirect_Edge_def)
    1.83 +done
    1.84 +
    1.85 +subsection {* The Collector *}
    1.86 +
    1.87 +text {* \noindent A constant @{text "M_init"} is used to give @{text "\<acute>Ma"} a
    1.88 +suitable first value, defined as a list of nodes where only the @{text
    1.89 +"Roots"} are black. *}
    1.90 +
    1.91 +consts  M_init :: nodes
    1.92 +
    1.93 +constdefs
    1.94 +  Proper_M_init :: "gar_coll_state \<Rightarrow> bool"
    1.95 +  "Proper_M_init \<equiv>  \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
    1.96 + 
    1.97 +  Proper :: "gar_coll_state \<Rightarrow> bool"
    1.98 +  "Proper \<equiv> \<guillemotleft> Proper_Roots \<acute>M \<and> Proper_Edges(\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<guillemotright>"
    1.99 +
   1.100 +  Safe :: "gar_coll_state \<Rightarrow> bool"
   1.101 +  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
   1.102 +
   1.103 +lemmas collector_defs = Proper_M_init_def Proper_def Safe_def
   1.104 +
   1.105 +subsubsection {* Blackening the roots *}
   1.106 +
   1.107 +constdefs
   1.108 +  Blacken_Roots :: " gar_coll_state ann_com"
   1.109 +  "Blacken_Roots \<equiv> 
   1.110 +  .{\<acute>Proper}.
   1.111 +  \<acute>ind:=0;;
   1.112 +  .{\<acute>Proper \<and> \<acute>ind=0}.
   1.113 +  WHILE \<acute>ind<length \<acute>M 
   1.114 +   INV .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
   1.115 +  DO .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
   1.116 +   IF \<acute>ind\<in>Roots THEN 
   1.117 +   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<in>Roots}. 
   1.118 +    \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
   1.119 +   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind+1. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
   1.120 +    \<acute>ind:=\<acute>ind+1 
   1.121 +  OD"
   1.122 +
   1.123 +lemma Blacken_Roots: 
   1.124 + "\<turnstile> Blacken_Roots .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}."
   1.125 +apply (unfold Blacken_Roots_def)
   1.126 +apply annhoare
   1.127 +apply(simp_all add:collector_defs Graph_defs)
   1.128 +apply safe
   1.129 +apply(simp_all add:nth_list_update)
   1.130 +   apply (erule less_SucE)
   1.131 +    apply simp+
   1.132 +  apply (erule less_SucE)
   1.133 +   apply simp+
   1.134 + apply(drule le_imp_less_or_eq)
   1.135 + apply force
   1.136 +apply force
   1.137 +done
   1.138 +
   1.139 +subsubsection {* Propagating black *}
   1.140 +
   1.141 +constdefs
   1.142 +  PBInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   1.143 +  "PBInv \<equiv> \<guillemotleft> \<lambda>ind. \<acute>obc < Blacks \<acute>M \<or> (\<forall>i <ind. \<not>BtoW (\<acute>E!i, \<acute>M) \<or>
   1.144 +   (\<not>\<acute>z \<and> i=R \<and> (snd(\<acute>E!R)) = T \<and> (\<exists>r. ind \<le> r \<and> r < length \<acute>E \<and> BtoW(\<acute>E!r,\<acute>M))))\<guillemotright>"
   1.145 +
   1.146 +constdefs  
   1.147 +  Propagate_Black_aux :: "gar_coll_state ann_com"
   1.148 +  "Propagate_Black_aux \<equiv>
   1.149 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
   1.150 +  \<acute>ind:=0;;
   1.151 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> \<acute>ind=0}. 
   1.152 +  WHILE \<acute>ind<length \<acute>E 
   1.153 +   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.154 +         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
   1.155 +  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.156 +       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
   1.157 +   IF \<acute>M!(fst (\<acute>E!\<acute>ind)) = Black THEN 
   1.158 +    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.159 +       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black}.
   1.160 +     \<acute>M:=\<acute>M[snd(\<acute>E!\<acute>ind):=Black];;
   1.161 +    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.162 +       \<and> \<acute>PBInv (\<acute>ind + 1) \<and> \<acute>ind<length \<acute>E}.
   1.163 +     \<acute>ind:=\<acute>ind+1
   1.164 +   FI
   1.165 +  OD"
   1.166 +
   1.167 +lemma Propagate_Black_aux: 
   1.168 +  "\<turnstile>  Propagate_Black_aux
   1.169 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.170 +    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
   1.171 +apply (unfold Propagate_Black_aux_def  PBInv_def collector_defs)
   1.172 +apply annhoare
   1.173 +apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
   1.174 +      apply force
   1.175 +     apply force
   1.176 +    apply force
   1.177 +--{* 4 subgoals left *}
   1.178 +apply clarify
   1.179 +apply(simp add:Proper_Edges_def Proper_Roots_def Graph6 Graph7 Graph8 Graph12)
   1.180 +apply (erule disjE)
   1.181 + apply(rule disjI1)
   1.182 + apply(erule Graph13)
   1.183 + apply force
   1.184 +apply (case_tac "M x ! snd (E x ! ind x)=Black")
   1.185 + apply (simp add: Graph10 BtoW_def)
   1.186 + apply (rule disjI2)
   1.187 + apply clarify
   1.188 + apply (erule less_SucE)
   1.189 +  apply (erule_tac x=i in allE , erule (1) notE impE)
   1.190 +  apply simp
   1.191 +  apply clarify
   1.192 +  apply (drule le_imp_less_or_eq)
   1.193 +  apply (erule disjE)
   1.194 +   apply (subgoal_tac "Suc (ind x)\<le>r")
   1.195 +    apply fast
   1.196 +   apply arith
   1.197 +  apply fast
   1.198 + apply fast
   1.199 +apply(rule disjI1)
   1.200 +apply(erule subset_psubset_trans)
   1.201 +apply(erule Graph11)
   1.202 +apply fast
   1.203 +--{* 3 subgoals left *}
   1.204 +apply force
   1.205 +apply force
   1.206 +--{* last *}
   1.207 +apply clarify
   1.208 +apply simp
   1.209 +apply(subgoal_tac "ind x = length (E x)")
   1.210 + apply (rotate_tac -1)
   1.211 + apply simp
   1.212 + apply(drule Graph1)
   1.213 +   apply simp
   1.214 +  apply clarify  
   1.215 + apply(erule allE, erule impE, assumption)
   1.216 +  apply force
   1.217 + apply force
   1.218 +apply arith
   1.219 +done
   1.220 +
   1.221 +subsubsection {* Refining propagating black *}
   1.222 +
   1.223 +constdefs
   1.224 +  Auxk :: "gar_coll_state \<Rightarrow> bool"
   1.225 +  "Auxk \<equiv> \<guillemotleft>\<acute>k<length \<acute>M \<and> (\<acute>M!\<acute>k\<noteq>Black \<or> \<not>BtoW(\<acute>E!\<acute>ind, \<acute>M) \<or> 
   1.226 +          \<acute>obc<Blacks \<acute>M \<or> (\<not>\<acute>z \<and> \<acute>ind=R \<and> snd(\<acute>E!R)=T  
   1.227 +          \<and> (\<exists>r. \<acute>ind<r \<and> r<length \<acute>E \<and> BtoW(\<acute>E!r, \<acute>M))))\<guillemotright>"
   1.228 +
   1.229 +constdefs  
   1.230 +  Propagate_Black :: " gar_coll_state ann_com"
   1.231 +  "Propagate_Black \<equiv>
   1.232 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
   1.233 +  \<acute>ind:=0;;
   1.234 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> \<acute>ind=0}.
   1.235 +  WHILE \<acute>ind<length \<acute>E 
   1.236 +   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.237 +         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
   1.238 +  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.239 +       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
   1.240 +   IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))=Black THEN 
   1.241 +    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.242 +      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black}.
   1.243 +     \<acute>k:=(snd(\<acute>E!\<acute>ind));;
   1.244 +    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.245 +      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black 
   1.246 +      \<and> \<acute>Auxk}.
   1.247 +     \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],, \<acute>ind:=\<acute>ind+1\<rangle>
   1.248 +   ELSE .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.249 +          \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
   1.250 +         \<langle>IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> 
   1.251 +   FI
   1.252 +  OD"
   1.253 +
   1.254 +lemma Propagate_Black: 
   1.255 +  "\<turnstile>  Propagate_Black
   1.256 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.257 +    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
   1.258 +apply (unfold Propagate_Black_def  PBInv_def Auxk_def collector_defs)
   1.259 +apply annhoare
   1.260 +apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
   1.261 +       apply force
   1.262 +      apply force
   1.263 +     apply force
   1.264 +--{* 5 subgoals left *}
   1.265 +apply clarify
   1.266 +apply(simp add:BtoW_def Proper_Edges_def)
   1.267 +--{* 4 subgoals left *}
   1.268 +apply clarify
   1.269 +apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
   1.270 +apply (erule disjE)
   1.271 + apply (rule disjI1)
   1.272 + apply (erule psubset_subset_trans)
   1.273 + apply (erule Graph9)
   1.274 +apply (case_tac "M x!k x=Black")
   1.275 + apply (case_tac "M x ! snd (E x ! ind x)=Black")
   1.276 +  apply (simp add: Graph10 BtoW_def)
   1.277 +  apply (rule disjI2)
   1.278 +  apply clarify
   1.279 +  apply (erule less_SucE)
   1.280 +   apply (erule_tac x=i in allE , erule (1) notE impE)
   1.281 +   apply simp
   1.282 +   apply clarify
   1.283 +   apply (drule le_imp_less_or_eq)
   1.284 +   apply (erule disjE)
   1.285 +    apply (subgoal_tac "Suc (ind x)\<le>r")
   1.286 +     apply fast
   1.287 +    apply arith
   1.288 +   apply fast
   1.289 +  apply fast
   1.290 + apply (simp add: Graph10 BtoW_def)
   1.291 + apply (erule disjE)
   1.292 +  apply (erule disjI1)
   1.293 + apply clarify
   1.294 + apply (erule less_SucE)
   1.295 +  apply force
   1.296 + apply simp
   1.297 + apply (subgoal_tac "Suc R\<le>r")
   1.298 +  apply fast
   1.299 + apply arith
   1.300 +apply(rule disjI1)
   1.301 +apply(erule subset_psubset_trans)
   1.302 +apply(erule Graph11)
   1.303 +apply fast
   1.304 +--{* 3 subgoals left *}
   1.305 +apply force
   1.306 +--{* 2 subgoals left *}
   1.307 +apply clarify
   1.308 +apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
   1.309 +apply (erule disjE)
   1.310 + apply fast
   1.311 +apply clarify
   1.312 +apply (erule less_SucE)
   1.313 + apply (erule_tac x=i in allE , erule (1) notE impE)
   1.314 + apply simp
   1.315 + apply clarify
   1.316 + apply (drule le_imp_less_or_eq)
   1.317 + apply (erule disjE)
   1.318 +  apply (subgoal_tac "Suc (ind x)\<le>r")
   1.319 +   apply fast
   1.320 +  apply arith
   1.321 + apply (simp add: BtoW_def)
   1.322 +apply (simp add: BtoW_def)
   1.323 +--{* last *}
   1.324 +apply clarify
   1.325 +apply simp
   1.326 +apply(subgoal_tac "ind x = length (E x)")
   1.327 + apply (rotate_tac -1)
   1.328 + apply simp
   1.329 + apply(drule Graph1)
   1.330 +   apply simp
   1.331 +  apply clarify  
   1.332 + apply(erule allE, erule impE, assumption)
   1.333 +  apply force
   1.334 + apply force
   1.335 +apply arith
   1.336 +done
   1.337 +
   1.338 +subsubsection {* Counting black nodes *}
   1.339 +
   1.340 +constdefs
   1.341 +  CountInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   1.342 +  "CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
   1.343 +
   1.344 +constdefs
   1.345 +  Count :: " gar_coll_state ann_com"
   1.346 +  "Count \<equiv>
   1.347 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.348 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.349 +    \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={}}.
   1.350 +  \<acute>ind:=0;;
   1.351 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.352 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.353 +   \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={} 
   1.354 +   \<and> \<acute>ind=0}.
   1.355 +   WHILE \<acute>ind<length \<acute>M 
   1.356 +     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.357 +           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.358 +           \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
   1.359 +           \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind\<le>length \<acute>M}.
   1.360 +   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.361 +         \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.362 +         \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind 
   1.363 +         \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}. 
   1.364 +       IF \<acute>M!\<acute>ind=Black 
   1.365 +          THEN .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.366 +                 \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.367 +                 \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
   1.368 +                 \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
   1.369 +          \<acute>bc:=insert \<acute>ind \<acute>bc
   1.370 +       FI;;
   1.371 +      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.372 +        \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.373 +        \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv (\<acute>ind+1)
   1.374 +        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}.
   1.375 +      \<acute>ind:=\<acute>ind+1
   1.376 +   OD"
   1.377 +
   1.378 +lemma Count: 
   1.379 +  "\<turnstile> Count 
   1.380 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.381 +   \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M
   1.382 +   \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}."
   1.383 +apply(unfold Count_def)
   1.384 +apply annhoare
   1.385 +apply(simp_all add:CountInv_def Graph6 Graph7 Graph8 Graph12 Blacks_def collector_defs)
   1.386 +      apply force
   1.387 +     apply force
   1.388 +    apply force
   1.389 +   apply clarify
   1.390 +   apply simp
   1.391 +   apply(fast elim:less_SucE)
   1.392 +  apply clarify
   1.393 +  apply simp
   1.394 +  apply(fast elim:less_SucE)
   1.395 + apply force
   1.396 +apply force
   1.397 +done
   1.398 +
   1.399 +subsubsection {* Appending garbage nodes to the free list *}
   1.400 +
   1.401 +consts Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
   1.402 +
   1.403 +axioms
   1.404 +  Append_to_free0: "length (Append_to_free (i, e)) = length e"
   1.405 +  Append_to_free1: "Proper_Edges (m, e) 
   1.406 +                   \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
   1.407 +  Append_to_free2: "i \<notin> Reach e 
   1.408 +     \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
   1.409 +
   1.410 +constdefs
   1.411 +  AppendInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   1.412 +  "AppendInv \<equiv> \<guillemotleft>\<lambda>ind. \<forall>i<length \<acute>M. ind\<le>i \<longrightarrow> i\<in>Reach \<acute>E \<longrightarrow> \<acute>M!i=Black\<guillemotright>"
   1.413 +
   1.414 +constdefs
   1.415 +  Append :: " gar_coll_state ann_com"
   1.416 +   "Append \<equiv>
   1.417 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
   1.418 +  \<acute>ind:=0;;
   1.419 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
   1.420 +    WHILE \<acute>ind<length \<acute>M 
   1.421 +      INV .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
   1.422 +    DO .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
   1.423 +       IF \<acute>M!\<acute>ind=Black THEN 
   1.424 +          .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
   1.425 +          \<acute>M:=\<acute>M[\<acute>ind:=White] 
   1.426 +       ELSE .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}.
   1.427 +              \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
   1.428 +       FI;;
   1.429 +     .{\<acute>Proper \<and> \<acute>AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
   1.430 +       \<acute>ind:=\<acute>ind+1
   1.431 +    OD"
   1.432 +
   1.433 +lemma Append: 
   1.434 +  "\<turnstile> Append .{\<acute>Proper}."
   1.435 +apply(unfold Append_def AppendInv_def)
   1.436 +apply annhoare
   1.437 +apply(simp_all add:collector_defs Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
   1.438 +       apply(force simp:Blacks_def nth_list_update)
   1.439 +      apply force
   1.440 +     apply force
   1.441 +    apply(force simp add:Graph_defs)
   1.442 +   apply force
   1.443 +  apply clarify
   1.444 +  apply simp
   1.445 +  apply(rule conjI)
   1.446 +   apply (erule Append_to_free1)
   1.447 +  apply clarify
   1.448 +  apply (drule_tac n = "i" in Append_to_free2)
   1.449 +  apply force
   1.450 + apply force
   1.451 +apply force
   1.452 +done
   1.453 +
   1.454 +subsubsection {* Correctness of the Collector *}
   1.455 +
   1.456 +constdefs 
   1.457 +  Collector :: " gar_coll_state ann_com"
   1.458 +  "Collector \<equiv>
   1.459 +.{\<acute>Proper}.  
   1.460 + WHILE True INV .{\<acute>Proper}. 
   1.461 + DO  
   1.462 +  Blacken_Roots;; 
   1.463 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}.  
   1.464 +   \<acute>obc:={};; 
   1.465 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}. 
   1.466 +   \<acute>bc:=Roots;; 
   1.467 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
   1.468 +   \<acute>Ma:=M_init;;  
   1.469 +  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>Ma=M_init}. 
   1.470 +   WHILE \<acute>obc\<noteq>\<acute>bc  
   1.471 +     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
   1.472 +           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.473 +           \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}. 
   1.474 +   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
   1.475 +       \<acute>obc:=\<acute>bc;;
   1.476 +       Propagate_Black;; 
   1.477 +      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   1.478 +        \<and> (\<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}. 
   1.479 +       \<acute>Ma:=\<acute>M;;
   1.480 +      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma 
   1.481 +        \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M 
   1.482 +        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}.
   1.483 +       \<acute>bc:={};;
   1.484 +       Count 
   1.485 +   OD;; 
   1.486 +  Append  
   1.487 + OD"
   1.488 +
   1.489 +lemma Collector: 
   1.490 +  "\<turnstile> Collector .{False}."
   1.491 +apply(unfold Collector_def)
   1.492 +apply annhoare
   1.493 +apply(simp_all add: Blacken_Roots Propagate_Black Count Append)
   1.494 +apply(simp_all add:Blacken_Roots_def Propagate_Black_def Count_def Append_def collector_defs)
   1.495 +   apply (force simp add: Proper_Roots_def)
   1.496 +  apply force
   1.497 + apply force
   1.498 +apply clarify
   1.499 +apply (erule disjE)
   1.500 +apply(simp add:psubsetI)
   1.501 + apply(force dest:subset_antisym)
   1.502 +apply force
   1.503 +done
   1.504 +
   1.505 +subsection {* Interference Freedom *}
   1.506 +
   1.507 +lemmas modules = Redirect_Edge_def Color_Target_def Blacken_Roots_def 
   1.508 +                 Propagate_Black_def Count_def Append_def
   1.509 +lemmas Invariants = PBInv_def Auxk_def CountInv_def AppendInv_def
   1.510 +lemmas abbrev = collector_defs mutator_defs Invariants
   1.511 +
   1.512 +lemma interfree_Blacken_Roots_Redirect_Edge: 
   1.513 + "interfree_aux (Some Blacken_Roots, {}, Some Redirect_Edge)"
   1.514 +apply (unfold modules)
   1.515 +apply interfree_aux
   1.516 +apply safe
   1.517 +apply (simp_all add:Graph6 Graph12 abbrev)
   1.518 +done
   1.519 +
   1.520 +lemma interfree_Redirect_Edge_Blacken_Roots: 
   1.521 +  "interfree_aux (Some Redirect_Edge, {}, Some Blacken_Roots)"
   1.522 +apply (unfold modules)
   1.523 +apply interfree_aux
   1.524 +apply safe
   1.525 +apply(simp add:abbrev)+
   1.526 +done
   1.527 +
   1.528 +lemma interfree_Blacken_Roots_Color_Target: 
   1.529 +  "interfree_aux (Some Blacken_Roots, {}, Some Color_Target)"
   1.530 +apply (unfold modules)
   1.531 +apply interfree_aux
   1.532 +apply safe
   1.533 +apply(simp_all add:Graph7 Graph8 nth_list_update abbrev)
   1.534 +done
   1.535 +
   1.536 +lemma interfree_Color_Target_Blacken_Roots: 
   1.537 +  "interfree_aux (Some Color_Target, {}, Some Blacken_Roots)"
   1.538 +apply (unfold modules )
   1.539 +apply interfree_aux
   1.540 +apply safe
   1.541 +apply(simp add:abbrev)+
   1.542 +done
   1.543 +
   1.544 +lemma interfree_Propagate_Black_Redirect_Edge: 
   1.545 +  "interfree_aux (Some Propagate_Black, {}, Some Redirect_Edge)"
   1.546 +apply (unfold modules )
   1.547 +apply interfree_aux
   1.548 +--{* 11 subgoals left *}
   1.549 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.550 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.551 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.552 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.553 +apply(erule conjE)+
   1.554 +apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
   1.555 + apply(erule Graph4) 
   1.556 +   apply(simp)+
   1.557 +  apply (simp add:BtoW_def)
   1.558 + apply (simp add:BtoW_def)
   1.559 +apply(rule conjI)
   1.560 + apply (force simp add:BtoW_def)
   1.561 +apply(erule Graph4)
   1.562 +   apply simp+
   1.563 +  apply (simp add:BtoW_def)
   1.564 +  apply force
   1.565 + apply (simp add:BtoW_def)
   1.566 + apply force
   1.567 +apply (simp add:BtoW_def)
   1.568 +apply force
   1.569 +--{* 7 subgoals left *}
   1.570 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.571 +apply(erule conjE)+
   1.572 +apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
   1.573 + apply(erule Graph4) 
   1.574 +   apply(simp)+
   1.575 +  apply (simp add:BtoW_def)
   1.576 + apply (simp add:BtoW_def)
   1.577 +apply(rule conjI)
   1.578 + apply (force simp add:BtoW_def)
   1.579 +apply(erule Graph4)
   1.580 +   apply simp+
   1.581 +  apply (simp add:BtoW_def)
   1.582 +  apply force
   1.583 + apply (simp add:BtoW_def)
   1.584 + apply force
   1.585 +apply (simp add:BtoW_def)
   1.586 +apply force
   1.587 +--{* 6 subgoals left *}
   1.588 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.589 +apply(erule conjE)+
   1.590 +apply(rule conjI)
   1.591 + apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
   1.592 +  apply(erule Graph4) 
   1.593 +    apply(simp)+
   1.594 +   apply (simp add:BtoW_def)
   1.595 +  apply (simp add:BtoW_def)
   1.596 + apply(rule conjI)
   1.597 +  apply (force simp add:BtoW_def)
   1.598 + apply(erule Graph4)
   1.599 +    apply simp+
   1.600 +   apply (simp add:BtoW_def)
   1.601 +   apply force
   1.602 +  apply (simp add:BtoW_def)
   1.603 +  apply force
   1.604 + apply (simp add:BtoW_def)
   1.605 + apply force
   1.606 +apply(simp add:BtoW_def nth_list_update) 
   1.607 +apply force
   1.608 +--{* 5 subgoals left *}
   1.609 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.610 +--{* 4 subgoals left *}
   1.611 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.612 +apply(rule conjI)
   1.613 + apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
   1.614 +  apply(erule Graph4) 
   1.615 +    apply(simp)+
   1.616 +   apply (simp add:BtoW_def)
   1.617 +  apply (simp add:BtoW_def)
   1.618 + apply(rule conjI)
   1.619 +  apply (force simp add:BtoW_def)
   1.620 + apply(erule Graph4)
   1.621 +    apply simp+
   1.622 +   apply (simp add:BtoW_def)
   1.623 +   apply force
   1.624 +  apply (simp add:BtoW_def)
   1.625 +  apply force
   1.626 + apply (simp add:BtoW_def)
   1.627 + apply force
   1.628 +apply(rule conjI)
   1.629 + apply(simp add:nth_list_update)
   1.630 + apply force
   1.631 +apply(rule impI, rule impI, erule disjE, erule disjI1, case_tac "R = (ind x)" ,case_tac "M x ! T = Black")
   1.632 +  apply(force simp add:BtoW_def)
   1.633 + apply(case_tac "M x !snd (E x ! ind x)=Black")
   1.634 +  apply(rule disjI2)
   1.635 +  apply simp
   1.636 +  apply (erule Graph5)
   1.637 +  apply simp+
   1.638 + apply(force simp add:BtoW_def)
   1.639 +apply(force simp add:BtoW_def)
   1.640 +--{* 3 subgoals left *}
   1.641 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.642 +--{* 2 subgoals left *}
   1.643 +apply(clarify, simp add:abbrev Graph6 Graph12)
   1.644 +apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
   1.645 + apply clarify
   1.646 + apply(erule Graph4) 
   1.647 +   apply(simp)+
   1.648 +  apply (simp add:BtoW_def)
   1.649 + apply (simp add:BtoW_def)
   1.650 +apply(rule conjI)
   1.651 + apply (force simp add:BtoW_def)
   1.652 +apply(erule Graph4)
   1.653 +   apply simp+
   1.654 +  apply (simp add:BtoW_def)
   1.655 +  apply force
   1.656 + apply (simp add:BtoW_def)
   1.657 + apply force
   1.658 +apply (simp add:BtoW_def)
   1.659 +apply force
   1.660 +--{* 1 subgoals left *}
   1.661 +apply(simp add:abbrev)
   1.662 +done
   1.663 +
   1.664 +lemma interfree_Redirect_Edge_Propagate_Black: 
   1.665 +  "interfree_aux (Some Redirect_Edge, {}, Some Propagate_Black)"
   1.666 +apply (unfold modules )
   1.667 +apply interfree_aux
   1.668 +apply(clarify, simp add:abbrev)+
   1.669 +done
   1.670 +
   1.671 +lemma interfree_Propagate_Black_Color_Target: 
   1.672 +  "interfree_aux (Some Propagate_Black, {}, Some Color_Target)"
   1.673 +apply (unfold modules )
   1.674 +apply interfree_aux
   1.675 +--{* 11 subgoals left *}
   1.676 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)+
   1.677 +apply(erule conjE)+
   1.678 +apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
   1.679 +      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
   1.680 +      erule allE, erule impE, assumption, erule impE, assumption, 
   1.681 +      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
   1.682 +--{* 7 subgoals left *}
   1.683 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.684 +apply(erule conjE)+
   1.685 +apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
   1.686 +      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
   1.687 +      erule allE, erule impE, assumption, erule impE, assumption, 
   1.688 +      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
   1.689 +--{* 6 subgoals left *}
   1.690 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.691 +apply clarify
   1.692 +apply (rule conjI)
   1.693 + apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
   1.694 +      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
   1.695 +      erule allE, erule impE, assumption, erule impE, assumption, 
   1.696 +      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
   1.697 +apply(simp add:nth_list_update)
   1.698 +--{* 5 subgoals left *}
   1.699 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.700 +--{* 4 subgoals left *}
   1.701 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.702 +apply (rule conjI)
   1.703 + apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
   1.704 +      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
   1.705 +      erule allE, erule impE, assumption, erule impE, assumption, 
   1.706 +      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
   1.707 +apply(rule conjI)
   1.708 +apply(simp add:nth_list_update)
   1.709 +apply(rule impI,rule impI, case_tac "M x!T=Black",rotate_tac -1, force simp add: BtoW_def Graph10, 
   1.710 +      erule subset_psubset_trans, erule Graph11, force)
   1.711 +--{* 3 subgoals left *}
   1.712 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.713 +--{* 2 subgoals left *}
   1.714 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.715 +apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
   1.716 +      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
   1.717 +      erule allE, erule impE, assumption, erule impE, assumption, 
   1.718 +      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
   1.719 +--{* 3 subgoals left *}
   1.720 +apply(simp add:abbrev)
   1.721 +done
   1.722 +
   1.723 +lemma interfree_Color_Target_Propagate_Black: 
   1.724 +  "interfree_aux (Some Color_Target, {}, Some Propagate_Black)"
   1.725 +apply (unfold modules )
   1.726 +apply interfree_aux
   1.727 +apply(clarify, simp add:abbrev)+
   1.728 +done
   1.729 +
   1.730 +lemma interfree_Count_Redirect_Edge: 
   1.731 +  "interfree_aux (Some Count, {}, Some Redirect_Edge)"
   1.732 +apply (unfold modules)
   1.733 +apply interfree_aux
   1.734 +--{* 9 subgoals left *}
   1.735 +apply(simp_all add:abbrev Graph6 Graph12)
   1.736 +--{* 6 subgoals left *}
   1.737 +apply(clarify, simp add:abbrev Graph6 Graph12,
   1.738 +      erule disjE,erule disjI1,rule disjI2,rule subset_trans, erule Graph3,force,force)+
   1.739 +done
   1.740 +
   1.741 +lemma interfree_Redirect_Edge_Count: 
   1.742 +  "interfree_aux (Some Redirect_Edge, {}, Some Count)"
   1.743 +apply (unfold modules )
   1.744 +apply interfree_aux
   1.745 +apply(clarify,simp add:abbrev)+
   1.746 +apply(simp add:abbrev)
   1.747 +done
   1.748 +
   1.749 +lemma interfree_Count_Color_Target: 
   1.750 +  "interfree_aux (Some Count, {}, Some Color_Target)"
   1.751 +apply (unfold modules )
   1.752 +apply interfree_aux
   1.753 +--{* 9 subgoals left *}
   1.754 +apply(simp_all add:abbrev Graph7 Graph8 Graph12)
   1.755 +--{* 6 subgoals left *}
   1.756 +apply(clarify,simp add:abbrev Graph7 Graph8 Graph12,
   1.757 +      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)+
   1.758 +--{* 2 subgoals left *}
   1.759 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
   1.760 +apply(rule conjI)
   1.761 + apply(erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9) 
   1.762 +apply(simp add:nth_list_update)
   1.763 +--{* 1 subgoals left *}
   1.764 +apply(clarify, simp add:abbrev Graph7 Graph8 Graph12,
   1.765 +      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)
   1.766 +done
   1.767 +
   1.768 +lemma interfree_Color_Target_Count: 
   1.769 +  "interfree_aux (Some Color_Target, {}, Some Count)"
   1.770 +apply (unfold modules )
   1.771 +apply interfree_aux
   1.772 +apply(clarify, simp add:abbrev)+
   1.773 +apply(simp add:abbrev)
   1.774 +done
   1.775 +
   1.776 +lemma interfree_Append_Redirect_Edge: 
   1.777 +  "interfree_aux (Some Append, {}, Some Redirect_Edge)"
   1.778 +apply (unfold modules )
   1.779 +apply interfree_aux
   1.780 +apply( simp_all add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12)
   1.781 +apply(clarify, simp add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12, force dest:Graph3)+
   1.782 +done
   1.783 +
   1.784 +lemma interfree_Redirect_Edge_Append: 
   1.785 +  "interfree_aux (Some Redirect_Edge, {}, Some Append)"
   1.786 +apply (unfold modules )
   1.787 +apply interfree_aux
   1.788 +apply(clarify, simp add:abbrev Append_to_free0)+
   1.789 +apply (force simp add: Append_to_free2)
   1.790 +apply(clarify, simp add:abbrev Append_to_free0)+
   1.791 +done
   1.792 +
   1.793 +lemma interfree_Append_Color_Target: 
   1.794 +  "interfree_aux (Some Append, {}, Some Color_Target)"
   1.795 +apply (unfold modules )
   1.796 +apply interfree_aux
   1.797 +apply(clarify, simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)+
   1.798 +apply(simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)
   1.799 +done
   1.800 +
   1.801 +lemma interfree_Color_Target_Append: 
   1.802 +  "interfree_aux (Some Color_Target, {}, Some Append)"
   1.803 +apply (unfold modules )
   1.804 +apply interfree_aux
   1.805 +apply(clarify, simp add:abbrev Append_to_free0)+
   1.806 +apply (force simp add: Append_to_free2)
   1.807 +apply(clarify,simp add:abbrev Append_to_free0)+
   1.808 +done
   1.809 +
   1.810 +lemmas collector_mutator_interfree = 
   1.811 + interfree_Blacken_Roots_Redirect_Edge interfree_Blacken_Roots_Color_Target 
   1.812 + interfree_Propagate_Black_Redirect_Edge interfree_Propagate_Black_Color_Target  
   1.813 + interfree_Count_Redirect_Edge interfree_Count_Color_Target 
   1.814 + interfree_Append_Redirect_Edge interfree_Append_Color_Target 
   1.815 + interfree_Redirect_Edge_Blacken_Roots interfree_Color_Target_Blacken_Roots 
   1.816 + interfree_Redirect_Edge_Propagate_Black interfree_Color_Target_Propagate_Black  
   1.817 + interfree_Redirect_Edge_Count interfree_Color_Target_Count 
   1.818 + interfree_Redirect_Edge_Append interfree_Color_Target_Append
   1.819 +
   1.820 +subsubsection {* Interference freedom Collector-Mutator *}
   1.821 +
   1.822 +lemma interfree_Collector_Mutator:
   1.823 + "interfree_aux (Some Collector, {}, Some Mutator)"
   1.824 +apply(unfold Collector_def Mutator_def)
   1.825 +apply interfree_aux
   1.826 +apply(simp_all add:collector_mutator_interfree)
   1.827 +apply(unfold modules collector_defs mutator_defs)
   1.828 +apply(tactic  {* TRYALL (interfree_aux_tac) *})
   1.829 +--{* 32 subgoals left *}
   1.830 +apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
   1.831 +--{* 20 subgoals left *}
   1.832 +apply(tactic{* TRYALL Clarify_tac *})
   1.833 +apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
   1.834 +apply(tactic {* TRYALL (etac disjE) *})
   1.835 +apply simp_all
   1.836 +apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac subset_trans,etac (thm "Graph3"),Force_tac, assume_tac]) *})
   1.837 +apply(tactic {* TRYALL(EVERY'[rtac disjI2,etac subset_trans,rtac (thm "Graph9"),Force_tac]) *})
   1.838 +apply(tactic {* TRYALL(EVERY'[rtac disjI1,etac psubset_subset_trans,rtac (thm "Graph9"),Force_tac]) *})
   1.839 +done
   1.840 +
   1.841 +subsubsection {* Interference freedom Mutator-Collector *}
   1.842 +
   1.843 +lemma interfree_Mutator_Collector:
   1.844 + "interfree_aux (Some Mutator, {}, Some Collector)"
   1.845 +apply(unfold Collector_def Mutator_def)
   1.846 +apply interfree_aux
   1.847 +apply(simp_all add:collector_mutator_interfree)
   1.848 +apply(unfold modules collector_defs mutator_defs)
   1.849 +apply(tactic  {* TRYALL (interfree_aux_tac) *})
   1.850 +--{* 64 subgoals left *}
   1.851 +apply(simp_all add:nth_list_update Invariants Append_to_free0)+
   1.852 +apply(tactic{* TRYALL Clarify_tac *})
   1.853 +--{* 4 subgoals left *}
   1.854 +apply force
   1.855 +apply(simp add:Append_to_free2)
   1.856 +apply force
   1.857 +apply(simp add:Append_to_free2)
   1.858 +done
   1.859 +
   1.860 +subsubsection {* The Garbage Collection algorithm *}
   1.861 +
   1.862 +text {* In total there are 289 verification conditions.  *}
   1.863 +
   1.864 +lemma Gar_Coll: 
   1.865 +  "\<parallel>- .{\<acute>Proper \<and> \<acute>Mut_init \<and> \<acute>z}.  
   1.866 +  COBEGIN  
   1.867 +   Collector
   1.868 +  .{False}.
   1.869 + \<parallel>  
   1.870 +   Mutator
   1.871 +  .{False}. 
   1.872 + COEND 
   1.873 +  .{False}."
   1.874 +apply oghoare
   1.875 +apply(force simp add: Mutator_def Collector_def modules)
   1.876 +apply(rule Collector)
   1.877 +apply(rule Mutator)
   1.878 +apply(simp add:interfree_Collector_Mutator)
   1.879 +apply(simp add:interfree_Mutator_Collector)
   1.880 +apply force
   1.881 +done
   1.882 +
   1.883 +end
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/HoareParallel/Graph.thy	Tue Mar 05 17:11:25 2002 +0100
     2.3 @@ -0,0 +1,426 @@
     2.4 +
     2.5 +header {* \chapter{Case Study: Single and Multi-Mutator Garbage Collection Algorithms}
     2.6 +
     2.7 +\section {Formalization of the Memory} *}
     2.8 +
     2.9 +theory Graph = Main:
    2.10 +
    2.11 +datatype node = Black | White
    2.12 +
    2.13 +types 
    2.14 +  nodes = "node list"
    2.15 +  edge  = "nat \<times> nat"
    2.16 +  edges = "edge list"
    2.17 +
    2.18 +consts Roots :: "nat set"
    2.19 +
    2.20 +constdefs
    2.21 +  Proper_Roots :: "nodes \<Rightarrow> bool"
    2.22 +  "Proper_Roots M \<equiv> Roots\<noteq>{} \<and> Roots \<subseteq> {i. i<length M}"
    2.23 +
    2.24 +  Proper_Edges :: "(nodes \<times> edges) \<Rightarrow> bool"
    2.25 +  "Proper_Edges \<equiv> (\<lambda>(M,E). \<forall>i<length E. fst(E!i)<length M \<and> snd(E!i)<length M)"
    2.26 +
    2.27 +  BtoW :: "(edge \<times> nodes) \<Rightarrow> bool"
    2.28 +  "BtoW \<equiv> (\<lambda>(e,M). (M!fst e)=Black \<and> (M!snd e)\<noteq>Black)"
    2.29 +
    2.30 +  Blacks :: "nodes \<Rightarrow> nat set"
    2.31 +  "Blacks M \<equiv> {i. i<length M \<and> M!i=Black}"
    2.32 +
    2.33 +  Reach :: "edges \<Rightarrow> nat set"
    2.34 +  "Reach E \<equiv> {x. (\<exists>path. 1<length path \<and> path!(length path - 1)\<in>Roots \<and> x=path!0
    2.35 +              \<and> (\<forall>i<length path - 1. (\<exists>j<length E. E!j=(path!(i+1), path!i))))
    2.36 +	      \<or> x\<in>Roots}"
    2.37 +
    2.38 +text{* Reach: the set of reachable nodes is the set of Roots together with the
    2.39 +nodes reachable from some Root by a path represented by a list of
    2.40 +  nodes (at least two since we traverse at least one edge), where two
    2.41 +consecutive nodes correspond to an edge in E. *}
    2.42 +
    2.43 +subsection {* Proofs about Graphs *}
    2.44 +
    2.45 +lemmas Graph_defs= Blacks_def Proper_Roots_def Proper_Edges_def BtoW_def
    2.46 +declare Graph_defs [simp]
    2.47 +
    2.48 +subsubsection{* Graph 1. *}
    2.49 +
    2.50 +lemma Graph1_aux [rule_format]: 
    2.51 +  "\<lbrakk> Roots\<subseteq>Blacks M; \<forall>i<length E. \<not>BtoW(E!i,M)\<rbrakk>
    2.52 +  \<Longrightarrow> 1< length path \<longrightarrow> (path!(length path - 1))\<in>Roots \<longrightarrow>  
    2.53 +  (\<forall>i<length path - 1. (\<exists>j. j < length E \<and> E!j=(path!(Suc i), path!i))) 
    2.54 +  \<longrightarrow> M!(path!0) = Black"
    2.55 +apply(induct_tac "path")
    2.56 + apply force
    2.57 +apply clarify
    2.58 +apply simp
    2.59 +apply(case_tac "list")
    2.60 + apply force
    2.61 +apply simp
    2.62 +apply(rotate_tac -1)
    2.63 +apply(erule_tac x = "0" in all_dupE)
    2.64 +apply simp
    2.65 +apply clarify
    2.66 +apply(erule allE , erule (1) notE impE)
    2.67 +apply simp
    2.68 +apply(erule mp)
    2.69 +apply(case_tac "lista")
    2.70 + apply force
    2.71 +apply simp
    2.72 +apply(erule mp)
    2.73 +apply clarify
    2.74 +apply(erule_tac x = "Suc i" in allE)
    2.75 +apply force
    2.76 +done
    2.77 +
    2.78 +lemma Graph1: 
    2.79 +  "\<lbrakk>Roots\<subseteq>Blacks M; Proper_Edges(M, E); \<forall>i<length E. \<not>BtoW(E!i,M) \<rbrakk> 
    2.80 +  \<Longrightarrow> Reach E\<subseteq>Blacks M"
    2.81 +apply (unfold Reach_def)
    2.82 +apply simp
    2.83 +apply clarify
    2.84 +apply(erule disjE)
    2.85 + apply clarify
    2.86 + apply(rule conjI)
    2.87 +  apply(subgoal_tac "0< length path - Suc 0")
    2.88 +   apply(erule allE , erule (1) notE impE)
    2.89 +   apply force
    2.90 +  apply simp
    2.91 + apply(rule Graph1_aux)
    2.92 +apply auto
    2.93 +done
    2.94 +
    2.95 +subsubsection{* Graph 2. *}
    2.96 +
    2.97 +lemma Ex_first_occurrence [rule_format]: 
    2.98 +  "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i. i<m \<longrightarrow> \<not> P i))";
    2.99 +apply(rule nat_less_induct)
   2.100 +apply clarify
   2.101 +apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
   2.102 +apply auto
   2.103 +done
   2.104 +
   2.105 +lemma Compl_lemma: "(n::nat)\<le>l \<Longrightarrow> (\<exists>m. m\<le>l \<and> n=l - m)"
   2.106 +apply(rule_tac x = "l - n" in exI)
   2.107 +apply arith
   2.108 +done
   2.109 +
   2.110 +lemma Ex_last_occurrence: 
   2.111 +  "\<lbrakk>P (n::nat); n\<le>l\<rbrakk> \<Longrightarrow> (\<exists>m. P (l - m) \<and> (\<forall>i. i<m \<longrightarrow> \<not>P (l - i)))"
   2.112 +apply(drule Compl_lemma)
   2.113 +apply clarify
   2.114 +apply(erule Ex_first_occurrence)
   2.115 +done
   2.116 +
   2.117 +lemma Graph2: 
   2.118 +  "\<lbrakk>T \<in> Reach E; R<length E\<rbrakk> \<Longrightarrow> T \<in> Reach (E[R:=(fst(E!R), T)])"
   2.119 +apply (unfold Reach_def)
   2.120 +apply clarify
   2.121 +apply simp
   2.122 +apply(case_tac "\<forall>z<length path. fst(E!R)\<noteq>path!z")
   2.123 + apply(rule_tac x = "path" in exI)
   2.124 + apply simp
   2.125 + apply clarify
   2.126 + apply(erule allE , erule (1) notE impE)
   2.127 + apply clarify
   2.128 + apply(rule_tac x = "j" in exI)
   2.129 + apply(case_tac "j=R")
   2.130 +  apply(erule_tac x = "Suc i" in allE)
   2.131 +  apply simp
   2.132 +  apply arith
   2.133 + apply (force simp add:nth_list_update)
   2.134 +apply simp
   2.135 +apply(erule exE)
   2.136 +apply(subgoal_tac "z \<le> length path - Suc 0")
   2.137 + prefer 2 apply arith
   2.138 +apply(drule_tac P = "\<lambda>m. m<length path \<and> fst(E!R)=path!m" in Ex_last_occurrence)
   2.139 + apply assumption
   2.140 +apply clarify
   2.141 +apply simp
   2.142 +apply(rule_tac x = "(path!0)#(drop (length path - Suc m) path)" in exI)
   2.143 +apply simp
   2.144 +apply(case_tac "length path - (length path - Suc m)")
   2.145 + apply arith
   2.146 +apply simp
   2.147 +apply(subgoal_tac "(length path - Suc m) + nat \<le> length path")
   2.148 + prefer 2 apply arith
   2.149 +apply(drule nth_drop)
   2.150 +apply simp
   2.151 +apply(subgoal_tac "length path - Suc m + nat = length path - Suc 0")
   2.152 + prefer 2 apply arith 
   2.153 +apply simp
   2.154 +apply clarify
   2.155 +apply(case_tac "i")
   2.156 + apply(force simp add: nth_list_update)
   2.157 +apply simp
   2.158 +apply(subgoal_tac "(length path - Suc m) + nata \<le> length path")
   2.159 + prefer 2 apply arith
   2.160 +apply simp
   2.161 +apply(subgoal_tac "(length path - Suc m) + (Suc nata) \<le> length path")
   2.162 + prefer 2 apply arith
   2.163 +apply simp
   2.164 +apply(erule_tac x = "length path - Suc m + nata" in allE)
   2.165 +apply simp
   2.166 +apply clarify
   2.167 +apply(rule_tac x = "j" in exI)
   2.168 +apply(case_tac "R=j")
   2.169 + prefer 2 apply force
   2.170 +apply simp
   2.171 +apply(drule_tac t = "path ! (length path - Suc m)" in sym)
   2.172 +apply simp
   2.173 +apply(case_tac " length path - Suc 0 < m")
   2.174 + apply(subgoal_tac "(length path - Suc m)=0")
   2.175 +  prefer 2 apply arith
   2.176 + apply(rotate_tac -1)
   2.177 + apply(simp del: diff_is_0_eq)
   2.178 + apply(subgoal_tac "Suc nata\<le>nat")
   2.179 + prefer 2 apply arith
   2.180 + apply(drule_tac n = "Suc nata" in Compl_lemma)
   2.181 + apply clarify
   2.182 + apply force
   2.183 +apply(drule leI)
   2.184 +apply(subgoal_tac "Suc (length path - Suc m + nata)=(length path - Suc 0) - (m - Suc nata)")
   2.185 + apply(erule_tac x = "m - (Suc nata)" in allE)
   2.186 + apply(case_tac "m")
   2.187 +  apply simp
   2.188 + apply simp
   2.189 + apply(subgoal_tac "natb - nata < Suc natb")
   2.190 +  prefer 2 apply(erule thin_rl)+ apply arith
   2.191 + apply simp
   2.192 + apply(case_tac "length path")
   2.193 +  apply force
   2.194 + apply simp
   2.195 +apply(frule_tac i1 = "length path" and j1 = "length path - Suc 0" and k1 = "m" in diff_diff_right [THEN mp])
   2.196 +apply(erule_tac V = "length path - Suc m + nat = length path - Suc 0" in thin_rl)
   2.197 +apply simp
   2.198 +apply arith
   2.199 +done
   2.200 +
   2.201 +
   2.202 +subsubsection{* Graph 3. *}
   2.203 +
   2.204 +lemma Graph3: 
   2.205 +  "\<lbrakk> T\<in>Reach E; R<length E \<rbrakk> \<Longrightarrow> Reach(E[R:=(fst(E!R),T)]) \<subseteq> Reach E"
   2.206 +apply (unfold Reach_def)
   2.207 +apply clarify
   2.208 +apply simp
   2.209 +apply(case_tac "\<exists>i<length path - 1. (fst(E!R),T)=(path!(Suc i),path!i)")
   2.210 +--{* the changed edge is part of the path *}
   2.211 + apply(erule exE)
   2.212 + apply(drule_tac P = "\<lambda>i. i<length path - 1 \<and> (fst(E!R),T)=(path!Suc i,path!i)" in Ex_first_occurrence)
   2.213 + apply clarify
   2.214 + apply(erule disjE)
   2.215 +--{* T is NOT a root *}
   2.216 +  apply clarify
   2.217 +  apply(rule_tac x = "(take m path)@patha" in exI)
   2.218 +  apply(subgoal_tac "\<not>(length path\<le>m)")
   2.219 +   prefer 2 apply arith
   2.220 +  apply(simp add: min_def)
   2.221 +  apply(rule conjI)
   2.222 +   apply(subgoal_tac "\<not>(m + length patha - 1 < m)")
   2.223 +    prefer 2 apply arith
   2.224 +   apply(simp add: nth_append min_def)
   2.225 +  apply(rule conjI)
   2.226 +   apply(case_tac "m")
   2.227 +    apply force
   2.228 +   apply(case_tac "path")
   2.229 +    apply force
   2.230 +   apply force
   2.231 +  apply clarify
   2.232 +  apply(case_tac "Suc i\<le>m")
   2.233 +   apply(erule_tac x = "i" in allE)
   2.234 +   apply simp
   2.235 +   apply clarify
   2.236 +   apply(rule_tac x = "j" in exI)
   2.237 +   apply(case_tac "Suc i<m")
   2.238 +    apply(simp add: nth_append min_def)
   2.239 +    apply(case_tac "R=j")
   2.240 +     apply(simp add: nth_list_update)
   2.241 +     apply(case_tac "i=m")
   2.242 +      apply force
   2.243 +     apply(erule_tac x = "i" in allE)
   2.244 +     apply force
   2.245 +    apply(force simp add: nth_list_update)
   2.246 +   apply(simp add: nth_append min_def)
   2.247 +   apply(subgoal_tac "i=m - 1")
   2.248 +    prefer 2 apply arith
   2.249 +   apply(case_tac "R=j")
   2.250 +    apply(erule_tac x = "m - 1" in allE)
   2.251 +    apply(simp add: nth_list_update)
   2.252 +   apply(force simp add: nth_list_update)
   2.253 +  apply(simp add: nth_append min_def)
   2.254 +  apply(rotate_tac -4)
   2.255 +  apply(erule_tac x = "i - m" in allE)
   2.256 +  apply(subgoal_tac "Suc (i - m)=(Suc i - m)" )
   2.257 +    prefer 2 apply arith
   2.258 +   apply simp
   2.259 +  apply(erule mp)
   2.260 +  apply arith
   2.261 +--{* T is a root *}
   2.262 + apply(case_tac "m=0")
   2.263 +  apply force
   2.264 + apply(rule_tac x = "take (Suc m) path" in exI)
   2.265 + apply(subgoal_tac "\<not>(length path\<le>Suc m)" )
   2.266 +  prefer 2 apply arith
   2.267 + apply(simp add: min_def)
   2.268 + apply clarify
   2.269 + apply(erule_tac x = "i" in allE)
   2.270 + apply simp
   2.271 + apply clarify
   2.272 + apply(case_tac "R=j")
   2.273 +  apply(force simp add: nth_list_update)
   2.274 + apply(force simp add: nth_list_update)
   2.275 +--{* the changed edge is not part of the path *}
   2.276 +apply(rule_tac x = "path" in exI)
   2.277 +apply simp
   2.278 +apply clarify
   2.279 +apply(erule_tac x = "i" in allE)
   2.280 +apply clarify
   2.281 +apply(case_tac "R=j")
   2.282 + apply(erule_tac x = "i" in allE)
   2.283 + apply simp
   2.284 +apply(force simp add: nth_list_update)
   2.285 +done
   2.286 +
   2.287 +subsubsection{* Graph 4. *}
   2.288 +
   2.289 +lemma Graph4: 
   2.290 +  "\<lbrakk>T \<in> Reach E; Roots\<subseteq>Blacks M; I\<le>length E; T<length M; R<length E; 
   2.291 +  \<forall>i<I. \<not>BtoW(E!i,M); R<I; M!fst(E!R)=Black; M!T\<noteq>Black\<rbrakk> \<Longrightarrow> 
   2.292 +  (\<exists>r. I\<le>r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
   2.293 +apply (unfold Reach_def)
   2.294 +apply simp
   2.295 +apply(erule disjE)
   2.296 + prefer 2 apply force
   2.297 +apply clarify
   2.298 +--{* there exist a black node in the path to T *}
   2.299 +apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
   2.300 + apply(erule exE)
   2.301 + apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
   2.302 + apply clarify
   2.303 + apply(case_tac "ma")
   2.304 +  apply force
   2.305 + apply simp
   2.306 + apply(case_tac "length path")
   2.307 +  apply force
   2.308 + apply simp
   2.309 + apply(rotate_tac -5)
   2.310 + apply(erule_tac x = "nat" in allE)
   2.311 + apply simp
   2.312 + apply clarify
   2.313 + apply(erule_tac x = "nat" in allE)
   2.314 + apply simp
   2.315 + apply(case_tac "j<I")
   2.316 +  apply(erule_tac x = "j" in allE)
   2.317 +  apply force
   2.318 + apply(rule_tac x = "j" in exI)
   2.319 + apply(force  simp add: nth_list_update)
   2.320 +apply simp
   2.321 +apply(rotate_tac -1)
   2.322 +apply(erule_tac x = "length path - 1" in allE)
   2.323 +apply(case_tac "length path")
   2.324 + apply force
   2.325 +apply force
   2.326 +done
   2.327 +
   2.328 +subsubsection {* Graph 5. *}
   2.329 +
   2.330 +lemma Graph5: 
   2.331 +  "\<lbrakk> T \<in> Reach E ; Roots \<subseteq> Blacks M; \<forall>i<R. \<not>BtoW(E!i,M); T<length M; 
   2.332 +    R<length E; M!fst(E!R)=Black; M!snd(E!R)=Black; M!T \<noteq> Black\<rbrakk> 
   2.333 +   \<Longrightarrow> (\<exists>r. R<r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
   2.334 +apply (unfold Reach_def)
   2.335 +apply simp
   2.336 +apply(erule disjE)
   2.337 + prefer 2 apply force
   2.338 +apply clarify
   2.339 +--{* there exist a black node in the path to T*}
   2.340 +apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
   2.341 + apply(erule exE)
   2.342 + apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
   2.343 + apply clarify
   2.344 + apply(case_tac "ma")
   2.345 +  apply force
   2.346 + apply simp
   2.347 + apply(case_tac "length path")
   2.348 +  apply force
   2.349 + apply simp
   2.350 + apply(rotate_tac -5)
   2.351 + apply(erule_tac x = "nat" in allE)
   2.352 + apply simp
   2.353 + apply clarify
   2.354 + apply(erule_tac x = "nat" in allE)
   2.355 + apply simp
   2.356 + apply(case_tac "j\<le>R")
   2.357 +  apply(drule le_imp_less_or_eq)
   2.358 +  apply(erule disjE)
   2.359 +   apply(erule allE , erule (1) notE impE)
   2.360 +   apply force
   2.361 +  apply force
   2.362 + apply(rule_tac x = "j" in exI)
   2.363 + apply(force  simp add: nth_list_update)
   2.364 +apply simp
   2.365 +apply(rotate_tac -1)
   2.366 +apply(erule_tac x = "length path - 1" in allE)
   2.367 +apply(case_tac "length path")
   2.368 + apply force
   2.369 +apply force
   2.370 +done
   2.371 +
   2.372 +subsubsection {* Graph 6, 7, 8. *}
   2.373 +
   2.374 +lemma Graph6: 
   2.375 + "\<lbrakk>Proper_Edges(M,E); R<length E ; T<length M\<rbrakk> \<Longrightarrow> Proper_Edges(M,E[R:=(fst(E!R),T)])"
   2.376 +apply (unfold Proper_Edges_def)
   2.377 + apply(force  simp add: nth_list_update)
   2.378 +done
   2.379 +
   2.380 +lemma Graph7: 
   2.381 + "\<lbrakk>Proper_Edges(M,E)\<rbrakk> \<Longrightarrow> Proper_Edges(M[T:=a],E)"
   2.382 +apply (unfold Proper_Edges_def)
   2.383 +apply force
   2.384 +done
   2.385 +
   2.386 +lemma Graph8: 
   2.387 + "\<lbrakk>Proper_Roots(M)\<rbrakk> \<Longrightarrow> Proper_Roots(M[T:=a])"
   2.388 +apply (unfold Proper_Roots_def)
   2.389 +apply force
   2.390 +done
   2.391 +
   2.392 +text{* Some specific lemmata for the verification of garbage collection algorithms. *}
   2.393 +
   2.394 +lemma Graph9: "j<length M \<Longrightarrow> Blacks M\<subseteq>Blacks (M[j := Black])"
   2.395 +apply (unfold Blacks_def)
   2.396 + apply(force simp add: nth_list_update)
   2.397 +done
   2.398 +
   2.399 +lemma Graph10 [rule_format (no_asm)]: "\<forall>i. M!i=a \<longrightarrow>M[i:=a]=M"
   2.400 +apply(induct_tac "M")
   2.401 +apply auto
   2.402 +apply(case_tac "i")
   2.403 +apply auto
   2.404 +done
   2.405 +
   2.406 +lemma Graph11 [rule_format (no_asm)]: 
   2.407 +  "\<lbrakk> M!j\<noteq>Black;j<length M\<rbrakk> \<Longrightarrow> Blacks M \<subset> Blacks (M[j := Black])"
   2.408 +apply (unfold Blacks_def)
   2.409 +apply(rule psubsetI)
   2.410 + apply(force simp add: nth_list_update)
   2.411 +apply safe
   2.412 +apply(erule_tac c = "j" in equalityCE)
   2.413 +apply auto
   2.414 +done
   2.415 +
   2.416 +lemma Graph12: "\<lbrakk>a\<subseteq>Blacks M;j<length M\<rbrakk> \<Longrightarrow> a\<subseteq>Blacks (M[j := Black])"
   2.417 +apply (unfold Blacks_def)
   2.418 +apply(force simp add: nth_list_update)
   2.419 +done
   2.420 +
   2.421 +lemma Graph13: "\<lbrakk>a\<subset> Blacks M;j<length M\<rbrakk> \<Longrightarrow> a \<subset> Blacks (M[j := Black])"
   2.422 +apply (unfold Blacks_def)
   2.423 +apply(erule psubset_subset_trans)
   2.424 +apply(force simp add: nth_list_update)
   2.425 +done
   2.426 +
   2.427 +declare Graph_defs [simp del]
   2.428 +
   2.429 +end
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/HoareParallel/Mul_Gar_Coll.thy	Tue Mar 05 17:11:25 2002 +0100
     3.3 @@ -0,0 +1,1291 @@
     3.4 +
     3.5 +header {* \section{The Multi-Mutator Case} *}
     3.6 +
     3.7 +theory Mul_Gar_Coll = Graph + OG_Syntax:
     3.8 +
     3.9 +text {*  The full theory takes aprox. 18 minutes.  *}
    3.10 +
    3.11 +record mut =
    3.12 +  Z :: bool
    3.13 +  R :: nat
    3.14 +  T :: nat
    3.15 +
    3.16 +text {* Declaration of variables: *}
    3.17 +
    3.18 +record mul_gar_coll_state =
    3.19 +  M :: nodes
    3.20 +  E :: edges
    3.21 +  bc :: "nat set"
    3.22 +  obc :: "nat set"
    3.23 +  Ma :: nodes
    3.24 +  ind :: nat 
    3.25 +  k :: nat
    3.26 +  q :: nat
    3.27 +  l :: nat
    3.28 +  Muts :: "mut list"
    3.29 +
    3.30 +subsection {* The Mutators *}
    3.31 +
    3.32 +constdefs 
    3.33 +  Mul_mut_init :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
    3.34 +  "Mul_mut_init \<equiv> \<guillemotleft> \<lambda>n. n=length \<acute>Muts \<and> (\<forall>i<n. R (\<acute>Muts!i)<length \<acute>E 
    3.35 +                          \<and> T (\<acute>Muts!i)<length \<acute>M) \<guillemotright>"
    3.36 +
    3.37 +  Mul_Redirect_Edge  :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
    3.38 +  "Mul_Redirect_Edge j n \<equiv>
    3.39 +  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.
    3.40 +  \<langle>IF T(\<acute>Muts!j) \<in> Reach \<acute>E THEN  
    3.41 +  \<acute>E:= \<acute>E[R (\<acute>Muts!j):= (fst (\<acute>E!R(\<acute>Muts!j)), T (\<acute>Muts!j))] FI,, 
    3.42 +  \<acute>Muts:= \<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=False\<rparr>]\<rangle>"
    3.43 +
    3.44 +  Mul_Color_Target :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
    3.45 +  "Mul_Color_Target j n \<equiv>
    3.46 +  .{\<acute>Mul_mut_init n \<and> \<not> Z (\<acute>Muts!j)}. 
    3.47 +  \<langle>\<acute>M:=\<acute>M[T (\<acute>Muts!j):=Black],, \<acute>Muts:=\<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=True\<rparr>]\<rangle>"
    3.48 +
    3.49 +  Mul_Mutator :: "nat \<Rightarrow> nat \<Rightarrow>  mul_gar_coll_state ann_com"
    3.50 +  "Mul_Mutator j n \<equiv>
    3.51 +  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
    3.52 +  WHILE True  
    3.53 +    INV .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
    3.54 +  DO Mul_Redirect_Edge j n ;; 
    3.55 +     Mul_Color_Target j n 
    3.56 +  OD"
    3.57 +
    3.58 +lemmas mul_mutator_defs = Mul_mut_init_def Mul_Redirect_Edge_def Mul_Color_Target_def 
    3.59 +
    3.60 +subsubsection {* Correctness of the proof outline of one mutator *}
    3.61 +
    3.62 +lemma Mul_Redirect_Edge: "0\<le>j \<and> j<n \<Longrightarrow> 
    3.63 +  \<turnstile> Mul_Redirect_Edge j n 
    3.64 +     pre(Mul_Color_Target j n)"
    3.65 +apply (unfold mul_mutator_defs)
    3.66 +apply annhoare
    3.67 +apply(simp_all)
    3.68 +apply clarify
    3.69 +apply(simp add:nth_list_update)
    3.70 +done
    3.71 +
    3.72 +lemma Mul_Color_Target: "0\<le>j \<and> j<n \<Longrightarrow> 
    3.73 +  \<turnstile>  Mul_Color_Target j n  
    3.74 +    .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}."
    3.75 +apply (unfold mul_mutator_defs)
    3.76 +apply annhoare
    3.77 +apply(simp_all)
    3.78 +apply clarify
    3.79 +apply(simp add:nth_list_update)
    3.80 +done
    3.81 +
    3.82 +lemma Mul_Mutator: "0\<le>j \<and> j<n \<Longrightarrow>  
    3.83 + \<turnstile> Mul_Mutator j n .{False}."
    3.84 +apply(unfold Mul_Mutator_def)
    3.85 +apply annhoare
    3.86 +apply(simp_all add:Mul_Redirect_Edge Mul_Color_Target)
    3.87 +apply(simp add:mul_mutator_defs Mul_Redirect_Edge_def)
    3.88 +done
    3.89 +
    3.90 +subsubsection {* Interference freedom between mutators *}
    3.91 +
    3.92 +lemma Mul_interfree_Redirect_Edge_Redirect_Edge: 
    3.93 +  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
    3.94 +  interfree_aux (Some (Mul_Redirect_Edge i n),{}, Some(Mul_Redirect_Edge j n))"
    3.95 +apply (unfold mul_mutator_defs)
    3.96 +apply interfree_aux
    3.97 +apply safe
    3.98 +apply(simp_all add: nth_list_update)
    3.99 +apply force+
   3.100 +done
   3.101 +
   3.102 +lemma Mul_interfree_Redirect_Edge_Color_Target: 
   3.103 +  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
   3.104 +  interfree_aux (Some(Mul_Redirect_Edge i n),{},Some(Mul_Color_Target j n))"
   3.105 +apply (unfold mul_mutator_defs)
   3.106 +apply interfree_aux
   3.107 +apply safe
   3.108 +apply(simp_all add: nth_list_update)
   3.109 +done
   3.110 +
   3.111 +lemma Mul_interfree_Color_Target_Redirect_Edge: 
   3.112 +  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
   3.113 +  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Redirect_Edge j n))"
   3.114 +apply (unfold mul_mutator_defs)
   3.115 +apply interfree_aux
   3.116 +apply safe
   3.117 +apply(simp_all add:nth_list_update)
   3.118 +apply (drule not_sym,force)+
   3.119 +done
   3.120 +
   3.121 +lemma Mul_interfree_Color_Target_Color_Target: 
   3.122 +  " \<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
   3.123 +  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Color_Target j n))"
   3.124 +apply (unfold mul_mutator_defs)
   3.125 +apply interfree_aux
   3.126 +apply safe
   3.127 +apply(simp_all add: nth_list_update)
   3.128 +apply (drule not_sym,force)
   3.129 +done
   3.130 +
   3.131 +lemmas mul_mutator_interfree = 
   3.132 +  Mul_interfree_Redirect_Edge_Redirect_Edge Mul_interfree_Redirect_Edge_Color_Target
   3.133 +  Mul_interfree_Color_Target_Redirect_Edge Mul_interfree_Color_Target_Color_Target
   3.134 +
   3.135 +lemma Mul_interfree_Mutator_Mutator: "\<lbrakk>i < n; j < n; i \<noteq> j\<rbrakk> \<Longrightarrow> 
   3.136 +  interfree_aux (Some (Mul_Mutator i n), {}, Some (Mul_Mutator j n))"
   3.137 +apply(unfold Mul_Mutator_def)
   3.138 +apply(interfree_aux)
   3.139 +apply(simp_all add:mul_mutator_interfree)
   3.140 +apply(simp_all add: mul_mutator_defs)
   3.141 +apply(tactic {* TRYALL (interfree_aux_tac) *})
   3.142 +apply(tactic {* ALLGOALS Clarify_tac *})
   3.143 +apply (simp_all add:nth_list_update)
   3.144 +apply force+
   3.145 +done
   3.146 +
   3.147 +subsubsection {* Modular Parameterized Mutators *}
   3.148 +
   3.149 +lemma Mul_Parameterized_Mutators: "0<n \<Longrightarrow>
   3.150 + \<parallel>- .{\<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.
   3.151 + COBEGIN
   3.152 + SCHEME  [0\<le> j< n]
   3.153 +  Mul_Mutator j n
   3.154 + .{False}.
   3.155 + COEND
   3.156 + .{False}."
   3.157 +apply oghoare
   3.158 +apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
   3.159 +apply(erule Mul_Mutator)
   3.160 +apply(simp add:Mul_interfree_Mutator_Mutator) 
   3.161 +apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
   3.162 +done
   3.163 +
   3.164 +subsection {* The Collector *}
   3.165 +
   3.166 +constdefs
   3.167 +  Queue :: "mul_gar_coll_state \<Rightarrow> nat"
   3.168 + "Queue \<equiv> \<guillemotleft> length (filter (\<lambda>i. \<not> Z i \<and> \<acute>M!(T i) \<noteq> Black) \<acute>Muts) \<guillemotright>"
   3.169 +
   3.170 +consts  M_init :: nodes
   3.171 +
   3.172 +constdefs
   3.173 +  Proper_M_init :: "mul_gar_coll_state \<Rightarrow> bool"
   3.174 +  "Proper_M_init \<equiv> \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
   3.175 +
   3.176 +  Mul_Proper :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   3.177 +  "Mul_Proper \<equiv> \<guillemotleft> \<lambda>n. Proper_Roots \<acute>M \<and> Proper_Edges (\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<and> n=length \<acute>Muts \<guillemotright>"
   3.178 +
   3.179 +  Safe :: "mul_gar_coll_state \<Rightarrow> bool"
   3.180 +  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
   3.181 +
   3.182 +lemmas mul_collector_defs = Proper_M_init_def Mul_Proper_def Safe_def
   3.183 +
   3.184 +subsubsection {* Blackening Roots *}
   3.185 +
   3.186 +constdefs
   3.187 +  Mul_Blacken_Roots :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
   3.188 +  "Mul_Blacken_Roots n \<equiv>
   3.189 +  .{\<acute>Mul_Proper n}.
   3.190 +  \<acute>ind:=0;;
   3.191 +  .{\<acute>Mul_Proper n \<and> \<acute>ind=0}.
   3.192 +  WHILE \<acute>ind<length \<acute>M 
   3.193 +    INV .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
   3.194 +  DO .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
   3.195 +       IF \<acute>ind\<in>Roots THEN 
   3.196 +     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<in>Roots}. 
   3.197 +       \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
   3.198 +     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind+1. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
   3.199 +       \<acute>ind:=\<acute>ind+1 
   3.200 +  OD"
   3.201 +
   3.202 +lemma Mul_Blacken_Roots: 
   3.203 +  "\<turnstile> Mul_Blacken_Roots n  
   3.204 +  .{\<acute>Mul_Proper n \<and> Roots \<subseteq> Blacks \<acute>M}."
   3.205 +apply (unfold Mul_Blacken_Roots_def)
   3.206 +apply annhoare
   3.207 +apply(simp_all add:mul_collector_defs Graph_defs)
   3.208 +apply safe
   3.209 +apply(simp_all add:nth_list_update)
   3.210 +   apply (erule less_SucE)
   3.211 +    apply simp+
   3.212 +  apply (erule less_SucE)
   3.213 +   apply simp+
   3.214 + apply(drule le_imp_less_or_eq)
   3.215 + apply force
   3.216 +apply force
   3.217 +done
   3.218 +
   3.219 +subsubsection {* Propagating Black *} 
   3.220 +
   3.221 +constdefs
   3.222 +  Mul_PBInv :: "mul_gar_coll_state \<Rightarrow> bool"
   3.223 +  "Mul_PBInv \<equiv>  \<guillemotleft>\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
   3.224 +                 \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) \<and> \<acute>l\<le>\<acute>Queue\<guillemotright>"
   3.225 +
   3.226 +  Mul_Auxk :: "mul_gar_coll_state \<Rightarrow> bool"
   3.227 +  "Mul_Auxk \<equiv> \<guillemotleft>\<acute>l<\<acute>Queue \<or> \<acute>M!\<acute>k\<noteq>Black \<or> \<not>BtoW(\<acute>E!\<acute>ind, \<acute>M) \<or> \<acute>obc\<subset>Blacks \<acute>M\<guillemotright>"
   3.228 +
   3.229 +constdefs
   3.230 +  Mul_Propagate_Black :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
   3.231 +  "Mul_Propagate_Black n \<equiv>
   3.232 + .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.233 +  \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)}. 
   3.234 + \<acute>ind:=0;;
   3.235 + .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.236 +   \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> Blacks \<acute>M\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.237 +   \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) \<and> \<acute>ind=0}. 
   3.238 + WHILE \<acute>ind<length \<acute>E 
   3.239 +  INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.240 +        \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.241 +        \<and> \<acute>Mul_PBInv \<and> \<acute>ind\<le>length \<acute>E}.
   3.242 + DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.243 +     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.244 +     \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
   3.245 +   IF \<acute>M!(fst (\<acute>E!\<acute>ind))=Black THEN 
   3.246 +   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.247 +     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.248 +     \<and> \<acute>Mul_PBInv \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black \<and> \<acute>ind<length \<acute>E}.
   3.249 +    \<acute>k:=snd(\<acute>E!\<acute>ind);;
   3.250 +   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.251 +     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.252 +     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) 
   3.253 +        \<and> \<acute>l\<le>\<acute>Queue \<and> \<acute>Mul_Auxk ) \<and> \<acute>k<length \<acute>M \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black 
   3.254 +     \<and> \<acute>ind<length \<acute>E}.
   3.255 +   \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],,\<acute>ind:=\<acute>ind+1\<rangle>
   3.256 +   ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.257 +         \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.258 +         \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
   3.259 +	 \<langle>IF \<acute>M!(fst (\<acute>E!\<acute>ind))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> FI
   3.260 + OD"
   3.261 +
   3.262 +lemma Mul_Propagate_Black: 
   3.263 +  "\<turnstile> Mul_Propagate_Black n  
   3.264 +   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.265 +     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))}."
   3.266 +apply(unfold Mul_Propagate_Black_def)
   3.267 +apply annhoare
   3.268 +apply(simp_all add:Mul_PBInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
   3.269 +--{* 8 subgoals left *}
   3.270 +apply force
   3.271 +apply force
   3.272 +apply force
   3.273 +apply(force simp add:BtoW_def Graph_defs)
   3.274 +--{* 4 subgoals left *}
   3.275 +apply clarify
   3.276 +apply(simp add: mul_collector_defs Graph12 Graph6 Graph7 Graph8)
   3.277 +apply(disjE_tac)
   3.278 + apply(simp_all add:Graph12 Graph13)
   3.279 + apply(case_tac "M x! k x=Black")
   3.280 +  apply(simp add: Graph10)
   3.281 + apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
   3.282 +apply(case_tac "M x! k x=Black")
   3.283 + apply(simp add: Graph10 BtoW_def)
   3.284 + apply(rule disjI2, clarify, erule less_SucE, force)
   3.285 + apply(case_tac "M x!snd(E x! ind x)=Black")
   3.286 +  apply(force)
   3.287 + apply(force)
   3.288 +apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
   3.289 +--{* 3 subgoals left *}
   3.290 +apply force
   3.291 +--{* 2 subgoals left *}
   3.292 +apply clarify
   3.293 +apply(conjI_tac)
   3.294 +apply(disjE_tac)
   3.295 + apply (simp_all)
   3.296 +apply clarify
   3.297 +apply(erule less_SucE)
   3.298 + apply force
   3.299 +apply (simp add:BtoW_def)
   3.300 +--{* 1 subgoals left *}
   3.301 +apply clarify
   3.302 +apply simp
   3.303 +apply(disjE_tac)
   3.304 +apply (simp_all)
   3.305 +apply(rule disjI1 , rule Graph1)
   3.306 + apply simp_all
   3.307 +done
   3.308 +
   3.309 +subsubsection {* Counting Black Nodes *}
   3.310 +
   3.311 +constdefs
   3.312 +  Mul_CountInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   3.313 + "Mul_CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
   3.314 +
   3.315 +  Mul_Count :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
   3.316 +  "Mul_Count n \<equiv> 
   3.317 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.318 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.319 +    \<and> length \<acute>Ma=length \<acute>M 
   3.320 +    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) ) 
   3.321 +    \<and> \<acute>q<n+1 \<and> \<acute>bc={}}.
   3.322 +  \<acute>ind:=0;;
   3.323 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.324 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.325 +    \<and> length \<acute>Ma=length \<acute>M 
   3.326 +    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) ) 
   3.327 +    \<and> \<acute>q<n+1 \<and> \<acute>bc={} \<and> \<acute>ind=0}.
   3.328 +  WHILE \<acute>ind<length \<acute>M 
   3.329 +     INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.330 +          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
   3.331 +          \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
   3.332 +          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
   3.333 +	  \<and> \<acute>q<n+1 \<and> \<acute>ind\<le>length \<acute>M}.
   3.334 +  DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.335 +       \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.336 +       \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
   3.337 +       \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
   3.338 +       \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}. 
   3.339 +     IF \<acute>M!\<acute>ind=Black 
   3.340 +     THEN .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.341 +            \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
   3.342 +            \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
   3.343 +            \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
   3.344 +            \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
   3.345 +          \<acute>bc:=insert \<acute>ind \<acute>bc
   3.346 +     FI;;
   3.347 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.348 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.349 +    \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv (\<acute>ind+1) 
   3.350 +    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
   3.351 +    \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}.
   3.352 +  \<acute>ind:=\<acute>ind+1
   3.353 +  OD"
   3.354 + 
   3.355 +lemma Mul_Count: 
   3.356 +  "\<turnstile> Mul_Count n  
   3.357 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.358 +    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.359 +    \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
   3.360 +    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
   3.361 +    \<and> \<acute>q<n+1}."
   3.362 +apply (unfold Mul_Count_def)
   3.363 +apply annhoare
   3.364 +apply(simp_all add:Mul_CountInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
   3.365 +--{* 7 subgoals left *}
   3.366 +apply force
   3.367 +apply force
   3.368 +apply force
   3.369 +--{* 4 subgoals left *}
   3.370 +apply clarify
   3.371 +apply(conjI_tac)
   3.372 +apply(disjE_tac)
   3.373 + apply simp_all
   3.374 +apply(simp add:Blacks_def)
   3.375 +apply clarify
   3.376 +apply(erule less_SucE)
   3.377 + back
   3.378 + apply force
   3.379 +apply force
   3.380 +--{* 3 subgoals left *}
   3.381 +apply clarify
   3.382 +apply(conjI_tac)
   3.383 +apply(disjE_tac)
   3.384 + apply simp_all
   3.385 +apply clarify
   3.386 +apply(erule less_SucE)
   3.387 + back
   3.388 + apply force
   3.389 +apply simp
   3.390 +apply(rotate_tac -1)
   3.391 +apply (force simp add:Blacks_def)
   3.392 +--{* 2 subgoals left *}
   3.393 +apply force
   3.394 +--{* 1 subgoals left *}
   3.395 +apply clarify
   3.396 +apply(drule le_imp_less_or_eq)
   3.397 +apply(disjE_tac)
   3.398 +apply (simp_all add:Blacks_def)
   3.399 +done
   3.400 +
   3.401 +subsubsection {* Appending garbage nodes to the free list *}
   3.402 +
   3.403 +consts  Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
   3.404 +
   3.405 +axioms
   3.406 +  Append_to_free0: "length (Append_to_free (i, e)) = length e"
   3.407 +  Append_to_free1: "Proper_Edges (m, e) 
   3.408 +                    \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
   3.409 +  Append_to_free2: "i \<notin> Reach e 
   3.410 +           \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
   3.411 +
   3.412 +constdefs
   3.413 +  Mul_AppendInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
   3.414 +  "Mul_AppendInv \<equiv> \<guillemotleft> \<lambda>ind. (\<forall>i. ind\<le>i \<longrightarrow> i<length \<acute>M \<longrightarrow> i\<in>Reach \<acute>E \<longrightarrow> \<acute>M!i=Black)\<guillemotright>"
   3.415 +
   3.416 +  Mul_Append :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
   3.417 +  "Mul_Append n \<equiv> 
   3.418 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
   3.419 +  \<acute>ind:=0;;
   3.420 +  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
   3.421 +  WHILE \<acute>ind<length \<acute>M 
   3.422 +    INV .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
   3.423 +  DO .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
   3.424 +      IF \<acute>M!\<acute>ind=Black THEN 
   3.425 +     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
   3.426 +      \<acute>M:=\<acute>M[\<acute>ind:=White] 
   3.427 +      ELSE 
   3.428 +     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}. 
   3.429 +      \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
   3.430 +      FI;;
   3.431 +  .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
   3.432 +   \<acute>ind:=\<acute>ind+1
   3.433 +  OD"
   3.434 +
   3.435 +lemma Mul_Append: 
   3.436 +  "\<turnstile> Mul_Append n  
   3.437 +     .{\<acute>Mul_Proper n}."
   3.438 +apply(unfold Mul_Append_def)
   3.439 +apply annhoare
   3.440 +apply(simp_all add: mul_collector_defs Mul_AppendInv_def 
   3.441 +      Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
   3.442 +apply(force simp add:Blacks_def)
   3.443 +apply(force simp add:Blacks_def)
   3.444 +apply(force simp add:Blacks_def)
   3.445 +apply(force simp add:Graph_defs)
   3.446 +apply force
   3.447 +apply(force simp add:Append_to_free1 Append_to_free2)
   3.448 +apply force
   3.449 +apply force
   3.450 +done
   3.451 +
   3.452 +subsubsection {* Collector *}
   3.453 +
   3.454 +constdefs 
   3.455 +  Mul_Collector :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
   3.456 +  "Mul_Collector n \<equiv>
   3.457 +.{\<acute>Mul_Proper n}.  
   3.458 +WHILE True INV .{\<acute>Mul_Proper n}. 
   3.459 +DO  
   3.460 +Mul_Blacken_Roots n ;; 
   3.461 +.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M}.  
   3.462 + \<acute>obc:={};; 
   3.463 +.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}.  
   3.464 + \<acute>bc:=Roots;; 
   3.465 +.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
   3.466 + \<acute>l:=0;; 
   3.467 +.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>l=0}. 
   3.468 + WHILE \<acute>l<n+1  
   3.469 +   INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and>  
   3.470 +         (\<acute>Safe \<or> (\<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M) \<and> \<acute>l<n+1)}. 
   3.471 + DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.472 +      \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M)}.
   3.473 +    \<acute>obc:=\<acute>bc;;
   3.474 +    Mul_Propagate_Black n;; 
   3.475 +    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.476 +      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.477 +      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
   3.478 +      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))}. 
   3.479 +    \<acute>bc:={};;
   3.480 +    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.481 +      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.482 +      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue 
   3.483 +      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) \<and> \<acute>bc={}}. 
   3.484 +       \<langle> \<acute>Ma:=\<acute>M,, \<acute>q:=\<acute>Queue \<rangle>;;
   3.485 +    Mul_Count n;; 
   3.486 +    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.487 +      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.488 +      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
   3.489 +      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
   3.490 +      \<and> \<acute>q<n+1}. 
   3.491 +    IF \<acute>obc=\<acute>bc THEN
   3.492 +    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.493 +      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.494 +      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
   3.495 +      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
   3.496 +      \<and> \<acute>q<n+1 \<and> \<acute>obc=\<acute>bc}.  
   3.497 +    \<acute>l:=\<acute>l+1  
   3.498 +    ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
   3.499 +          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
   3.500 +          \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
   3.501 +          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) 
   3.502 +          \<and> \<acute>q<n+1 \<and> \<acute>obc\<noteq>\<acute>bc}.  
   3.503 +        \<acute>l:=0 FI 
   3.504 + OD;; 
   3.505 + Mul_Append n  
   3.506 +OD"
   3.507 +
   3.508 +lemmas mul_modules = Mul_Redirect_Edge_def Mul_Color_Target_def 
   3.509 + Mul_Blacken_Roots_def Mul_Propagate_Black_def 
   3.510 + Mul_Count_def Mul_Append_def
   3.511 +
   3.512 +lemma Mul_Collector:
   3.513 +  "\<turnstile> Mul_Collector n 
   3.514 +  .{False}."
   3.515 +apply(unfold Mul_Collector_def)
   3.516 +apply annhoare
   3.517 +apply(simp_all only:pre.simps Mul_Blacken_Roots 
   3.518 +       Mul_Propagate_Black Mul_Count Mul_Append)
   3.519 +apply(simp_all add:mul_modules)
   3.520 +apply(simp_all add:mul_collector_defs Queue_def)
   3.521 +apply force
   3.522 +apply force
   3.523 +apply force
   3.524 +apply (force simp add: less_Suc_eq_le length_filter)
   3.525 +apply force
   3.526 +apply (force dest:subset_antisym)
   3.527 +apply force
   3.528 +apply force
   3.529 +apply force
   3.530 +done
   3.531 +
   3.532 +subsection {* Interference Freedom *}
   3.533 +
   3.534 +lemma le_length_filter_update[rule_format]: 
   3.535 + "\<forall>i. (\<not>P (list!i) \<or> P j) \<and> i<length list 
   3.536 + \<longrightarrow> length(filter P list) \<le> length(filter P (list[i:=j]))"
   3.537 +apply(induct_tac "list")
   3.538 + apply(simp)
   3.539 +apply(clarify)
   3.540 +apply(case_tac i)
   3.541 + apply(simp)
   3.542 +apply(simp)
   3.543 +done
   3.544 +
   3.545 +lemma less_length_filter_update [rule_format]: 
   3.546 + "\<forall>i. P j \<and> \<not>(P (list!i)) \<and> i<length list 
   3.547 + \<longrightarrow> length(filter P list) < length(filter P (list[i:=j]))"
   3.548 +apply(induct_tac "list")
   3.549 + apply(simp)
   3.550 +apply(clarify)
   3.551 +apply(case_tac i)
   3.552 + apply(simp)
   3.553 +apply(simp)
   3.554 +done
   3.555 +
   3.556 +lemma Mul_interfree_Blacken_Roots_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk> \<Longrightarrow>  
   3.557 +  interfree_aux (Some(Mul_Blacken_Roots n),{},Some(Mul_Redirect_Edge j n))"
   3.558 +apply (unfold mul_modules)
   3.559 +apply interfree_aux
   3.560 +apply safe
   3.561 +apply(simp_all add:Graph6 Graph9 Graph12 nth_list_update mul_mutator_defs mul_collector_defs)
   3.562 +done
   3.563 +
   3.564 +lemma Mul_interfree_Redirect_Edge_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow> 
   3.565 +  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Blacken_Roots n))"
   3.566 +apply (unfold mul_modules)
   3.567 +apply interfree_aux
   3.568 +apply safe
   3.569 +apply(simp_all add:mul_mutator_defs nth_list_update)
   3.570 +done
   3.571 +
   3.572 +lemma Mul_interfree_Blacken_Roots_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.573 +  interfree_aux (Some(Mul_Blacken_Roots n),{},Some (Mul_Color_Target j n ))"
   3.574 +apply (unfold mul_modules)
   3.575 +apply interfree_aux
   3.576 +apply safe
   3.577 +apply(simp_all add:mul_mutator_defs mul_collector_defs nth_list_update Graph7 Graph8 Graph9 Graph12)
   3.578 +done
   3.579 +
   3.580 +lemma Mul_interfree_Color_Target_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.581 +  interfree_aux (Some(Mul_Color_Target j n ),{},Some (Mul_Blacken_Roots n ))"
   3.582 +apply (unfold mul_modules)
   3.583 +apply interfree_aux
   3.584 +apply safe
   3.585 +apply(simp_all add:mul_mutator_defs nth_list_update)
   3.586 +done
   3.587 +
   3.588 +lemma Mul_interfree_Propagate_Black_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.589 +  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Redirect_Edge j n ))"
   3.590 +apply (unfold mul_modules)
   3.591 +apply interfree_aux
   3.592 +apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_PBInv_def nth_list_update Graph6)
   3.593 +--{* 7 subgoals left *}
   3.594 +apply clarify
   3.595 +apply(disjE_tac)
   3.596 +  apply(simp_all add:Graph6)
   3.597 + apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.598 +apply(rule conjI)
   3.599 + apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.600 +apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.601 +--{* 6 subgoals left *}
   3.602 +apply clarify
   3.603 +apply(disjE_tac)
   3.604 +  apply(simp_all add:Graph6)
   3.605 + apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.606 +apply(rule conjI)
   3.607 + apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.608 +apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.609 +--{* 5 subgoals left *}
   3.610 +apply clarify
   3.611 +apply(disjE_tac)
   3.612 +  apply(simp_all add:Graph6)
   3.613 + apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.614 +apply(rule conjI)
   3.615 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.616 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.617 +apply(erule conjE)
   3.618 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.619 + apply(rule conjI)
   3.620 +  apply(rule impI,(rule disjI2)+,rule conjI)
   3.621 +   apply clarify
   3.622 +   apply(case_tac "R (Muts x! j)=i")
   3.623 +    apply (force simp add: nth_list_update BtoW_def)
   3.624 +   apply (force simp add: nth_list_update)
   3.625 +  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.626 + apply(rule impI,(rule disjI2)+, erule le_trans)
   3.627 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.628 +apply(rule conjI)
   3.629 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.630 + apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.631 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.632 +apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.633 +--{* 4 subgoals left *}
   3.634 +apply clarify
   3.635 +apply(disjE_tac)
   3.636 +  apply(simp_all add:Graph6)
   3.637 + apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.638 +apply(rule conjI)
   3.639 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.640 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.641 +apply(erule conjE)
   3.642 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.643 + apply(rule conjI)
   3.644 +  apply(rule impI,(rule disjI2)+,rule conjI)
   3.645 +   apply clarify
   3.646 +   apply(case_tac "R (Muts x! j)=i")
   3.647 +    apply (force simp add: nth_list_update BtoW_def)
   3.648 +   apply (force simp add: nth_list_update)
   3.649 +  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.650 + apply(rule impI,(rule disjI2)+, erule le_trans)
   3.651 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.652 +apply(rule conjI)
   3.653 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.654 + apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.655 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.656 +apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.657 +--{* 3 subgoals left *}
   3.658 +apply clarify
   3.659 +apply(disjE_tac)
   3.660 +  apply(simp_all add:Graph6)
   3.661 +  apply (rule impI)
   3.662 +   apply(rule conjI)
   3.663 +    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.664 +   apply(case_tac "R (Muts x ! j)= ind x")
   3.665 +    apply(simp add:nth_list_update)
   3.666 +   apply(simp add:nth_list_update)
   3.667 +  apply(case_tac "R (Muts x ! j)= ind x")
   3.668 +   apply(simp add:nth_list_update)
   3.669 +  apply(simp add:nth_list_update)
   3.670 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.671 +  apply(rule conjI)
   3.672 +   apply(rule impI)
   3.673 +   apply(rule conjI)
   3.674 +    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.675 +    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.676 +   apply(case_tac "R (Muts x ! j)= ind x")
   3.677 +    apply(simp add:nth_list_update)
   3.678 +   apply(simp add:nth_list_update)
   3.679 +  apply(rule impI)
   3.680 +  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.681 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.682 + apply(rule conjI)
   3.683 +  apply(rule impI)
   3.684 +   apply(rule conjI)
   3.685 +    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.686 +    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.687 +   apply(case_tac "R (Muts x ! j)= ind x")
   3.688 +    apply(simp add:nth_list_update)
   3.689 +   apply(simp add:nth_list_update)
   3.690 +  apply(rule impI)
   3.691 +  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.692 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.693 + apply(erule conjE)
   3.694 + apply(rule conjI)
   3.695 +  apply(case_tac "M x!(T (Muts x!j))=Black")
   3.696 +   apply(rule impI,rule conjI,(rule disjI2)+,rule conjI)
   3.697 +    apply clarify
   3.698 +    apply(case_tac "R (Muts x! j)=i")
   3.699 +     apply (force simp add: nth_list_update BtoW_def)
   3.700 +    apply (force simp add: nth_list_update)
   3.701 +   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.702 +  apply(case_tac "R (Muts x ! j)= ind x")
   3.703 +   apply(simp add:nth_list_update)
   3.704 +  apply(simp add:nth_list_update)
   3.705 + apply(rule impI,rule conjI)
   3.706 +  apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.707 +  apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.708 + apply(case_tac "R (Muts x! j)=ind x")
   3.709 +  apply (force simp add: nth_list_update)
   3.710 + apply (force simp add: nth_list_update)
   3.711 +apply(rule impI, (rule disjI2)+, erule le_trans)
   3.712 +apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.713 +--{* 2 subgoals left *}
   3.714 +apply clarify
   3.715 +apply(rule conjI)
   3.716 + apply(disjE_tac)
   3.717 +  apply(simp_all add:Mul_Auxk_def Graph6)
   3.718 +  apply (rule impI)
   3.719 +   apply(rule conjI)
   3.720 +    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.721 +   apply(case_tac "R (Muts x ! j)= ind x")
   3.722 +    apply(simp add:nth_list_update)
   3.723 +   apply(simp add:nth_list_update)
   3.724 +  apply(case_tac "R (Muts x ! j)= ind x")
   3.725 +   apply(simp add:nth_list_update)
   3.726 +  apply(simp add:nth_list_update)
   3.727 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.728 +  apply(rule impI)
   3.729 +  apply(rule conjI)
   3.730 +   apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.731 +   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.732 +  apply(case_tac "R (Muts x ! j)= ind x")
   3.733 +   apply(simp add:nth_list_update)
   3.734 +  apply(simp add:nth_list_update)
   3.735 + apply(rule impI)
   3.736 + apply(rule conjI)
   3.737 +  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.738 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.739 + apply(case_tac "R (Muts x ! j)= ind x")
   3.740 +  apply(simp add:nth_list_update)
   3.741 + apply(simp add:nth_list_update)
   3.742 +apply(rule impI)
   3.743 +apply(rule conjI)
   3.744 + apply(erule conjE)+
   3.745 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.746 +  apply((rule disjI2)+,rule conjI)
   3.747 +   apply clarify
   3.748 +   apply(case_tac "R (Muts x! j)=i")
   3.749 +    apply (force simp add: nth_list_update BtoW_def)
   3.750 +   apply (force simp add: nth_list_update)
   3.751 +  apply(rule conjI)
   3.752 +   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.753 +  apply(rule impI)
   3.754 +  apply(case_tac "R (Muts x ! j)= ind x")
   3.755 +   apply(simp add:nth_list_update BtoW_def)
   3.756 +  apply (simp  add:nth_list_update)
   3.757 +  apply(rule impI)
   3.758 +  apply simp
   3.759 +  apply(disjE_tac)
   3.760 +   apply(rule disjI1, erule less_le_trans)
   3.761 +   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.762 +  apply force
   3.763 + apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.764 + apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.765 + apply(case_tac "R (Muts x ! j)= ind x")
   3.766 +  apply(simp add:nth_list_update)
   3.767 + apply(simp add:nth_list_update)
   3.768 +apply(disjE_tac) 
   3.769 +apply simp_all
   3.770 +apply(conjI_tac)
   3.771 + apply(rule impI)
   3.772 + apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.773 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.774 +apply(erule conjE)+
   3.775 +apply(rule impI,(rule disjI2)+,rule conjI)
   3.776 + apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.777 +apply(rule impI)+
   3.778 +apply simp
   3.779 +apply(disjE_tac)
   3.780 + apply(rule disjI1, erule less_le_trans)
   3.781 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.782 +apply force
   3.783 +--{* 1 subgoals left *} 
   3.784 +apply clarify
   3.785 +apply(disjE_tac)
   3.786 +  apply(simp_all add:Graph6)
   3.787 + apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.788 +apply(rule conjI)
   3.789 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.790 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.791 +apply(erule conjE)
   3.792 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.793 + apply(rule conjI)
   3.794 +  apply(rule impI,(rule disjI2)+,rule conjI)
   3.795 +   apply clarify
   3.796 +   apply(case_tac "R (Muts x! j)=i")
   3.797 +    apply (force simp add: nth_list_update BtoW_def)
   3.798 +   apply (force simp add: nth_list_update)
   3.799 +  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.800 + apply(rule impI,(rule disjI2)+, erule le_trans)
   3.801 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.802 +apply(rule conjI)
   3.803 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.804 + apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.805 +apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
   3.806 +apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
   3.807 +done
   3.808 +
   3.809 +lemma Mul_interfree_Redirect_Edge_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.810 +  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Propagate_Black n))"
   3.811 +apply (unfold mul_modules)
   3.812 +apply interfree_aux
   3.813 +apply safe
   3.814 +apply(simp_all add:mul_mutator_defs nth_list_update)
   3.815 +done
   3.816 +
   3.817 +lemma Mul_interfree_Propagate_Black_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.818 +  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Color_Target j n ))"
   3.819 +apply (unfold mul_modules)
   3.820 +apply interfree_aux
   3.821 +apply(simp_all add: mul_collector_defs mul_mutator_defs)
   3.822 +--{* 7 subgoals left *}
   3.823 +apply clarify
   3.824 +apply (simp add:Graph7 Graph8 Graph12)
   3.825 +apply(disjE_tac)
   3.826 +  apply(simp add:Graph7 Graph8 Graph12)
   3.827 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.828 +  apply(rule disjI2,rule disjI1, erule le_trans)
   3.829 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.830 + apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
   3.831 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
   3.832 +--{* 6 subgoals left *}
   3.833 +apply clarify
   3.834 +apply (simp add:Graph7 Graph8 Graph12)
   3.835 +apply(disjE_tac)
   3.836 +  apply(simp add:Graph7 Graph8 Graph12)
   3.837 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.838 +  apply(rule disjI2,rule disjI1, erule le_trans)
   3.839 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.840 + apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
   3.841 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
   3.842 +--{* 5 subgoals left *}
   3.843 +apply clarify
   3.844 +apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
   3.845 +apply(disjE_tac)
   3.846 +   apply(simp add:Graph7 Graph8 Graph12) 
   3.847 +  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
   3.848 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.849 +  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.850 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.851 + apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
   3.852 +apply(erule conjE)
   3.853 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.854 + apply((rule disjI2)+)
   3.855 + apply (rule conjI)
   3.856 +  apply(simp add:Graph10)
   3.857 + apply(erule le_trans)
   3.858 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.859 +apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
   3.860 +--{* 4 subgoals left *}
   3.861 +apply clarify
   3.862 +apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
   3.863 +apply(disjE_tac)
   3.864 +   apply(simp add:Graph7 Graph8 Graph12)
   3.865 +  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
   3.866 + apply(case_tac "M x!(T (Muts x!j))=Black")
   3.867 +  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   3.868 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.869 + apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
   3.870 +apply(erule conjE)
   3.871 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.872 + apply((rule disjI2)+)
   3.873 + apply (rule conjI)
   3.874 +  apply(simp add:Graph10)
   3.875 + apply(erule le_trans)
   3.876 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.877 +apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
   3.878 +--{* 3 subgoals left *}
   3.879 +apply clarify
   3.880 +apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
   3.881 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.882 + apply(simp add:Graph10)
   3.883 + apply(disjE_tac)
   3.884 +  apply simp_all
   3.885 +  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
   3.886 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.887 + apply(erule conjE)
   3.888 + apply((rule disjI2)+,erule le_trans)
   3.889 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.890 +apply(rule conjI)
   3.891 + apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
   3.892 +apply (force simp add:nth_list_update)
   3.893 +--{* 2 subgoals left *}
   3.894 +apply clarify 
   3.895 +apply(simp add:Mul_Auxk_def Graph7 Graph8 Graph12)
   3.896 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.897 + apply(simp add:Graph10)
   3.898 + apply(disjE_tac)
   3.899 +  apply simp_all
   3.900 +  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
   3.901 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.902 + apply(erule conjE)+
   3.903 + apply((rule disjI2)+,rule conjI, erule le_trans)
   3.904 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.905 + apply((rule impI)+)
   3.906 + apply simp
   3.907 + apply(erule disjE)
   3.908 +  apply(rule disjI1, erule less_le_trans) 
   3.909 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.910 + apply force
   3.911 +apply(rule conjI)
   3.912 + apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
   3.913 +apply (force simp add:nth_list_update)
   3.914 +--{* 1 subgoals left *}
   3.915 +apply clarify
   3.916 +apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
   3.917 +apply(case_tac "M x!(T (Muts x!j))=Black")
   3.918 + apply(simp add:Graph10)
   3.919 + apply(disjE_tac)
   3.920 +  apply simp_all
   3.921 +  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
   3.922 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.923 + apply(erule conjE)
   3.924 + apply((rule disjI2)+,erule le_trans)
   3.925 + apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
   3.926 +apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
   3.927 +done
   3.928 +
   3.929 +lemma Mul_interfree_Color_Target_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.930 +  interfree_aux (Some(Mul_Color_Target j n),{},Some(Mul_Propagate_Black n ))"
   3.931 +apply (unfold mul_modules)
   3.932 +apply interfree_aux
   3.933 +apply safe
   3.934 +apply(simp_all add:mul_mutator_defs nth_list_update)
   3.935 +done
   3.936 +
   3.937 +lemma Mul_interfree_Count_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
   3.938 +  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Redirect_Edge j n))"
   3.939 +apply (unfold mul_modules)
   3.940 +apply interfree_aux
   3.941 +--{* 9 subgoals left *}
   3.942 +apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def Graph6)
   3.943 +apply clarify
   3.944 +apply disjE_tac
   3.945 +   apply(simp add:Graph6)
   3.946 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.947 + apply(simp add:Graph6)
   3.948 +apply clarify
   3.949 +apply disjE_tac
   3.950 + apply(simp add:Graph6)
   3.951 + apply(rule conjI)
   3.952 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.953 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.954 +apply(simp add:Graph6)
   3.955 +--{* 8 subgoals left *}
   3.956 +apply(simp add:mul_mutator_defs nth_list_update)
   3.957 +--{* 7 subgoals left *}
   3.958 +apply(simp add:mul_mutator_defs mul_collector_defs)
   3.959 +apply clarify
   3.960 +apply disjE_tac
   3.961 +   apply(simp add:Graph6)
   3.962 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.963 + apply(simp add:Graph6)
   3.964 +apply clarify
   3.965 +apply disjE_tac
   3.966 + apply(simp add:Graph6)
   3.967 + apply(rule conjI)
   3.968 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.969 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.970 +apply(simp add:Graph6)
   3.971 +--{* 6 subgoals left *}
   3.972 +apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
   3.973 +apply clarify
   3.974 +apply disjE_tac
   3.975 +   apply(simp add:Graph6 Queue_def)
   3.976 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.977 + apply(simp add:Graph6)
   3.978 +apply clarify
   3.979 +apply disjE_tac
   3.980 + apply(simp add:Graph6)
   3.981 + apply(rule conjI)
   3.982 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.983 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.984 +apply(simp add:Graph6)
   3.985 +--{* 5 subgoals left *}
   3.986 +apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
   3.987 +apply clarify
   3.988 +apply disjE_tac
   3.989 +   apply(simp add:Graph6)
   3.990 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   3.991 + apply(simp add:Graph6)
   3.992 +apply clarify
   3.993 +apply disjE_tac
   3.994 + apply(simp add:Graph6)
   3.995 + apply(rule conjI)
   3.996 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.997 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   3.998 +apply(simp add:Graph6)
   3.999 +--{* 4 subgoals left *}
  3.1000 +apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
  3.1001 +apply clarify
  3.1002 +apply disjE_tac
  3.1003 +   apply(simp add:Graph6)
  3.1004 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  3.1005 + apply(simp add:Graph6)
  3.1006 +apply clarify
  3.1007 +apply disjE_tac
  3.1008 + apply(simp add:Graph6)
  3.1009 + apply(rule conjI)
  3.1010 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1011 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1012 +apply(simp add:Graph6)
  3.1013 +--{* 3 subgoals left *}
  3.1014 +apply(simp add:mul_mutator_defs nth_list_update)
  3.1015 +--{* 2 subgoals left *}
  3.1016 +apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
  3.1017 +apply clarify
  3.1018 +apply disjE_tac
  3.1019 +   apply(simp add:Graph6)
  3.1020 +  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
  3.1021 + apply(simp add:Graph6)
  3.1022 +apply clarify
  3.1023 +apply disjE_tac
  3.1024 + apply(simp add:Graph6)
  3.1025 + apply(rule conjI)
  3.1026 +  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1027 + apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1028 +apply(simp add:Graph6)
  3.1029 +--{* 1 subgoals left *}
  3.1030 +apply(simp add:mul_mutator_defs nth_list_update)
  3.1031 +done
  3.1032 +
  3.1033 +lemma Mul_interfree_Redirect_Edge_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1034 +  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Count n ))"
  3.1035 +apply (unfold mul_modules)
  3.1036 +apply interfree_aux
  3.1037 +apply safe
  3.1038 +apply(simp_all add:mul_mutator_defs nth_list_update)
  3.1039 +done
  3.1040 +
  3.1041 +lemma Mul_interfree_Count_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1042 +  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Color_Target j n))"
  3.1043 +apply (unfold mul_modules)
  3.1044 +apply interfree_aux
  3.1045 +apply(simp_all add:mul_collector_defs mul_mutator_defs Mul_CountInv_def)
  3.1046 +--{* 6 subgoals left *}
  3.1047 +apply clarify
  3.1048 +apply disjE_tac
  3.1049 +  apply (simp add: Graph7 Graph8 Graph12)
  3.1050 + apply (simp add: Graph7 Graph8 Graph12)
  3.1051 +apply clarify
  3.1052 +apply disjE_tac
  3.1053 + apply (simp add: Graph7 Graph8 Graph12)
  3.1054 + apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1055 +  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1056 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1057 + apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1058 +apply (simp add: Graph7 Graph8 Graph12)
  3.1059 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1060 +--{* 5 subgoals left *}
  3.1061 +apply clarify
  3.1062 +apply disjE_tac
  3.1063 +  apply (simp add: Graph7 Graph8 Graph12)
  3.1064 + apply (simp add: Graph7 Graph8 Graph12)
  3.1065 +apply clarify
  3.1066 +apply disjE_tac
  3.1067 + apply (simp add: Graph7 Graph8 Graph12)
  3.1068 + apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1069 +  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1070 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1071 + apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1072 +apply (simp add: Graph7 Graph8 Graph12)
  3.1073 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1074 +--{* 4 subgoals left *}
  3.1075 +apply clarify
  3.1076 +apply disjE_tac
  3.1077 +  apply (simp add: Graph7 Graph8 Graph12)
  3.1078 + apply (simp add: Graph7 Graph8 Graph12)
  3.1079 +apply clarify
  3.1080 +apply disjE_tac
  3.1081 + apply (simp add: Graph7 Graph8 Graph12)
  3.1082 + apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1083 +  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1084 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1085 + apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1086 +apply (simp add: Graph7 Graph8 Graph12)
  3.1087 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1088 +--{* 3 subgoals left *}
  3.1089 +apply clarify
  3.1090 +apply disjE_tac
  3.1091 +  apply (simp add: Graph7 Graph8 Graph12)
  3.1092 + apply (simp add: Graph7 Graph8 Graph12)
  3.1093 +apply clarify
  3.1094 +apply disjE_tac
  3.1095 + apply (simp add: Graph7 Graph8 Graph12)
  3.1096 + apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1097 +  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1098 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1099 + apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1100 +apply (simp add: Graph7 Graph8 Graph12)
  3.1101 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1102 +--{* 2 subgoals left *}
  3.1103 +apply clarify
  3.1104 +apply disjE_tac
  3.1105 +  apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
  3.1106 + apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
  3.1107 +apply clarify
  3.1108 +apply disjE_tac
  3.1109 + apply (simp add: Graph7 Graph8 Graph12)
  3.1110 + apply(rule conjI)
  3.1111 +  apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1112 +   apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1113 +   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1114 +  apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1115 + apply (simp add: nth_list_update)
  3.1116 +apply (simp add: Graph7 Graph8 Graph12)
  3.1117 +apply(rule conjI)
  3.1118 + apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1119 +apply (simp add: nth_list_update)
  3.1120 +--{* 1 subgoals left *}
  3.1121 +apply clarify
  3.1122 +apply disjE_tac
  3.1123 +  apply (simp add: Graph7 Graph8 Graph12)
  3.1124 + apply (simp add: Graph7 Graph8 Graph12)
  3.1125 +apply clarify
  3.1126 +apply disjE_tac
  3.1127 + apply (simp add: Graph7 Graph8 Graph12)
  3.1128 + apply(case_tac "M x!(T (Muts x!j))=Black")
  3.1129 +  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  3.1130 +  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  3.1131 + apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
  3.1132 +apply (simp add: Graph7 Graph8 Graph12)
  3.1133 +apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
  3.1134 +done
  3.1135 +
  3.1136 +lemma Mul_interfree_Color_Target_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1137 +  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Count n ))"
  3.1138 +apply (unfold mul_modules)
  3.1139 +apply interfree_aux
  3.1140 +apply safe
  3.1141 +apply(simp_all add:mul_mutator_defs nth_list_update)
  3.1142 +done
  3.1143 +
  3.1144 +lemma Mul_interfree_Append_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1145 +  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Redirect_Edge j n))"
  3.1146 +apply (unfold mul_modules)
  3.1147 +apply interfree_aux
  3.1148 +apply(tactic {* ALLGOALS Clarify_tac *})
  3.1149 +apply(simp_all add:Graph6 Append_to_free0 Append_to_free1 mul_collector_defs mul_mutator_defs Mul_AppendInv_def)
  3.1150 +apply(erule_tac x=j in allE, force dest:Graph3)+
  3.1151 +done
  3.1152 +
  3.1153 +lemma Mul_interfree_Redirect_Edge_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1154 +  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Append n))"
  3.1155 +apply (unfold mul_modules)
  3.1156 +apply interfree_aux
  3.1157 +apply(tactic {* ALLGOALS Clarify_tac *})
  3.1158 +apply(simp_all add:mul_collector_defs Append_to_free0 Mul_AppendInv_def  mul_mutator_defs nth_list_update)
  3.1159 +done
  3.1160 +
  3.1161 +lemma Mul_interfree_Append_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1162 +  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Color_Target j n))"
  3.1163 +apply (unfold mul_modules)
  3.1164 +apply interfree_aux
  3.1165 +apply(tactic {* ALLGOALS Clarify_tac *})
  3.1166 +apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_AppendInv_def Graph7 Graph8 Append_to_free0 Append_to_free1 
  3.1167 +              Graph12 nth_list_update)
  3.1168 +done
  3.1169 +
  3.1170 +lemma Mul_interfree_Color_Target_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
  3.1171 +  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Append n))"
  3.1172 +apply (unfold mul_modules)
  3.1173 +apply interfree_aux
  3.1174 +apply(tactic {* ALLGOALS Clarify_tac *})
  3.1175 +apply(simp_all add: mul_mutator_defs nth_list_update)
  3.1176 +apply(simp add:Mul_AppendInv_def Append_to_free0)
  3.1177 +done
  3.1178 +
  3.1179 +subsubsection {* Interference freedom Collector-Mutator *}
  3.1180 +
  3.1181 +lemmas mul_collector_mutator_interfree =  
  3.1182 + Mul_interfree_Blacken_Roots_Redirect_Edge Mul_interfree_Blacken_Roots_Color_Target 
  3.1183 + Mul_interfree_Propagate_Black_Redirect_Edge Mul_interfree_Propagate_Black_Color_Target  
  3.1184 + Mul_interfree_Count_Redirect_Edge Mul_interfree_Count_Color_Target 
  3.1185 + Mul_interfree_Append_Redirect_Edge Mul_interfree_Append_Color_Target 
  3.1186 + Mul_interfree_Redirect_Edge_Blacken_Roots Mul_interfree_Color_Target_Blacken_Roots 
  3.1187 + Mul_interfree_Redirect_Edge_Propagate_Black Mul_interfree_Color_Target_Propagate_Black  
  3.1188 + Mul_interfree_Redirect_Edge_Count Mul_interfree_Color_Target_Count 
  3.1189 + Mul_interfree_Redirect_Edge_Append Mul_interfree_Color_Target_Append
  3.1190 +
  3.1191 +lemma Mul_interfree_Collector_Mutator: "j<n  \<Longrightarrow> 
  3.1192 +  interfree_aux (Some (Mul_Collector n), {}, Some (Mul_Mutator j n))"
  3.1193 +apply(unfold Mul_Collector_def Mul_Mutator_def)
  3.1194 +apply interfree_aux
  3.1195 +apply(simp_all add:mul_collector_mutator_interfree)
  3.1196 +apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
  3.1197 +apply(tactic  {* TRYALL (interfree_aux_tac) *})
  3.1198 +--{* 42 subgoals left *}
  3.1199 +apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
  3.1200 +--{* 24 subgoals left *}
  3.1201 +apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  3.1202 +--{* 14 subgoals left *}
  3.1203 +apply(tactic {* TRYALL Clarify_tac *})
  3.1204 +apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  3.1205 +apply(tactic {* TRYALL (rtac conjI) *})
  3.1206 +apply(tactic {* TRYALL (rtac impI) *})
  3.1207 +apply(tactic {* TRYALL (etac disjE) *})
  3.1208 +apply(tactic {* TRYALL (etac conjE) *})
  3.1209 +apply(tactic {* TRYALL (etac disjE) *})
  3.1210 +apply(tactic {* TRYALL (etac disjE) *})
  3.1211 +--{* 72 subgoals left *}
  3.1212 +apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
  3.1213 +--{* 35 subgoals left *}
  3.1214 +apply(tactic {* TRYALL(EVERY'[rtac disjI1,rtac subset_trans,etac (thm "Graph3"),Force_tac, assume_tac]) *})
  3.1215 +--{* 28 subgoals left *}
  3.1216 +apply(tactic {* TRYALL (etac conjE) *})
  3.1217 +apply(tactic {* TRYALL (etac disjE) *})
  3.1218 +--{* 34 subgoals left *}
  3.1219 +apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1220 +apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  3.1221 +apply(tactic {* ALLGOALS(case_tac "M x!(T (Muts x ! j))=Black") *})
  3.1222 +apply(simp_all add:Graph10)
  3.1223 +--{* 47 subgoals left *}
  3.1224 +apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
  3.1225 +--{* 41 subgoals left *}
  3.1226 +apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI1, etac le_trans, force_tac (claset(),simpset() addsimps [thm "Queue_def", less_Suc_eq_le, thm "le_length_filter_update"])]) *})
  3.1227 +--{* 35 subgoals left *}
  3.1228 +apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac psubset_subset_trans,rtac (thm "Graph9"),Force_tac]) *})
  3.1229 +--{* 31 subgoals left *}
  3.1230 +apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
  3.1231 +--{* 29 subgoals left *}
  3.1232 +apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac subset_psubset_trans,etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
  3.1233 +--{* 25 subgoals left *}
  3.1234 +apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI2, rtac disjI1, etac le_trans, force_tac (claset(),simpset() addsimps [thm "Queue_def", less_Suc_eq_le, thm "le_length_filter_update"])]) *})
  3.1235 +--{* 10 subgoals left *}
  3.1236 +apply(rule disjI2,rule disjI2,rule conjI,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update, rule disjI1, rule less_imp_le, erule less_le_trans, force simp add:Queue_def less_Suc_eq_le le_length_filter_update)+
  3.1237 +done
  3.1238 +
  3.1239 +subsubsection {* Interference freedom Mutator-Collector *}
  3.1240 +
  3.1241 +lemma Mul_interfree_Mutator_Collector: " j < n \<Longrightarrow> 
  3.1242 +  interfree_aux (Some (Mul_Mutator j n), {}, Some (Mul_Collector n))"
  3.1243 +apply(unfold Mul_Collector_def Mul_Mutator_def)
  3.1244 +apply interfree_aux
  3.1245 +apply(simp_all add:mul_collector_mutator_interfree)
  3.1246 +apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
  3.1247 +apply(tactic  {* TRYALL (interfree_aux_tac) *})
  3.1248 +--{* 76 subgoals left *}
  3.1249 +apply (clarify,simp add: nth_list_update)+
  3.1250 +--{* 56 subgoals left *}
  3.1251 +apply(clarify,simp add:Mul_AppendInv_def Append_to_free0 nth_list_update)+
  3.1252 +done
  3.1253 +
  3.1254 +subsubsection {* The Multi-Mutator Garbage Collection Algorithm *}
  3.1255 +
  3.1256 +text {* The total number of verification conditions is 328 *}
  3.1257 +
  3.1258 +lemma Mul_Gar_Coll: 
  3.1259 + "\<parallel>- .{\<acute>Mul_Proper n \<and> \<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.  
  3.1260 + COBEGIN  
  3.1261 +  Mul_Collector n
  3.1262 + .{False}.
  3.1263 + \<parallel>  
  3.1264 + SCHEME  [0\<le> j< n]
  3.1265 +  Mul_Mutator j n
  3.1266 + .{False}.  
  3.1267 + COEND  
  3.1268 + .{False}."
  3.1269 +apply oghoare
  3.1270 +--{* Strengthening the precondition *}
  3.1271 +apply(rule Int_greatest)
  3.1272 + apply (case_tac n)
  3.1273 +  apply(force simp add: Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
  3.1274 + apply(simp add: Mul_Mutator_def mul_collector_defs mul_mutator_defs nth_append)
  3.1275 + apply force
  3.1276 +apply clarify
  3.1277 +apply(case_tac xa)
  3.1278 + apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
  3.1279 +apply(simp add: Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append nth_map_upt)
  3.1280 +--{* Collector *}
  3.1281 +apply(rule Mul_Collector)
  3.1282 +--{* Mutator *}
  3.1283 +apply(erule Mul_Mutator)
  3.1284 +--{* Interference freedom *}
  3.1285 +apply(simp add:Mul_interfree_Collector_Mutator)
  3.1286 +apply(simp add:Mul_interfree_Mutator_Collector)
  3.1287 +apply(simp add:Mul_interfree_Mutator_Mutator)
  3.1288 +--{* Weakening of the postcondition *}
  3.1289 +apply(case_tac n)
  3.1290 + apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
  3.1291 +apply(simp add:Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append)
  3.1292 +done
  3.1293 +
  3.1294 +end
  3.1295 \ No newline at end of file
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/HoareParallel/OG_Com.thy	Tue Mar 05 17:11:25 2002 +0100
     4.3 @@ -0,0 +1,55 @@
     4.4 +
     4.5 +header {* \chapter{The Owicki-Gries Method} 
     4.6 +
     4.7 +\section{Abstract Syntax} *} 
     4.8 +
     4.9 +theory OG_Com = Main:
    4.10 +
    4.11 +text {* Type abbreviations for boolean expressions and assertions: *}
    4.12 +
    4.13 +types
    4.14 +    'a bexp = "'a set"
    4.15 +    'a assn = "'a set"
    4.16 +
    4.17 +text {* The syntax of commands is defined by two mutually recursive
    4.18 +datatypes: @{text "'a ann_com"} for annotated commands and @{text "'a
    4.19 +com"} for non-annotated commands. *}
    4.20 +
    4.21 +datatype 'a ann_com = 
    4.22 +     AnnBasic "('a assn)"  "('a \<Rightarrow> 'a)"         
    4.23 +   | AnnSeq "('a ann_com)"  "('a ann_com)"   
    4.24 +   | AnnCond1 "('a assn)"  "('a bexp)"  "('a ann_com)"  "('a ann_com)" 
    4.25 +   | AnnCond2 "('a assn)"  "('a bexp)"  "('a ann_com)" 
    4.26 +   | AnnWhile "('a assn)"  "('a bexp)"  "('a assn)"  "('a ann_com)" 
    4.27 +   | AnnAwait "('a assn)"  "('a bexp)"  "('a com)" 
    4.28 +and 'a com = 
    4.29 +     Parallel "('a ann_com option \<times> 'a assn) list"
    4.30 +   | Basic "('a \<Rightarrow> 'a)" 
    4.31 +   | Seq "('a com)"  "('a com)" 
    4.32 +   | Cond "('a bexp)"  "('a com)"  "('a com)" 
    4.33 +   | While "('a bexp)"  "('a assn)"  "('a com)"
    4.34 +
    4.35 +text {* The function @{text pre} extracts the precondition of an
    4.36 +annotated command: *}
    4.37 +
    4.38 +consts
    4.39 +  pre ::"'a ann_com \<Rightarrow> 'a assn" 
    4.40 +primrec 
    4.41 +  "pre (AnnBasic r f) = r"
    4.42 +  "pre (AnnSeq c1 c2) = pre c1"
    4.43 +  "pre (AnnCond1 r b c1 c2) = r"
    4.44 +  "pre (AnnCond2 r b c) = r"
    4.45 +  "pre (AnnWhile r b i c) = r"
    4.46 +  "pre (AnnAwait r b c) = r"
    4.47 +
    4.48 +text {* Well-formedness predicate for atomic programs: *}
    4.49 +
    4.50 +consts atom_com :: "'a com \<Rightarrow> bool"
    4.51 +primrec  
    4.52 +  "atom_com (Parallel Ts) = False"
    4.53 +  "atom_com (Basic f) = True"
    4.54 +  "atom_com (Seq c1 c2) = (atom_com c1 \<and> atom_com c2)"
    4.55 +  "atom_com (Cond b c1 c2) = (atom_com c1 \<and> atom_com c2)"
    4.56 +  "atom_com (While b i c) = atom_com c"
    4.57 +  
    4.58 +end
    4.59 \ No newline at end of file
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/HoareParallel/OG_Examples.thy	Tue Mar 05 17:11:25 2002 +0100
     5.3 @@ -0,0 +1,564 @@
     5.4 +
     5.5 +header {* \section{Examples} *}
     5.6 +
     5.7 +theory OG_Examples = OG_Syntax:
     5.8 +
     5.9 +subsection {* Mutual Exclusion *}
    5.10 +
    5.11 +subsubsection {* Peterson's Algorithm I*}
    5.12 +
    5.13 +text {* Eike Best. "Semantics of Sequential and Parallel Programs", page 217. *}
    5.14 +
    5.15 +record Petersons_mutex_1 =
    5.16 + pr1 :: nat
    5.17 + pr2 :: nat
    5.18 + in1 :: bool
    5.19 + in2 :: bool 
    5.20 + hold :: nat
    5.21 +
    5.22 +lemma Petersons_mutex_1: 
    5.23 +  "\<parallel>- .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2 }.  
    5.24 +  COBEGIN .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
    5.25 +  WHILE True INV .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
    5.26 +  DO  
    5.27 +  .{\<acute>pr1=0 \<and> \<not>\<acute>in1}. \<langle> \<acute>in1:=True,,\<acute>pr1:=1 \<rangle>;;  
    5.28 +  .{\<acute>pr1=1 \<and> \<acute>in1}.  \<langle> \<acute>hold:=1,,\<acute>pr1:=2 \<rangle>;;  
    5.29 +  .{\<acute>pr1=2 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}.  
    5.30 +  AWAIT (\<not>\<acute>in2 \<or> \<not>(\<acute>hold=1)) THEN \<acute>pr1:=3 END;;    
    5.31 +  .{\<acute>pr1=3 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}. 
    5.32 +   \<langle>\<acute>in1:=False,,\<acute>pr1:=0\<rangle> 
    5.33 +  OD .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
    5.34 +  \<parallel>  
    5.35 +  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
    5.36 +  WHILE True INV .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
    5.37 +  DO  
    5.38 +  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}. \<langle> \<acute>in2:=True,,\<acute>pr2:=1 \<rangle>;;  
    5.39 +  .{\<acute>pr2=1 \<and> \<acute>in2}. \<langle>  \<acute>hold:=2,,\<acute>pr2:=2 \<rangle>;;  
    5.40 +  .{\<acute>pr2=2 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}.  
    5.41 +  AWAIT (\<not>\<acute>in1 \<or> \<not>(\<acute>hold=2)) THEN \<acute>pr2:=3  END;;    
    5.42 +  .{\<acute>pr2=3 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}. 
    5.43 +    \<langle>\<acute>in2:=False,,\<acute>pr2:=0\<rangle> 
    5.44 +  OD .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
    5.45 +  COEND  
    5.46 +  .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2}."
    5.47 +apply oghoare
    5.48 +--{* 104 verification conditions. *}
    5.49 +apply auto
    5.50 +done
    5.51 +
    5.52 +subsubsection {*Peterson's Algorithm II: A Busy Wait Solution *}
    5.53 + 
    5.54 +text {* Apt and Olderog. "Verification of sequential and concurrent Programs", page 282. *}
    5.55 +
    5.56 +record Busy_wait_mutex =
    5.57 + flag1 :: bool
    5.58 + flag2 :: bool
    5.59 + turn  :: nat
    5.60 + after1 :: bool 
    5.61 + after2 :: bool
    5.62 +
    5.63 +lemma Busy_wait_mutex: 
    5.64 + "\<parallel>-  .{True}.  
    5.65 +  \<acute>flag1:=False,, \<acute>flag2:=False,,  
    5.66 +  COBEGIN .{\<not>\<acute>flag1}.  
    5.67 +        WHILE True  
    5.68 +        INV .{\<not>\<acute>flag1}.  
    5.69 +        DO .{\<not>\<acute>flag1}. \<langle> \<acute>flag1:=True,,\<acute>after1:=False \<rangle>;;  
    5.70 +           .{\<acute>flag1 \<and> \<not>\<acute>after1}. \<langle> \<acute>turn:=1,,\<acute>after1:=True \<rangle>;;  
    5.71 +           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
    5.72 +            WHILE \<not>(\<acute>flag2 \<longrightarrow> \<acute>turn=2)  
    5.73 +            INV .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
    5.74 +            DO .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;; 
    5.75 +           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>flag2 \<and> \<acute>after2 \<longrightarrow> \<acute>turn=2)}.
    5.76 +            \<acute>flag1:=False  
    5.77 +        OD  
    5.78 +       .{False}.  
    5.79 +  \<parallel>  
    5.80 +     .{\<not>\<acute>flag2}.  
    5.81 +        WHILE True  
    5.82 +        INV .{\<not>\<acute>flag2}.  
    5.83 +        DO .{\<not>\<acute>flag2}. \<langle> \<acute>flag2:=True,,\<acute>after2:=False \<rangle>;;  
    5.84 +           .{\<acute>flag2 \<and> \<not>\<acute>after2}. \<langle> \<acute>turn:=2,,\<acute>after2:=True \<rangle>;;  
    5.85 +           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
    5.86 +            WHILE \<not>(\<acute>flag1 \<longrightarrow> \<acute>turn=1)  
    5.87 +            INV .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
    5.88 +            DO .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;;  
    5.89 +           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>flag1 \<and> \<acute>after1 \<longrightarrow> \<acute>turn=1)}. 
    5.90 +            \<acute>flag2:=False  
    5.91 +        OD  
    5.92 +       .{False}.  
    5.93 +  COEND  
    5.94 +  .{False}."
    5.95 +apply oghoare
    5.96 +--{* 122 vc *}
    5.97 +apply auto
    5.98 +done
    5.99 +
   5.100 +subsubsection {* Peterson's Algorithm III: A Solution using Semaphores  *}
   5.101 +
   5.102 +record  Semaphores_mutex =
   5.103 + out :: bool
   5.104 + who :: nat
   5.105 +
   5.106 +lemma Semaphores_mutex: 
   5.107 + "\<parallel>- .{i\<noteq>j}.  
   5.108 +  \<acute>out:=True ,,  
   5.109 +  COBEGIN .{i\<noteq>j}.  
   5.110 +       WHILE True INV .{i\<noteq>j}.  
   5.111 +       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
   5.112 +          .{\<not>\<acute>out \<and> \<acute>who=i \<and> i\<noteq>j}. \<acute>out:=True OD  
   5.113 +       .{False}.  
   5.114 +  \<parallel>  
   5.115 +       .{i\<noteq>j}.  
   5.116 +       WHILE True INV .{i\<noteq>j}.  
   5.117 +       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,,\<acute>who:=j END;;  
   5.118 +          .{\<not>\<acute>out \<and> \<acute>who=j \<and> i\<noteq>j}. \<acute>out:=True OD  
   5.119 +       .{False}.  
   5.120 +  COEND  
   5.121 +  .{False}."
   5.122 +apply oghoare
   5.123 +--{* 38 vc *}
   5.124 +apply auto
   5.125 +done
   5.126 +
   5.127 +subsubsection {* Peterson's Algorithm III: Parameterized version: *}
   5.128 +
   5.129 +lemma Semaphores_parameterized_mutex: 
   5.130 + "0<n \<Longrightarrow> \<parallel>- .{True}.  
   5.131 +  \<acute>out:=True ,,  
   5.132 + COBEGIN
   5.133 +  SCHEME [0\<le> i< n]
   5.134 +    .{True}.  
   5.135 +     WHILE True INV .{True}.  
   5.136 +      DO .{True}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
   5.137 +         .{\<not>\<acute>out \<and> \<acute>who=i}. \<acute>out:=True OD
   5.138 +    .{False}. 
   5.139 + COEND
   5.140 +  .{False}." 
   5.141 +apply oghoare
   5.142 +apply auto
   5.143 +done
   5.144 +
   5.145 +subsubsection{* The Ticket Algorithm *}
   5.146 +
   5.147 +record Ticket_mutex =
   5.148 + num :: nat
   5.149 + nextv :: nat
   5.150 + turn :: "nat list"
   5.151 + index :: nat 
   5.152 +
   5.153 +lemma Ticket_mutex: 
   5.154 + "\<lbrakk> 0<n; I=\<guillemotleft>n=length \<acute>turn \<and> 0<\<acute>nextv \<and> (\<forall>k l. k<n \<and> l<n \<and> k\<noteq>l 
   5.155 +    \<longrightarrow> \<acute>turn!k < \<acute>num \<and> (\<acute>turn!k =0 \<or> \<acute>turn!k\<noteq>\<acute>turn!l))\<guillemotright> \<rbrakk>
   5.156 +   \<Longrightarrow> \<parallel>- .{n=length \<acute>turn}.  
   5.157 +   \<acute>index:= 0,,
   5.158 +   WHILE \<acute>index < n INV .{n=length \<acute>turn \<and> (\<forall>i<\<acute>index. \<acute>turn!i=0)}. 
   5.159 +    DO \<acute>turn:= \<acute>turn[\<acute>index:=0],, \<acute>index:=\<acute>index +1 OD,,
   5.160 +  \<acute>num:=1 ,, \<acute>nextv:=1 ,, 
   5.161 + COBEGIN
   5.162 +  SCHEME [0\<le> i< n]
   5.163 +    .{\<acute>I}.  
   5.164 +     WHILE True INV .{\<acute>I}.  
   5.165 +      DO .{\<acute>I}. \<langle> \<acute>turn :=\<acute>turn[i:=\<acute>num],, \<acute>num:=\<acute>num+1 \<rangle>;;  
   5.166 +         .{\<acute>I}. WAIT \<acute>turn!i=\<acute>nextv END;;
   5.167 +         .{\<acute>I \<and> \<acute>turn!i=\<acute>nextv}. \<acute>nextv:=\<acute>nextv+1
   5.168 +      OD
   5.169 +    .{False}. 
   5.170 + COEND
   5.171 +  .{False}." 
   5.172 +apply oghoare
   5.173 +--{* 35 vc *}
   5.174 +apply simp_all
   5.175 +apply(tactic {* ALLGOALS Clarify_tac *})
   5.176 +apply simp_all
   5.177 +apply(tactic {* ALLGOALS Clarify_tac *})
   5.178 +--{* 11 subgoals left *}
   5.179 +apply(erule less_SucE)
   5.180 + apply simp
   5.181 +apply simp
   5.182 +--{* 10 subgoals left *}
   5.183 +apply force
   5.184 +apply(case_tac "i=k")
   5.185 + apply force
   5.186 +apply simp
   5.187 +apply(case_tac "i=l")
   5.188 + apply force
   5.189 +apply force
   5.190 +--{* 8 subgoals left *}
   5.191 +prefer 8
   5.192 +apply force
   5.193 +apply force
   5.194 +--{* 6 subgoals left *}
   5.195 +prefer 6
   5.196 +apply(erule_tac x=i in allE)
   5.197 +apply force
   5.198 +--{* 5 subgoals left *}
   5.199 +prefer 5
   5.200 +apply(rule conjI)
   5.201 + apply clarify
   5.202 +prefer 2
   5.203 +apply(case_tac "j=i")
   5.204 + apply simp
   5.205 +apply simp
   5.206 +--{* 4 subgoals left *}
   5.207 +apply(tactic {* ALLGOALS (case_tac "j=k") *})
   5.208 +apply simp_all
   5.209 +apply(erule_tac x=i in allE)
   5.210 +apply force
   5.211 +apply(case_tac "j=l")
   5.212 + apply simp
   5.213 + apply(erule_tac x=k in allE)
   5.214 + apply(erule_tac x=k in allE)
   5.215 + apply(erule_tac x=l in allE)
   5.216 + apply force
   5.217 +apply(erule_tac x=k in allE)
   5.218 +apply(erule_tac x=k in allE)
   5.219 +apply(erule_tac x=l in allE)
   5.220 +apply force
   5.221 +--{* 8 subgoals left *}
   5.222 +apply force
   5.223 +apply(case_tac "j=l")
   5.224 + apply simp
   5.225 +apply(erule_tac x=k in allE)
   5.226 +apply(erule_tac x=l in allE)
   5.227 +apply force
   5.228 +apply force
   5.229 +apply force
   5.230 +apply(erule_tac x=k in allE)
   5.231 +apply(erule_tac x=l in allE)
   5.232 +apply(case_tac "j=l")
   5.233 + apply force
   5.234 +apply force
   5.235 +apply force
   5.236 +apply(erule_tac x=k in allE)
   5.237 +apply(erule_tac x=l in allE)
   5.238 +apply(case_tac "j=l")
   5.239 + apply force
   5.240 +apply force
   5.241 +apply force
   5.242 +apply(erule_tac x=k in allE)
   5.243 +apply(erule_tac x=l in allE)
   5.244 +apply(case_tac "j=l")
   5.245 + apply force
   5.246 +apply force
   5.247 +done
   5.248 +
   5.249 +subsection{* Parallel Zero Search *}
   5.250 +
   5.251 +text {* Synchronized Zero Search. Zero-6 *}
   5.252 +
   5.253 +text {*Apt and Olderog. "Verification of sequential and concurrent Programs" page 294: *}
   5.254 +
   5.255 +record Zero_search =
   5.256 +   turn :: nat
   5.257 +   found :: bool
   5.258 +   x :: nat
   5.259 +   y :: nat
   5.260 +
   5.261 +lemma Zero_search: 
   5.262 +  "\<lbrakk>I1= \<guillemotleft> a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
   5.263 +      \<and> (\<not>\<acute>found \<and> a<\<acute> x \<longrightarrow> f(\<acute>x)\<noteq>0) \<guillemotright> ;  
   5.264 +    I2= \<guillemotleft>\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
   5.265 +      \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0) \<guillemotright> \<rbrakk> \<Longrightarrow>  
   5.266 +  \<parallel>- .{\<exists> u. f(u)=0}.  
   5.267 +  \<acute>turn:=1,, \<acute>found:= False,,  
   5.268 +  \<acute>x:=a,, \<acute>y:=a+1 ,,  
   5.269 +  COBEGIN .{\<acute>I1}.  
   5.270 +       WHILE \<not>\<acute>found  
   5.271 +       INV .{\<acute>I1}.  
   5.272 +       DO .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
   5.273 +          WAIT \<acute>turn=1 END;;  
   5.274 +          .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
   5.275 +          \<acute>turn:=2;;  
   5.276 +          .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.    
   5.277 +          \<langle> \<acute>x:=\<acute>x+1,,  
   5.278 +            IF f(\<acute>x)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
   5.279 +       OD;;  
   5.280 +       .{\<acute>I1  \<and> \<acute>found}.  
   5.281 +       \<acute>turn:=2  
   5.282 +       .{\<acute>I1 \<and> \<acute>found}.  
   5.283 +  \<parallel>  
   5.284 +      .{\<acute>I2}.  
   5.285 +       WHILE \<not>\<acute>found  
   5.286 +       INV .{\<acute>I2}.  
   5.287 +       DO .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
   5.288 +          WAIT \<acute>turn=2 END;;  
   5.289 +          .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
   5.290 +          \<acute>turn:=1;;  
   5.291 +          .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
   5.292 +          \<langle> \<acute>y:=(\<acute>y - 1),,  
   5.293 +            IF f(\<acute>y)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
   5.294 +       OD;;  
   5.295 +       .{\<acute>I2 \<and> \<acute>found}.  
   5.296 +       \<acute>turn:=1  
   5.297 +       .{\<acute>I2 \<and> \<acute>found}.  
   5.298 +  COEND  
   5.299 +  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
   5.300 +apply oghoare
   5.301 +--{* 98 verification conditions *}
   5.302 +apply auto 
   5.303 +--{* auto takes about 3 minutes !! *}
   5.304 +apply arith+
   5.305 +done
   5.306 +
   5.307 +text {* Easier Version: without AWAIT.  Apt and Olderog. page 256: *}
   5.308 +
   5.309 +lemma Zero_Search_2: 
   5.310 +"\<lbrakk>I1=\<guillemotleft> a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
   5.311 +    \<and> (\<not>\<acute>found \<and> a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)\<guillemotright>;  
   5.312 + I2= \<guillemotleft>\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> (a<\<acute>x \<and> f(\<acute>x)=0) \<or> (\<acute>y\<le>a \<and> f(\<acute>y)=0)) 
   5.313 +    \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)\<guillemotright>\<rbrakk> \<Longrightarrow>  
   5.314 +  \<parallel>- .{\<exists>u. f(u)=0}.  
   5.315 +  \<acute>found:= False,,  
   5.316 +  \<acute>x:=a,, \<acute>y:=a+1,,  
   5.317 +  COBEGIN .{\<acute>I1}.  
   5.318 +       WHILE \<not>\<acute>found  
   5.319 +       INV .{\<acute>I1}.  
   5.320 +       DO .{a\<le>\<acute>x \<and> (\<acute>found \<longrightarrow> \<acute>y\<le>a \<and> f(\<acute>y)=0) \<and> (a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)}.  
   5.321 +          \<langle> \<acute>x:=\<acute>x+1,,IF f(\<acute>x)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
   5.322 +       OD  
   5.323 +       .{\<acute>I1 \<and> \<acute>found}.  
   5.324 +  \<parallel>  
   5.325 +      .{\<acute>I2}.  
   5.326 +       WHILE \<not>\<acute>found  
   5.327 +       INV .{\<acute>I2}.  
   5.328 +       DO .{\<acute>y\<le>a+1 \<and> (\<acute>found \<longrightarrow> a<\<acute>x \<and> f(\<acute>x)=0) \<and> (\<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)}.  
   5.329 +          \<langle> \<acute>y:=(\<acute>y - 1),,IF f(\<acute>y)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
   5.330 +       OD  
   5.331 +       .{\<acute>I2 \<and> \<acute>found}.  
   5.332 +  COEND  
   5.333 +  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
   5.334 +apply oghoare
   5.335 +--{* 20 vc *}
   5.336 +apply auto
   5.337 +--{* auto takes aprox. 2 minutes. *}
   5.338 +apply arith+
   5.339 +done
   5.340 +
   5.341 +subsection {* Producer/Consumer *}
   5.342 +
   5.343 +subsubsection {* Previous lemmas *}
   5.344 +
   5.345 +lemma nat_lemma1: "\<lbrakk>(c::nat) \<le> a ;a < b\<rbrakk> \<Longrightarrow> b - a \<le> b - c"
   5.346 +by (simp split: nat_diff_split)
   5.347 +
   5.348 +lemma nat_lemma2: "\<lbrakk> b = m*(n::nat) + t; a = s*n + t ; b - a < n \<rbrakk> \<Longrightarrow> m - s = 0"
   5.349 +proof -
   5.350 +  assume "b = m*(n::nat) + t" and "a = s*n + t"
   5.351 +  hence "(m - s) * n = b - a" by (simp add: diff_mult_distrib)
   5.352 +  also assume "\<dots> < n"
   5.353 +  finally have "m - s < 1" by simp
   5.354 +  thus ?thesis by arith
   5.355 +qed
   5.356 +
   5.357 +lemma less_imp_diff_is_0: "m < Suc(n) \<Longrightarrow> m-n = 0"
   5.358 +by arith
   5.359 +lemma mod_lemma: "\<lbrakk> (c::nat) \<le> a; a < b; b - c < n \<rbrakk> \<Longrightarrow> b mod n \<noteq> a mod n"
   5.360 +apply(subgoal_tac "b=b div n*n + b mod n" )
   5.361 + prefer 2  apply (simp add: mod_div_equality [symmetric])
   5.362 +apply(subgoal_tac "a=a div n*n + a mod n")
   5.363 + prefer 2
   5.364 + apply(simp add: mod_div_equality [symmetric])
   5.365 +apply(frule nat_lemma1 , assumption)
   5.366 +apply(drule le_less_trans)
   5.367 +back
   5.368 + apply assumption
   5.369 +apply(frule less_not_refl2)
   5.370 +apply(drule less_imp_le)
   5.371 +apply (drule_tac m = "a" in div_le_mono)
   5.372 +apply(drule_tac m = "a div n" in le_imp_less_Suc)
   5.373 +apply(drule less_imp_diff_is_0)
   5.374 +apply(safe)
   5.375 +apply(simp)
   5.376 +apply(frule_tac b = "b" and a = "a" and n = "n" in nat_lemma2 , assumption)
   5.377 +apply assumption
   5.378 +apply(drule  diffs0_imp_equal)
   5.379 +apply(simp)
   5.380 +apply(simp)
   5.381 +done
   5.382 +
   5.383 +subsubsection {* Producer/Consumer Algorithm *}
   5.384 +
   5.385 +record Producer_consumer =
   5.386 +  ins :: nat
   5.387 +  outs :: nat
   5.388 +  li :: nat
   5.389 +  lj :: nat
   5.390 +  vx :: nat
   5.391 +  vy :: nat
   5.392 +  buffer :: "nat list"
   5.393 +  b :: "nat list"
   5.394 +
   5.395 +text {* The whole proof takes aprox. 4 minutes. *}
   5.396 +
   5.397 +lemma Producer_consumer: 
   5.398 +  "\<lbrakk>INIT= \<guillemotleft>0<length a \<and> 0<length \<acute>buffer \<and> length \<acute>b=length a\<guillemotright> ;  
   5.399 +    I= \<guillemotleft>(\<forall>k<\<acute>ins. \<acute>outs\<le>k \<longrightarrow> (a ! k) = \<acute>buffer ! (k mod (length \<acute>buffer))) \<and>  
   5.400 +            \<acute>outs\<le>\<acute>ins \<and> \<acute>ins-\<acute>outs\<le>length \<acute>buffer\<guillemotright> ;  
   5.401 +    I1= \<guillemotleft>\<acute>I \<and> \<acute>li\<le>length a\<guillemotright> ;  
   5.402 +    p1= \<guillemotleft>\<acute>I1 \<and> \<acute>li=\<acute>ins\<guillemotright> ;  
   5.403 +    I2 = \<guillemotleft>\<acute>I \<and> (\<forall>k<\<acute>lj. (a ! k)=(\<acute>b ! k)) \<and> \<acute>lj\<le>length a\<guillemotright> ;
   5.404 +    p2 = \<guillemotleft>\<acute>I2 \<and> \<acute>lj=\<acute>outs\<guillemotright> \<rbrakk> \<Longrightarrow>   
   5.405 +  \<parallel>- .{\<acute>INIT}.  
   5.406 + \<acute>ins:=0,, \<acute>outs:=0,, \<acute>li:=0,, \<acute>lj:=0,,
   5.407 + COBEGIN .{\<acute>p1 \<and> \<acute>INIT}. 
   5.408 +   WHILE \<acute>li <length a 
   5.409 +     INV .{\<acute>p1 \<and> \<acute>INIT}.   
   5.410 +   DO .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a}.  
   5.411 +       \<acute>vx:= (a ! \<acute>li);;  
   5.412 +      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li)}. 
   5.413 +        WAIT \<acute>ins-\<acute>outs < length \<acute>buffer END;; 
   5.414 +      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li) 
   5.415 +         \<and> \<acute>ins-\<acute>outs < length \<acute>buffer}. 
   5.416 +       \<acute>buffer:=(list_update \<acute>buffer (\<acute>ins mod (length \<acute>buffer)) \<acute>vx);; 
   5.417 +      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a 
   5.418 +         \<and> (a ! \<acute>li)=(\<acute>buffer ! (\<acute>ins mod (length \<acute>buffer))) 
   5.419 +         \<and> \<acute>ins-\<acute>outs <length \<acute>buffer}.  
   5.420 +       \<acute>ins:=\<acute>ins+1;; 
   5.421 +      .{\<acute>I1 \<and> \<acute>INIT \<and> (\<acute>li+1)=\<acute>ins \<and> \<acute>li<length a}.  
   5.422 +       \<acute>li:=\<acute>li+1  
   5.423 +   OD  
   5.424 +  .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li=length a}.  
   5.425 +  \<parallel>  
   5.426 +  .{\<acute>p2 \<and> \<acute>INIT}.  
   5.427 +   WHILE \<acute>lj < length a  
   5.428 +     INV .{\<acute>p2 \<and> \<acute>INIT}.  
   5.429 +   DO .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>INIT}.  
   5.430 +        WAIT \<acute>outs<\<acute>ins END;; 
   5.431 +      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>INIT}.  
   5.432 +       \<acute>vy:=(\<acute>buffer ! (\<acute>outs mod (length \<acute>buffer)));; 
   5.433 +      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
   5.434 +       \<acute>outs:=\<acute>outs+1;;  
   5.435 +      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
   5.436 +       \<acute>b:=(list_update \<acute>b \<acute>lj \<acute>vy);; 
   5.437 +      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> (a ! \<acute>lj)=(\<acute>b ! \<acute>lj) \<and> \<acute>INIT}.  
   5.438 +       \<acute>lj:=\<acute>lj+1  
   5.439 +   OD  
   5.440 +  .{\<acute>p2 \<and> \<acute>lj=length a \<and> \<acute>INIT}.  
   5.441 + COEND  
   5.442 + .{ \<forall>k<length a. (a ! k)=(\<acute>b ! k)}."
   5.443 +apply oghoare
   5.444 +--{* 138 vc  *}
   5.445 +apply(tactic {* ALLGOALS Clarify_tac *})
   5.446 +--{* 112 subgoals left *}
   5.447 +apply(simp_all (no_asm))
   5.448 +apply(tactic {*ALLGOALS (conjI_Tac (K all_tac)) *})
   5.449 +--{* 860 subgoals left *}
   5.450 +apply(tactic {* ALLGOALS Clarify_tac *})
   5.451 +apply(simp_all only:length_0_conv [THEN sym])
   5.452 +--{* 36 subgoals left *}
   5.453 +apply (simp_all del:length_0_conv add: nth_list_update mod_less_divisor mod_lemma)
   5.454 +--{* 32 subgoals left *}
   5.455 +apply(tactic {* ALLGOALS Clarify_tac *})
   5.456 +apply(tactic {* TRYALL arith_tac *})
   5.457 +--{* 9 subgoals left *}
   5.458 +apply (force simp add:less_Suc_eq)
   5.459 +apply(drule sym)
   5.460 +apply (force simp add:less_Suc_eq)+
   5.461 +done
   5.462 +
   5.463 +subsection {* Parameterized Examples *}
   5.464 +
   5.465 +subsubsection {* Set Elements of an Array to Zero *}
   5.466 +
   5.467 +record scheme1_vars =
   5.468 +  a :: "nat \<Rightarrow> nat"
   5.469 +lemma scheme1: 
   5.470 + "\<parallel>- .{True}.
   5.471 +   COBEGIN SCHEME [0\<le>i<n] .{True}. \<acute>a:=\<acute>a (i:=0) .{\<acute>a i=0}. COEND 
   5.472 +  .{\<forall>i < n. \<acute>a i = 0}."
   5.473 +apply oghoare
   5.474 +apply simp_all
   5.475 +done
   5.476 +
   5.477 +text {* Same example with lists as auxiliary variables. *}
   5.478 +record scheme1_list_vars =
   5.479 +  a :: "nat list"
   5.480 +lemma scheme1_list: 
   5.481 + "\<parallel>- .{n < length \<acute>a}. 
   5.482 +   COBEGIN 
   5.483 +     SCHEME [0\<le>i<n] .{n < length \<acute>a}. \<acute>a:=\<acute>a[i:=0] .{\<acute>a!i=0}. 
   5.484 +   COEND 
   5.485 +    .{\<forall>i < n. \<acute>a!i = 0}."
   5.486 +apply oghoare
   5.487 +apply simp_all
   5.488 +  apply force+
   5.489 +apply clarify
   5.490 +apply (simp add:nth_list_update)
   5.491 +done
   5.492 +
   5.493 +subsubsection {* Increment a Variable in Parallel *}
   5.494 +
   5.495 +text {* First some lemmas about summation properties. Summation is
   5.496 +defined in PreList. *}
   5.497 +
   5.498 +lemma scheme2_lemma1: "!!b. j<n \<Longrightarrow> (\<Sum>i<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
   5.499 +apply(induct n)
   5.500 + apply simp_all
   5.501 +apply(force simp add: less_Suc_eq)
   5.502 +done
   5.503 +
   5.504 +lemma scheme2_lemma2_aux: "!!b. j<n \<Longrightarrow> 
   5.505 + (\<Sum>i<n. (b i::nat)) = (\<Sum>i<j. b i) + b j + (\<Sum>i<n-(Suc j) . b (Suc j + i))"
   5.506 +apply(induct n)
   5.507 + apply simp_all
   5.508 +apply(simp add:less_Suc_eq)
   5.509 + apply(auto)
   5.510 +apply(subgoal_tac "n - j = Suc(n- Suc j)")
   5.511 +  apply simp
   5.512 +apply arith
   5.513 +done 
   5.514 +
   5.515 +lemma scheme2_lemma2_aux2: "!!b. j\<le> s \<Longrightarrow> (\<Sum>i<j. (b (s:=t)) i) = (\<Sum>i<j. b i)"
   5.516 +apply(induct j)
   5.517 + apply simp_all
   5.518 +done
   5.519 +
   5.520 +lemma scheme2_lemma2 [rule_format]: 
   5.521 + "!!b. \<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i< n. b i)=(\<Sum>i< n. (b (j := Suc 0)) i)"
   5.522 +apply(frule_tac b="(b (j:=(Suc 0)))" in scheme2_lemma2_aux)
   5.523 +apply(erule_tac  t="Summation (b(j := (Suc 0))) n" in ssubst)
   5.524 +apply(frule_tac b=b in scheme2_lemma2_aux)
   5.525 +apply(erule_tac  t="Summation b n" in ssubst)
   5.526 +apply(subgoal_tac "Suc (Summation b j + b j + (\<Sum>i<n - Suc j. b (Suc j + i)))=(Summation b j + Suc (b j) + (\<Sum>i<n - Suc j. b (Suc j + i)))")
   5.527 +apply(rotate_tac -1)
   5.528 +apply(erule ssubst)
   5.529 +apply(subgoal_tac "j\<le>j")
   5.530 + apply(drule_tac b="b" and t="(Suc 0)" in scheme2_lemma2_aux2)
   5.531 +apply(rotate_tac -1)
   5.532 +apply(erule ssubst)
   5.533 +apply simp_all
   5.534 +done
   5.535 +
   5.536 +lemma scheme2_lemma3: "!!b. \<forall>i< n. b i = (Suc 0) \<Longrightarrow> (\<Sum>i<n. b i)= n"
   5.537 +apply (induct n)
   5.538 +apply auto
   5.539 +done
   5.540 +
   5.541 +record scheme2_vars = 
   5.542 + c :: "nat \<Rightarrow> nat" 
   5.543 + x :: nat
   5.544 +lemma scheme_2: "0<n \<Longrightarrow> 
   5.545 + \<parallel>- .{\<acute>x=0 \<and> (\<Sum>i< n. \<acute>c i)=0}.  
   5.546 + COBEGIN 
   5.547 +   SCHEME [0\<le>i<n] 
   5.548 +  .{\<acute>x=(\<Sum>i< n. \<acute>c i) \<and> \<acute>c i=0}. 
   5.549 +   \<langle> \<acute>x:=\<acute>x+(Suc 0),, \<acute>c:=\<acute>c (i:=(Suc 0)) \<rangle>
   5.550 +  .{\<acute>x=(\<Sum>i< n. \<acute>c i) \<and> \<acute>c i=(Suc 0)}.
   5.551 + COEND 
   5.552 + .{\<acute>x=n}."
   5.553 +apply oghoare
   5.554 +apply simp_all
   5.555 +apply (tactic {* ALLGOALS Clarify_tac *})
   5.556 +apply simp_all
   5.557 +    apply(force elim:scheme2_lemma1)
   5.558 +   apply(erule scheme2_lemma2)
   5.559 +   apply simp
   5.560 +  apply(erule scheme2_lemma2)
   5.561 +  apply simp
   5.562 + apply(erule scheme2_lemma2)
   5.563 + apply simp
   5.564 +apply(force intro: scheme2_lemma3)
   5.565 +done
   5.566 +
   5.567 +end
   5.568 \ No newline at end of file
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/HoareParallel/OG_Hoare.thy	Tue Mar 05 17:11:25 2002 +0100
     6.3 @@ -0,0 +1,495 @@
     6.4 +
     6.5 +header {* \section{The Proof System} *}
     6.6 +
     6.7 +theory OG_Hoare = OG_Tran:
     6.8 +
     6.9 +consts assertions :: "'a ann_com \<Rightarrow> ('a assn) set"
    6.10 +primrec
    6.11 +  "assertions (AnnBasic r f) = {r}"
    6.12 +  "assertions (AnnSeq c1 c2) = assertions c1 \<union> assertions c2"
    6.13 +  "assertions (AnnCond1 r b c1 c2) = {r} \<union> assertions c1 \<union> assertions c2"
    6.14 +  "assertions (AnnCond2 r b c) = {r} \<union> assertions c"
    6.15 +  "assertions (AnnWhile r b i c) = {r, i} \<union> assertions c"
    6.16 +  "assertions (AnnAwait r b c) = {r}" 
    6.17 +
    6.18 +consts atomics :: "'a ann_com \<Rightarrow> ('a assn \<times> 'a com) set"       
    6.19 +primrec
    6.20 +  "atomics (AnnBasic r f) = {(r, Basic f)}"
    6.21 +  "atomics (AnnSeq c1 c2) = atomics c1 \<union> atomics c2"
    6.22 +  "atomics (AnnCond1 r b c1 c2) = atomics c1 \<union> atomics c2"
    6.23 +  "atomics (AnnCond2 r b c) = atomics c"
    6.24 +  "atomics (AnnWhile r b i c) = atomics c" 
    6.25 +  "atomics (AnnAwait r b c) = {(r \<inter> b, c)}"
    6.26 +
    6.27 +consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
    6.28 +primrec "com (c, q) = c"
    6.29 +
    6.30 +consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
    6.31 +primrec "post (c, q) = q"
    6.32 +
    6.33 +constdefs  interfree_aux :: "('a ann_com_op \<times> 'a assn \<times> 'a ann_com_op) \<Rightarrow> bool"
    6.34 +  "interfree_aux \<equiv> \<lambda>(co, q, co'). co'= None \<or>  
    6.35 +                    (\<forall>(r,a) \<in> atomics (the co'). \<parallel>= (q \<inter> r) a q \<and>
    6.36 +                    (co = None \<or> (\<forall>p \<in> assertions (the co). \<parallel>= (p \<inter> r) a p)))"
    6.37 +
    6.38 +constdefs interfree :: "(('a ann_triple_op) list) \<Rightarrow> bool" 
    6.39 +  "interfree Ts \<equiv> \<forall>i j. i < length Ts \<and> j < length Ts \<and> i \<noteq> j \<longrightarrow> 
    6.40 +                         interfree_aux (com (Ts!i), post (Ts!i), com (Ts!j)) "
    6.41 +
    6.42 +consts ann_hoare :: "('a ann_com \<times> 'a assn) set" 
    6.43 +syntax "_ann_hoare" :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(2\<turnstile> _// _)" [60,90] 45)
    6.44 +translations "\<turnstile> c q" \<rightleftharpoons> "(c, q) \<in> ann_hoare"
    6.45 +
    6.46 +consts oghoare :: "('a assn \<times> 'a com \<times> 'a assn) set"
    6.47 +syntax "_oghoare" :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>- _//_//_)" [90,55,90] 50)
    6.48 +translations "\<parallel>- p c q" \<rightleftharpoons> "(p, c, q) \<in> oghoare"
    6.49 +
    6.50 +inductive oghoare ann_hoare
    6.51 +intros
    6.52 +  AnnBasic: "r \<subseteq> {s. f s \<in> q} \<Longrightarrow> \<turnstile> (AnnBasic r f) q"
    6.53 +
    6.54 +  AnnSeq:   "\<lbrakk> \<turnstile> c0 pre c1; \<turnstile> c1 q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnSeq c0 c1) q"
    6.55 +  
    6.56 +  AnnCond1: "\<lbrakk> r \<inter> b \<subseteq> pre c1; \<turnstile> c1 q; r \<inter> -b \<subseteq> pre c2; \<turnstile> c2 q\<rbrakk> 
    6.57 +              \<Longrightarrow> \<turnstile> (AnnCond1 r b c1 c2) q"
    6.58 +  AnnCond2: "\<lbrakk> r \<inter> b \<subseteq> pre c; \<turnstile> c q; r \<inter> -b \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnCond2 r b c) q"
    6.59 +  
    6.60 +  AnnWhile: "\<lbrakk> r \<subseteq> i; i \<inter> b \<subseteq> pre c; \<turnstile> c i; i \<inter> -b \<subseteq> q \<rbrakk> 
    6.61 +              \<Longrightarrow> \<turnstile> (AnnWhile r b i c) q"
    6.62 +  
    6.63 +  AnnAwait:  "\<lbrakk> atom_com c; \<parallel>- (r \<inter> b) c q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b c) q"
    6.64 +  
    6.65 +  AnnConseq: "\<lbrakk>\<turnstile> c q; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<turnstile> c q'"
    6.66 +
    6.67 +
    6.68 +  Parallel: "\<lbrakk> \<forall>i<length Ts. \<exists>c q. Ts!i = (Some c, q) \<and> \<turnstile> c q; interfree Ts \<rbrakk>
    6.69 +	   \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
    6.70 +                     Parallel Ts 
    6.71 +                  (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
    6.72 +
    6.73 +  Basic:   "\<parallel>- {s. f s \<in>q} (Basic f) q"
    6.74 +  
    6.75 +  Seq:    "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q "
    6.76 +
    6.77 +  Cond:   "\<lbrakk> \<parallel>- (p \<inter> b) c1 q; \<parallel>- (p \<inter> -b) c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
    6.78 +
    6.79 +  While:  "\<lbrakk> \<parallel>- (p \<inter> b) c p \<rbrakk> \<Longrightarrow> \<parallel>- p (While b i c) (p \<inter> -b)"
    6.80 +
    6.81 +  Conseq: "\<lbrakk> p' \<subseteq> p; \<parallel>- p c q ; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<parallel>- p' c q'"
    6.82 +					    
    6.83 +section {* Soundness *}
    6.84 +(* In the version Isabelle-10-Sep-1999: HOL: The THEN and ELSE
    6.85 +parts of conditional expressions (if P then x else y) are no longer
    6.86 +simplified.  (This allows the simplifier to unfold recursive
    6.87 +functional programs.)  To restore the old behaviour, we declare
    6.88 +@{text "lemmas [cong del] = if_weak_cong"}. *)
    6.89 +
    6.90 +lemmas [cong del] = if_weak_cong
    6.91 +
    6.92 +lemmas ann_hoare_induct = oghoare_ann_hoare.induct [THEN conjunct2]
    6.93 +lemmas oghoare_induct = oghoare_ann_hoare.induct [THEN conjunct1]
    6.94 +
    6.95 +lemmas AnnBasic = oghoare_ann_hoare.AnnBasic
    6.96 +lemmas AnnSeq = oghoare_ann_hoare.AnnSeq
    6.97 +lemmas AnnCond1 = oghoare_ann_hoare.AnnCond1
    6.98 +lemmas AnnCond2 = oghoare_ann_hoare.AnnCond2
    6.99 +lemmas AnnWhile = oghoare_ann_hoare.AnnWhile
   6.100 +lemmas AnnAwait = oghoare_ann_hoare.AnnAwait
   6.101 +lemmas AnnConseq = oghoare_ann_hoare.AnnConseq
   6.102 +
   6.103 +lemmas Parallel = oghoare_ann_hoare.Parallel
   6.104 +lemmas Basic = oghoare_ann_hoare.Basic
   6.105 +lemmas Seq = oghoare_ann_hoare.Seq
   6.106 +lemmas Cond = oghoare_ann_hoare.Cond
   6.107 +lemmas While = oghoare_ann_hoare.While
   6.108 +lemmas Conseq = oghoare_ann_hoare.Conseq
   6.109 +
   6.110 +subsection {* Soundness of the System for Atomic Programs *}
   6.111 +
   6.112 +lemma Basic_ntran [rule_format]: 
   6.113 + "(Basic f, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow> t = f s"
   6.114 +apply(induct "n")
   6.115 + apply(simp (no_asm))
   6.116 +apply(fast dest: rel_pow_Suc_D2 Parallel_empty_lemma elim: transition_cases)
   6.117 +done
   6.118 +
   6.119 +lemma SEM_fwhile: "SEM S (p \<inter> b) \<subseteq> p \<Longrightarrow> SEM (fwhile b S k) p \<subseteq> (p \<inter> -b)"
   6.120 +apply (induct "k")
   6.121 + apply(simp (no_asm) add: L3_5v_lemma3)
   6.122 +apply(simp (no_asm) add: L3_5iv L3_5ii Parallel_empty)
   6.123 +apply(rule Un_least)
   6.124 + apply(rule subset_trans)
   6.125 +  prefer 2 apply simp
   6.126 + apply(erule L3_5i)
   6.127 +apply(simp add: SEM_def sem_def id_def)
   6.128 +apply clarify
   6.129 +apply(drule rtrancl_imp_UN_rel_pow)
   6.130 +apply clarify
   6.131 +apply(drule Basic_ntran)
   6.132 + apply fast+
   6.133 +done
   6.134 +
   6.135 +lemma atom_hoare_sound [rule_format (no_asm)]: 
   6.136 + " \<parallel>- p c q \<longrightarrow> atom_com(c) \<longrightarrow> \<parallel>= p c q"
   6.137 +apply (unfold com_validity_def)
   6.138 +apply(rule oghoare_induct)
   6.139 +apply simp_all
   6.140 +--{*Basic*}
   6.141 +    apply(simp add: SEM_def sem_def)
   6.142 +    apply(fast dest: rtrancl_imp_UN_rel_pow Basic_ntran)
   6.143 +--{* Seq *}
   6.144 +   apply(rule impI)
   6.145 +   apply(rule subset_trans)
   6.146 +    prefer 2 apply simp
   6.147 +   apply(simp add: L3_5ii L3_5i)
   6.148 +--{* Cond *}
   6.149 +  apply(rule impI)
   6.150 +  apply(simp add: L3_5iv)
   6.151 +  apply(erule Un_least)
   6.152 +  apply assumption
   6.153 +--{* While *}
   6.154 + apply(rule impI)
   6.155 + apply(simp add: L3_5v)
   6.156 + apply(rule UN_least)
   6.157 + apply(drule SEM_fwhile)
   6.158 + apply assumption
   6.159 +--{* Conseq *}
   6.160 +apply(simp add: SEM_def sem_def)
   6.161 +apply force
   6.162 +done
   6.163 +    
   6.164 +subsection {* Soundness of the System for Component Programs *}
   6.165 +
   6.166 +inductive_cases ann_transition_cases:
   6.167 +    "(None,s) -1\<rightarrow> t"
   6.168 +    "(Some (AnnBasic r f),s) -1\<rightarrow> t"
   6.169 +    "(Some (AnnSeq c1 c2), s) -1\<rightarrow> t" 
   6.170 +    "(Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> t"
   6.171 +    "(Some (AnnCond2 r b c), s) -1\<rightarrow> t"
   6.172 +    "(Some (AnnWhile r b I c), s) -1\<rightarrow> t"
   6.173 +    "(Some (AnnAwait r b c),s) -1\<rightarrow> t"
   6.174 +
   6.175 +text {* Strong Soundness for Component Programs:*}
   6.176 +
   6.177 +lemma ann_hoare_case_analysis [rule_format]: "\<turnstile> C q' \<longrightarrow>  
   6.178 +  ((\<forall>r f. C = AnnBasic r f \<longrightarrow> (\<exists>q. r \<subseteq> {s. f s \<in> q} \<and> q \<subseteq> q')) \<and>  
   6.179 +  (\<forall>c0 c1. C = AnnSeq c0 c1 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<turnstile> c0 pre c1 \<and> \<turnstile> c1 q)) \<and>  
   6.180 +  (\<forall>r b c1 c2. C = AnnCond1 r b c1 c2 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and>  
   6.181 +  r \<inter> b \<subseteq> pre c1 \<and> \<turnstile> c1 q \<and> r \<inter> -b \<subseteq> pre c2 \<and> \<turnstile> c2 q)) \<and>  
   6.182 +  (\<forall>r b c. C = AnnCond2 r b c \<longrightarrow> 
   6.183 +  (\<exists>q. q \<subseteq> q' \<and> r \<inter> b \<subseteq> pre c  \<and> \<turnstile> c q \<and> r \<inter> -b \<subseteq> q)) \<and>  
   6.184 +  (\<forall>r i b c. C = AnnWhile r b i c \<longrightarrow>  
   6.185 +  (\<exists>q. q \<subseteq> q' \<and> r \<subseteq> i \<and> i \<inter> b \<subseteq> pre c \<and> \<turnstile> c i \<and> i \<inter> -b \<subseteq> q)) \<and>  
   6.186 +  (\<forall>r b c. C = AnnAwait r b c \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<parallel>- (r \<inter> b) c q)))"
   6.187 +apply(rule ann_hoare_induct)
   6.188 +apply simp_all
   6.189 + apply(rule_tac x=q in exI,simp)+
   6.190 +apply(rule conjI,clarify,simp,clarify,rule_tac x=qa in exI,fast)+
   6.191 +apply(clarify,simp,clarify,rule_tac x=qa in exI,fast)
   6.192 +done
   6.193 +
   6.194 +lemma Help: "(transition \<inter> {(v,v,u). True}) = (transition)"
   6.195 +apply force
   6.196 +done
   6.197 +
   6.198 +lemma Strong_Soundness_aux_aux [rule_format]: 
   6.199 + "(co, s) -1\<rightarrow> (co', t) \<longrightarrow> (\<forall>c. co = Some c \<longrightarrow> s\<in> pre c \<longrightarrow> 
   6.200 + (\<forall>q. \<turnstile> c q \<longrightarrow> (if co' = None then t\<in>q else t \<in> pre(the co') \<and> \<turnstile> (the co') q )))"
   6.201 +apply(rule ann_transition_transition.induct [THEN conjunct1])
   6.202 +apply simp_all 
   6.203 +--{* Basic *}
   6.204 +         apply clarify
   6.205 +         apply(frule ann_hoare_case_analysis)
   6.206 +         apply force
   6.207 +--{* Seq *}
   6.208 +        apply clarify
   6.209 +        apply(frule ann_hoare_case_analysis,simp)
   6.210 +        apply(fast intro: AnnConseq)
   6.211 +       apply clarify
   6.212 +       apply(frule ann_hoare_case_analysis,simp)
   6.213 +       apply clarify
   6.214 +       apply(rule conjI)
   6.215 +        apply force
   6.216 +       apply(rule AnnSeq,simp)
   6.217 +       apply(fast intro: AnnConseq)
   6.218 +--{* Cond1 *}
   6.219 +      apply clarify
   6.220 +      apply(frule ann_hoare_case_analysis,simp)
   6.221 +      apply(fast intro: AnnConseq)
   6.222 +     apply clarify
   6.223 +     apply(frule ann_hoare_case_analysis,simp)
   6.224 +     apply(fast intro: AnnConseq)
   6.225 +--{* Cond2 *}
   6.226 +    apply clarify
   6.227 +    apply(frule ann_hoare_case_analysis,simp)
   6.228 +    apply(fast intro: AnnConseq)
   6.229 +   apply clarify
   6.230 +   apply(frule ann_hoare_case_analysis,simp)
   6.231 +   apply(fast intro: AnnConseq)
   6.232 +--{* While *}
   6.233 +  apply clarify
   6.234 +  apply(frule ann_hoare_case_analysis,simp)
   6.235 +  apply force
   6.236 + apply clarify
   6.237 + apply(frule ann_hoare_case_analysis,simp)
   6.238 + apply auto
   6.239 + apply(rule AnnSeq)
   6.240 +  apply simp
   6.241 + apply(rule AnnWhile)
   6.242 +  apply simp_all
   6.243 + apply(fast)
   6.244 +--{* Await *}
   6.245 +apply(frule ann_hoare_case_analysis,simp)
   6.246 +apply clarify
   6.247 +apply(drule atom_hoare_sound)
   6.248 + apply simp 
   6.249 +apply(simp add: com_validity_def SEM_def sem_def)
   6.250 +apply(simp add: Help All_None_def)
   6.251 +apply force
   6.252 +done
   6.253 +
   6.254 +lemma Strong_Soundness_aux: "\<lbrakk> (Some c, s) -*\<rightarrow> (co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
   6.255 +  \<Longrightarrow> if co = None then t \<in> q else t \<in> pre (the co) \<and> \<turnstile> (the co) q"
   6.256 +apply(erule rtrancl_induct2)
   6.257 + apply simp
   6.258 +apply(case_tac "a")
   6.259 + apply(fast elim: ann_transition_cases)
   6.260 +apply(erule Strong_Soundness_aux_aux)
   6.261 + apply simp
   6.262 +apply simp_all
   6.263 +done
   6.264 +
   6.265 +lemma Strong_Soundness: "\<lbrakk> (Some c, s)-*\<rightarrow>(co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
   6.266 +  \<Longrightarrow> if co = None then t\<in>q else t \<in> pre (the co)"
   6.267 +apply(force dest:Strong_Soundness_aux)
   6.268 +done
   6.269 +
   6.270 +lemma ann_hoare_sound: "\<turnstile> c q  \<Longrightarrow> \<Turnstile> c q"
   6.271 +apply (unfold ann_com_validity_def ann_SEM_def ann_sem_def)
   6.272 +apply clarify
   6.273 +apply(drule Strong_Soundness)
   6.274 +apply simp_all
   6.275 +done
   6.276 +
   6.277 +subsection {* Soundness of the System for Parallel Programs *}
   6.278 +
   6.279 +lemma Parallel_length_post_P1: "(Parallel Ts,s) -P1\<rightarrow> (R', t) \<Longrightarrow>  
   6.280 +  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>
   6.281 +  (\<forall>i. i<length Ts \<longrightarrow> post(Rs ! i) = post(Ts ! i)))"
   6.282 +apply(erule transition_cases)
   6.283 +apply simp
   6.284 +apply clarify
   6.285 +apply(case_tac "i=ia")
   6.286 +apply simp+
   6.287 +done
   6.288 +
   6.289 +lemma Parallel_length_post_PStar: "(Parallel Ts,s) -P*\<rightarrow> (R',t) \<Longrightarrow>   
   6.290 +  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>  
   6.291 +  (\<forall>i. i<length Ts \<longrightarrow> post(Ts ! i) = post(Rs ! i)))"
   6.292 +apply(erule rtrancl_induct2)
   6.293 + apply(simp_all)
   6.294 +apply clarify
   6.295 +apply simp
   6.296 +apply(drule Parallel_length_post_P1)
   6.297 +apply auto
   6.298 +done
   6.299 +
   6.300 +lemma assertions_lemma: "pre c \<in> assertions c"
   6.301 +apply(rule ann_com_com.induct [THEN conjunct1])
   6.302 +apply auto
   6.303 +done
   6.304 +
   6.305 +lemma interfree_aux1 [rule_format]: 
   6.306 +  "(c,s) -1\<rightarrow> (r,t)  \<longrightarrow> (interfree_aux(c1, q1, c) \<longrightarrow> interfree_aux(c1, q1, r))"
   6.307 +apply (rule ann_transition_transition.induct [THEN conjunct1])
   6.308 +apply(safe)
   6.309 +prefer 13
   6.310 +apply (rule TrueI)
   6.311 +apply (simp_all add:interfree_aux_def)
   6.312 +apply force+
   6.313 +done
   6.314 +
   6.315 +lemma interfree_aux2 [rule_format]: 
   6.316 +  "(c,s) -1\<rightarrow> (r,t) \<longrightarrow> (interfree_aux(c, q, a)  \<longrightarrow> interfree_aux(r, q, a) )"
   6.317 +apply (rule ann_transition_transition.induct [THEN conjunct1])
   6.318 +apply(force simp add:interfree_aux_def)+
   6.319 +done
   6.320 +
   6.321 +lemma interfree_lemma: "\<lbrakk> (Some c, s) -1\<rightarrow> (r, t);interfree Ts ; i<length Ts;  
   6.322 +           Ts!i = (Some c, q) \<rbrakk> \<Longrightarrow> interfree (Ts[i:= (r, q)])"
   6.323 +apply(simp add: interfree_def)
   6.324 +apply clarify
   6.325 +apply(case_tac "i=j")
   6.326 + apply(drule_tac t = "ia" in not_sym)
   6.327 + apply simp_all
   6.328 +apply(force elim: interfree_aux1)
   6.329 +apply(force elim: interfree_aux2 simp add:nth_list_update)
   6.330 +done
   6.331 +
   6.332 +text {* Strong Soundness Theorem for Parallel Programs:*}
   6.333 +
   6.334 +lemma Parallel_Strong_Soundness_Seq_aux: 
   6.335 +  "\<lbrakk>interfree Ts; i<length Ts; com(Ts ! i) = Some(AnnSeq c0 c1) \<rbrakk> 
   6.336 +  \<Longrightarrow>  interfree (Ts[i:=(Some c0, pre c1)])"
   6.337 +apply(simp add: interfree_def)
   6.338 +apply clarify
   6.339 +apply(case_tac "i=j")
   6.340 + apply(force simp add: nth_list_update interfree_aux_def)
   6.341 +apply(case_tac "i=ia")
   6.342 + apply(erule_tac x=ia in allE)
   6.343 + apply(force simp add:interfree_aux_def assertions_lemma)
   6.344 +apply simp
   6.345 +done
   6.346 +
   6.347 +lemma Parallel_Strong_Soundness_Seq [rule_format (no_asm)]: 
   6.348 + "\<lbrakk> \<forall>i<length Ts. (if com(Ts!i) = None then b \<in> post(Ts!i) 
   6.349 +  else b \<in> pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i));  
   6.350 +  com(Ts ! i) = Some(AnnSeq c0 c1); i<length Ts; interfree Ts \<rbrakk> \<Longrightarrow> 
   6.351 + (\<forall>ia<length Ts. (if com(Ts[i:=(Some c0, pre c1)]! ia) = None  
   6.352 +  then b \<in> post(Ts[i:=(Some c0, pre c1)]! ia) 
   6.353 + else b \<in> pre(the(com(Ts[i:=(Some c0, pre c1)]! ia))) \<and>  
   6.354 + \<turnstile> the(com(Ts[i:=(Some c0, pre c1)]! ia)) post(Ts[i:=(Some c0, pre c1)]! ia))) 
   6.355 +  \<and> interfree (Ts[i:= (Some c0, pre c1)])"
   6.356 +apply(rule conjI)
   6.357 + apply safe
   6.358 + apply(case_tac "i=ia")
   6.359 +  apply simp
   6.360 +  apply(force dest: ann_hoare_case_analysis)
   6.361 + apply simp
   6.362 +apply(fast elim: Parallel_Strong_Soundness_Seq_aux)
   6.363 +done
   6.364 +
   6.365 +lemma Parallel_Strong_Soundness_aux_aux [rule_format]: 
   6.366 + "(Some c, b) -1\<rightarrow> (co, t) \<longrightarrow>  
   6.367 +  (\<forall>Ts. i<length Ts \<longrightarrow> com(Ts ! i) = Some c \<longrightarrow>  
   6.368 +  (\<forall>i<length Ts. (if com(Ts ! i) = None then b\<in>post(Ts!i)  
   6.369 +  else b\<in>pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i))) \<longrightarrow>  
   6.370 + interfree Ts \<longrightarrow>  
   6.371 +  (\<forall>j. j<length Ts \<and> i\<noteq>j \<longrightarrow> (if com(Ts!j) = None then t\<in>post(Ts!j)  
   6.372 +  else t\<in>pre(the(com(Ts!j))) \<and> \<turnstile> the(com(Ts!j)) post(Ts!j))) )"
   6.373 +apply(rule ann_transition_transition.induct [THEN conjunct1])
   6.374 +apply safe
   6.375 +prefer 11
   6.376 +apply(rule TrueI)
   6.377 +apply simp_all
   6.378 +--{* Basic *}
   6.379 +   apply(erule_tac x = "i" in all_dupE, erule (1) notE impE)
   6.380 +   apply(erule_tac x = "j" in allE , erule (1) notE impE)
   6.381 +   apply(simp add: interfree_def)
   6.382 +   apply(erule_tac x = "j" in allE,simp)
   6.383 +   apply(erule_tac x = "i" in allE,simp)
   6.384 +   apply(drule_tac t = "i" in not_sym)
   6.385 +   apply(case_tac "com(Ts ! j)=None")
   6.386 +    apply(force intro: converse_rtrancl_into_rtrancl
   6.387 +          simp add: interfree_aux_def com_validity_def SEM_def sem_def All_None_def)
   6.388 +   apply(simp add:interfree_aux_def)
   6.389 +   apply clarify
   6.390 +   apply simp
   6.391 +   apply clarify
   6.392 +   apply(erule_tac x="pre y" in ballE)
   6.393 +    apply(force intro: converse_rtrancl_into_rtrancl 
   6.394 +          simp add: com_validity_def SEM_def sem_def All_None_def)
   6.395 +   apply(simp add:assertions_lemma)
   6.396 +--{* Seqs *}
   6.397 +  apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
   6.398 +  apply(drule  Parallel_Strong_Soundness_Seq,simp+)
   6.399 + apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
   6.400 + apply(drule  Parallel_Strong_Soundness_Seq,simp+)
   6.401 +--{* Await *}
   6.402 +apply(rule_tac x = "i" in allE , assumption , erule (1) notE impE)
   6.403 +apply(erule_tac x = "j" in allE , erule (1) notE impE)
   6.404 +apply(simp add: interfree_def)
   6.405 +apply(erule_tac x = "j" in allE,simp)
   6.406 +apply(erule_tac x = "i" in allE,simp)
   6.407 +apply(drule_tac t = "i" in not_sym)
   6.408 +apply(case_tac "com(Ts ! j)=None")
   6.409 + apply(force intro: converse_rtrancl_into_rtrancl simp add: interfree_aux_def 
   6.410 +        com_validity_def SEM_def sem_def All_None_def Help)
   6.411 +apply(simp add:interfree_aux_def)
   6.412 +apply clarify
   6.413 +apply simp
   6.414 +apply clarify
   6.415 +apply(erule_tac x="pre y" in ballE)
   6.416 + apply(force intro: converse_rtrancl_into_rtrancl 
   6.417 +       simp add: com_validity_def SEM_def sem_def All_None_def Help)
   6.418 +apply(simp add:assertions_lemma)
   6.419 +done
   6.420 +
   6.421 +lemma Parallel_Strong_Soundness_aux [rule_format]: 
   6.422 + "\<lbrakk>(Ts',s) -P*\<rightarrow> (Rs',t);  Ts' = (Parallel Ts); interfree Ts;
   6.423 + \<forall>i. i<length Ts \<longrightarrow> (\<exists>c q. (Ts ! i) = (Some c, q) \<and> s\<in>(pre c) \<and> \<turnstile> c q ) \<rbrakk> \<Longrightarrow>  
   6.424 +  \<forall>Rs. Rs' = (Parallel Rs) \<longrightarrow> (\<forall>j. j<length Rs \<longrightarrow> 
   6.425 +  (if com(Rs ! j) = None then t\<in>post(Ts ! j) 
   6.426 +  else t\<in>pre(the(com(Rs ! j))) \<and> \<turnstile> the(com(Rs ! j)) post(Ts ! j))) \<and> interfree Rs"
   6.427 +apply(erule rtrancl_induct2)
   6.428 + apply clarify
   6.429 +--{* Base *}
   6.430 + apply force
   6.431 +--{* Induction step *}
   6.432 +apply clarify
   6.433 +apply(drule Parallel_length_post_PStar)
   6.434 +apply clarify
   6.435 +apply (ind_cases "(Parallel Ts, s) -P1\<rightarrow> (Parallel Rs, t)")
   6.436 +apply(rule conjI)
   6.437 + apply clarify
   6.438 + apply(case_tac "i=j")
   6.439 +  apply(simp split del:split_if)
   6.440 +  apply(erule Strong_Soundness_aux_aux,simp+)
   6.441 +   apply force
   6.442 +  apply force
   6.443 + apply(simp split del: split_if)
   6.444 + apply(erule Parallel_Strong_Soundness_aux_aux)
   6.445 + apply(simp_all add: split del:split_if)
   6.446 + apply force
   6.447 +apply(rule interfree_lemma)
   6.448 +apply simp_all
   6.449 +done
   6.450 +
   6.451 +lemma Parallel_Strong_Soundness: 
   6.452 + "\<lbrakk>(Parallel Ts, s) -P*\<rightarrow> (Parallel Rs, t); interfree Ts; j<length Rs; 
   6.453 +  \<forall>i. i<length Ts \<longrightarrow> (\<exists>c q. Ts ! i = (Some c, q) \<and> s\<in>pre c \<and> \<turnstile> c q) \<rbrakk> \<Longrightarrow>  
   6.454 +  if com(Rs ! j) = None then t\<in>post(Ts ! j) else t\<in>pre (the(com(Rs ! j)))"
   6.455 +apply(drule  Parallel_Strong_Soundness_aux)
   6.456 +apply simp+
   6.457 +done
   6.458 +
   6.459 +lemma oghoare_sound [rule_format (no_asm)]: "\<parallel>- p c q \<longrightarrow> \<parallel>= p c q"
   6.460 +apply (unfold com_validity_def)
   6.461 +apply(rule oghoare_induct)
   6.462 +apply(rule TrueI)+
   6.463 +--{* Parallel *}     
   6.464 +      apply(simp add: SEM_def sem_def)
   6.465 +      apply clarify
   6.466 +      apply(frule Parallel_length_post_PStar)
   6.467 +      apply clarify
   6.468 +      apply(drule_tac j=i in Parallel_Strong_Soundness)
   6.469 +         apply clarify
   6.470 +        apply simp
   6.471 +       apply force
   6.472 +      apply simp
   6.473 +      apply(erule_tac V = "\<forall>i. ?P i" in thin_rl)
   6.474 +      apply(drule_tac s = "length Rs" in sym)
   6.475 +      apply(erule allE, erule impE, assumption)
   6.476 +      apply(force dest: nth_mem simp add: All_None_def)
   6.477 +--{* Basic *}
   6.478 +    apply(simp add: SEM_def sem_def)
   6.479 +    apply(force dest: rtrancl_imp_UN_rel_pow Basic_ntran)
   6.480 +--{* Seq *}
   6.481 +   apply(rule subset_trans)
   6.482 +    prefer 2 apply assumption
   6.483 +   apply(simp add: L3_5ii L3_5i)
   6.484 +--{* Cond *}
   6.485 +  apply(simp add: L3_5iv)
   6.486 +  apply(erule Un_least)
   6.487 +  apply assumption
   6.488 +--{* While *}
   6.489 + apply(simp add: L3_5v)
   6.490 + apply(rule UN_least)
   6.491 + apply(drule SEM_fwhile)
   6.492 + apply assumption
   6.493 +--{* Conseq *}
   6.494 +apply(simp add: SEM_def sem_def)
   6.495 +apply auto
   6.496 +done
   6.497 +
   6.498 +end
   6.499 \ No newline at end of file
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/HoareParallel/OG_Syntax.thy	Tue Mar 05 17:11:25 2002 +0100
     7.3 @@ -0,0 +1,137 @@
     7.4 +
     7.5 +header {* \section{Concrete Syntax} *}
     7.6 +
     7.7 +theory OG_Syntax = Quote_Antiquote + OG_Tactics:
     7.8 +
     7.9 +text{* Syntax for commands and for assertions and boolean expressions in 
    7.10 + commands @{text com} and annotated commands @{text ann_com}. *}
    7.11 +
    7.12 +syntax
    7.13 +  "_Assign"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(\<acute>_ :=/ _)" [70, 65] 61)
    7.14 +  "_AnnAssign"   :: "'a assn \<Rightarrow> idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(_ \<acute>_ :=/ _)" [90,70,65] 61)
    7.15 +
    7.16 +translations
    7.17 +  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
    7.18 +  "r \<acute>\<spacespace>x := a" \<rightharpoonup> "AnnBasic r \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
    7.19 +
    7.20 +syntax
    7.21 +  "_AnnSkip"     :: "'a assn \<Rightarrow> 'a ann_com"              ("_//SKIP" [90] 63)
    7.22 +  "_AnnSeq"      :: "'a ann_com \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"  ("_;;/ _" [60,61] 60)
    7.23 +  
    7.24 +  "_AnnCond1"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
    7.25 +                    ("_ //IF _ /THEN _ /ELSE _ /FI"  [90,0,0,0] 61)
    7.26 +  "_AnnCond2"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
    7.27 +                    ("_ //IF _ /THEN _ /FI"  [90,0,0] 61)
    7.28 +  "_AnnWhile"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a assn \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com" 
    7.29 +                    ("_ //WHILE _ /INV _ //DO _//OD"  [90,0,0,0] 61)
    7.30 +  "_AnnAwait"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"
    7.31 +                    ("_ //AWAIT _ /THEN /_ /END"  [90,0,0] 61)
    7.32 +  "_AnnAtom"     :: "'a assn  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"   ("_//\<langle>_\<rangle>" [90,0] 61)
    7.33 +  "_AnnWait"     :: "'a assn \<Rightarrow> 'a bexp \<Rightarrow> 'a ann_com"   ("_//WAIT _ END" [90,0] 61)
    7.34 +
    7.35 +  "_Skip"        :: "'a com"                 ("SKIP" 63)
    7.36 +  "_Seq"         :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" ("_,,/ _" [55, 56] 55)
    7.37 +  "_Cond"        :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" 
    7.38 +                                  ("(0IF _/ THEN _/ ELSE _/ FI)" [0, 0, 0] 61)
    7.39 +  "_Cond2"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("IF _ THEN _ FI" [0,0] 56)
    7.40 +  "_While_inv"   :: "'a bexp \<Rightarrow> 'a assn \<Rightarrow> 'a com \<Rightarrow> 'a com"
    7.41 +                    ("(0WHILE _/ INV _ //DO _ /OD)"  [0, 0, 0] 61)
    7.42 +  "_While"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"
    7.43 +                    ("(0WHILE _ //DO _ /OD)"  [0, 0] 61)
    7.44 +
    7.45 +translations
    7.46 +  "SKIP" \<rightleftharpoons> "Basic id"
    7.47 +  "c_1,, c_2" \<rightleftharpoons> "Seq c_1 c_2"
    7.48 +
    7.49 +  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
    7.50 +  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
    7.51 +  "WHILE b INV i DO c OD" \<rightharpoonup> "While .{b}. i c"
    7.52 +  "WHILE b DO c OD" \<rightleftharpoons> "WHILE b INV arbitrary DO c OD"
    7.53 +
    7.54 +  "r SKIP" \<rightleftharpoons> "AnnBasic r id"
    7.55 +  "c_1;; c_2" \<rightleftharpoons> "AnnSeq c_1 c_2" 
    7.56 +  "r IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "AnnCond1 r .{b}. c1 c2"
    7.57 +  "r IF b THEN c FI" \<rightharpoonup> "AnnCond2 r .{b}. c"
    7.58 +  "r WHILE b INV i DO c OD" \<rightharpoonup> "AnnWhile r .{b}. i c"
    7.59 +  "r AWAIT b THEN c END" \<rightharpoonup> "AnnAwait r .{b}. c"
    7.60 +  "r \<langle>c\<rangle>" \<rightleftharpoons> "r AWAIT True THEN c END"
    7.61 +  "r WAIT b END" \<rightleftharpoons> "r AWAIT b THEN SKIP END"
    7.62 + 
    7.63 +nonterminals
    7.64 +  prgs
    7.65 +
    7.66 +syntax
    7.67 +  "_PAR" :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" [57] 56)
    7.68 +  "_prg" :: "['a, 'a] \<Rightarrow> prgs"        ("_//_" [60, 90] 57)
    7.69 +  "_prgs" :: "['a, 'a, prgs] \<Rightarrow> prgs"  ("_//_//\<parallel>//_" [60,90,57] 57)
    7.70 +
    7.71 +  "_prg_scheme" :: "['a, 'a, 'a, 'a, 'a] \<Rightarrow> prgs"  
    7.72 +                  ("SCHEME [_ \<le> _ < _] _// _" [0,0,0,60, 90] 57)
    7.73 +
    7.74 +translations
    7.75 +  "_prg c q" \<rightleftharpoons> "[(Some c, q)]"
    7.76 +  "_prgs c q ps" \<rightleftharpoons> "(Some c, q) # ps"
    7.77 +  "_PAR ps" \<rightleftharpoons> "Parallel ps"
    7.78 +
    7.79 +  "_prg_scheme j i k c q" \<rightleftharpoons> "(map (\<lambda>i. (Some c, q)) [j..k(])"
    7.80 +
    7.81 +print_translation {*
    7.82 +  let
    7.83 +    fun quote_tr' f (t :: ts) =
    7.84 +          Term.list_comb (f $ Syntax.quote_tr' "_antiquote" t, ts)
    7.85 +      | quote_tr' _ _ = raise Match;
    7.86 +
    7.87 +    fun annquote_tr' f (r :: t :: ts) =
    7.88 +          Term.list_comb (f $ r $ Syntax.quote_tr' "_antiquote" t, ts)
    7.89 +      | annquote_tr' _ _ = raise Match;
    7.90 +
    7.91 +    val assert_tr' = quote_tr' (Syntax.const "_Assert");
    7.92 +
    7.93 +    fun bexp_tr' name ((Const ("Collect", _) $ t) :: ts) =
    7.94 +          quote_tr' (Syntax.const name) (t :: ts)
    7.95 +      | bexp_tr' _ _ = raise Match;
    7.96 +
    7.97 +    fun annbexp_tr' name (r :: (Const ("Collect", _) $ t) :: ts) =
    7.98 +          annquote_tr' (Syntax.const name) (r :: t :: ts)
    7.99 +      | annbexp_tr' _ _ = raise Match;
   7.100 +
   7.101 +    fun upd_tr' (x_upd, T) =
   7.102 +      (case try (unsuffix RecordPackage.updateN) x_upd of
   7.103 +        Some x => (x, if T = dummyT then T else Term.domain_type T)
   7.104 +      | None => raise Match);
   7.105 +
   7.106 +    fun update_name_tr' (Free x) = Free (upd_tr' x)
   7.107 +      | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
   7.108 +          c $ Free (upd_tr' x)
   7.109 +      | update_name_tr' (Const x) = Const (upd_tr' x)
   7.110 +      | update_name_tr' _ = raise Match;
   7.111 +
   7.112 +    fun assign_tr' (Abs (x, _, f $ t $ Bound 0) :: ts) =
   7.113 +          quote_tr' (Syntax.const "_Assign" $ update_name_tr' f)
   7.114 +            (Abs (x, dummyT, t) :: ts)
   7.115 +      | assign_tr' _ = raise Match;
   7.116 +
   7.117 +    fun annassign_tr' (r :: Abs (x, _, f $ t $ Bound 0) :: ts) =
   7.118 +          quote_tr' (Syntax.const "_AnnAssign" $ r $ update_name_tr' f)
   7.119 +            (Abs (x, dummyT, t) :: ts)
   7.120 +      | annassign_tr' _ = raise Match;
   7.121 +
   7.122 +    fun Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1 ) $ t2) $ Const ("Nil",_))] = 
   7.123 +                   (Syntax.const "_prg" $ t1 $ t2)
   7.124 +      | Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1) $ t2) $ ts)] =
   7.125 +                     (Syntax.const "_prgs" $ t1 $ t2 $ Parallel_PAR [ts])
   7.126 +      | Parallel_PAR _ = raise Match;
   7.127 +
   7.128 +fun Parallel_tr' ts = Syntax.const "_PAR" $ Parallel_PAR ts;
   7.129 +  in
   7.130 +    [("Collect", assert_tr'), ("Basic", assign_tr'), 
   7.131 +      ("Cond", bexp_tr' "_Cond"), ("While", bexp_tr' "_While_inv"),
   7.132 +      ("AnnBasic", annassign_tr'), 
   7.133 +      ("AnnWhile", annbexp_tr' "_AnnWhile"), ("AnnAwait", annbexp_tr' "_AnnAwait"),
   7.134 +      ("AnnCond1", annbexp_tr' "_AnnCond1"), ("AnnCond2", annbexp_tr' "_AnnCond2")]
   7.135 +
   7.136 +  end
   7.137 +
   7.138 +*}
   7.139 +
   7.140 +end
   7.141 \ No newline at end of file
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/HoareParallel/OG_Tactics.thy	Tue Mar 05 17:11:25 2002 +0100
     8.3 @@ -0,0 +1,501 @@
     8.4 +
     8.5 +header {* \section{Generation of Verification Conditions} *}
     8.6 +
     8.7 +theory OG_Tactics = OG_Hoare:
     8.8 +
     8.9 +lemmas ann_hoare_intros=AnnBasic AnnSeq AnnCond1 AnnCond2 AnnWhile AnnAwait AnnConseq
    8.10 +lemmas oghoare_intros=Parallel Basic Seq Cond While Conseq
    8.11 +
    8.12 +lemma ParallelConseqRule: 
    8.13 + "\<lbrakk> p \<subseteq> (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i))));  
    8.14 +  \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i)))) 
    8.15 +      (Parallel Ts) 
    8.16 +     (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i));  
    8.17 +  (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i)) \<subseteq> q \<rbrakk>  
    8.18 +  \<Longrightarrow> \<parallel>- p (Parallel Ts) q"
    8.19 +apply (rule Conseq)
    8.20 +prefer 2 
    8.21 + apply fast
    8.22 +apply assumption+
    8.23 +done
    8.24 +
    8.25 +lemma SkipRule: "p \<subseteq> q \<Longrightarrow> \<parallel>- p (Basic id) q"
    8.26 +apply(rule oghoare_intros)
    8.27 +  prefer 2 apply(rule Basic)
    8.28 + prefer 2 apply(rule subset_refl)
    8.29 +apply(simp add:Id_def)
    8.30 +done
    8.31 +
    8.32 +lemma BasicRule: "p \<subseteq> {s. (f s)\<in>q} \<Longrightarrow> \<parallel>- p (Basic f) q"
    8.33 +apply(rule oghoare_intros)
    8.34 +  prefer 2 apply(rule oghoare_intros)
    8.35 + prefer 2 apply(rule subset_refl)
    8.36 +apply assumption
    8.37 +done
    8.38 +
    8.39 +lemma SeqRule: "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q"
    8.40 +apply(rule Seq)
    8.41 +apply fast+
    8.42 +done
    8.43 +
    8.44 +lemma CondRule: 
    8.45 + "\<lbrakk> p \<subseteq> {s. (s\<in>b \<longrightarrow> s\<in>w) \<and> (s\<notin>b \<longrightarrow> s\<in>w')}; \<parallel>- w c1 q; \<parallel>- w' c2 q \<rbrakk> 
    8.46 +  \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
    8.47 +apply(rule Cond)
    8.48 + apply(rule Conseq)
    8.49 + prefer 4 apply(rule Conseq)
    8.50 +apply simp_all
    8.51 +apply force+
    8.52 +done
    8.53 +
    8.54 +lemma WhileRule: "\<lbrakk> p \<subseteq> i; \<parallel>- (i \<inter> b) c i ; (i \<inter> (-b)) \<subseteq> q \<rbrakk>  
    8.55 +        \<Longrightarrow> \<parallel>- p (While b i c) q"
    8.56 +apply(rule Conseq)
    8.57 + prefer 2 apply(rule While)
    8.58 +apply assumption+
    8.59 +done
    8.60 +
    8.61 +text {* Three new proof rules for special instances of the @{text
    8.62 +AnnBasic} and the @{text AnnAwait} commands when the transformation
    8.63 +performed on the state is the identity, and for an @{text AnnAwait}
    8.64 +command where the boolean condition is @{text "{s. True}"}: *}
    8.65 +
    8.66 +lemma AnnatomRule:
    8.67 +  "\<lbrakk> atom_com(c); \<parallel>- r c q \<rbrakk>  \<Longrightarrow> \<turnstile> (AnnAwait r {s. True} c) q"
    8.68 +apply(rule AnnAwait)
    8.69 +apply simp_all
    8.70 +done
    8.71 +
    8.72 +lemma AnnskipRule:
    8.73 +  "r \<subseteq> q \<Longrightarrow> \<turnstile> (AnnBasic r id) q"
    8.74 +apply(rule AnnBasic)
    8.75 +apply simp
    8.76 +done
    8.77 +
    8.78 +lemma AnnwaitRule:
    8.79 +  "\<lbrakk> (r \<inter> b) \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b (Basic id)) q"
    8.80 +apply(rule AnnAwait)
    8.81 + apply simp
    8.82 +apply(rule BasicRule)
    8.83 +apply simp
    8.84 +done
    8.85 +
    8.86 +text {* Lemmata to avoid using the definition of @{text
    8.87 +map_ann_hoare}, @{text interfree_aux}, @{text interfree_swap} and
    8.88 +@{text interfree} by splitting it into different cases: *}
    8.89 +
    8.90 +lemma interfree_aux_rule1: "interfree_aux(co, q, None)"
    8.91 +by(simp add:interfree_aux_def)
    8.92 +
    8.93 +lemma interfree_aux_rule2: 
    8.94 +  "\<forall>(R,r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<Longrightarrow> interfree_aux(None, q, Some a)"
    8.95 +apply(simp add:interfree_aux_def)
    8.96 +apply(force elim:oghoare_sound)
    8.97 +done
    8.98 +
    8.99 +lemma interfree_aux_rule3: 
   8.100 +  "(\<forall>(R, r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<and> (\<forall>p\<in>(assertions c). \<parallel>- (p \<inter> R) r p))
   8.101 +  \<Longrightarrow> interfree_aux(Some c, q, Some a)"
   8.102 +apply(simp add:interfree_aux_def)
   8.103 +apply(force elim:oghoare_sound)
   8.104 +done
   8.105 +
   8.106 +lemma AnnBasic_assertions: 
   8.107 +  "\<lbrakk>interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk> \<Longrightarrow> 
   8.108 +    interfree_aux(Some (AnnBasic r f), q, Some a)"
   8.109 +apply(simp add: interfree_aux_def)
   8.110 +by force
   8.111 +
   8.112 +lemma AnnSeq_assertions: 
   8.113 +  "\<lbrakk> interfree_aux(Some c1, q, Some a); interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
   8.114 +   interfree_aux(Some (AnnSeq c1 c2), q, Some a)"
   8.115 +apply(simp add: interfree_aux_def)
   8.116 +by force
   8.117 +
   8.118 +lemma AnnCond1_assertions: 
   8.119 +  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c1, q, Some a); 
   8.120 +  interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
   8.121 +  interfree_aux(Some(AnnCond1 r b c1 c2), q, Some a)"
   8.122 +apply(simp add: interfree_aux_def)
   8.123 +by force
   8.124 +
   8.125 +lemma AnnCond2_assertions: 
   8.126 +  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
   8.127 +  interfree_aux(Some (AnnCond2 r b c), q, Some a)"
   8.128 +apply(simp add: interfree_aux_def)
   8.129 +by force
   8.130 +
   8.131 +lemma AnnWhile_assertions: 
   8.132 +  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, i, Some a); 
   8.133 +  interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
   8.134 +  interfree_aux(Some (AnnWhile r b i c), q, Some a)"
   8.135 +apply(simp add: interfree_aux_def)
   8.136 +by force
   8.137 + 
   8.138 +lemma AnnAwait_assertions: 
   8.139 +  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk>\<Longrightarrow> 
   8.140 +  interfree_aux(Some (AnnAwait r b c), q, Some a)"
   8.141 +apply(simp add: interfree_aux_def)
   8.142 +by force
   8.143 + 
   8.144 +lemma AnnBasic_atomics: 
   8.145 +  "\<parallel>- (q \<inter> r) (Basic f) q \<Longrightarrow> interfree_aux(None, q, Some (AnnBasic r f))"
   8.146 +by(simp add: interfree_aux_def oghoare_sound)
   8.147 +
   8.148 +lemma AnnSeq_atomics: 
   8.149 +  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
   8.150 +  interfree_aux(Any, q, Some (AnnSeq a1 a2))"
   8.151 +apply(simp add: interfree_aux_def)
   8.152 +by force
   8.153 +
   8.154 +lemma AnnCond1_atomics:
   8.155 +  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
   8.156 +   interfree_aux(Any, q, Some (AnnCond1 r b a1 a2))"
   8.157 +apply(simp add: interfree_aux_def)
   8.158 +by force
   8.159 +
   8.160 +lemma AnnCond2_atomics: 
   8.161 +  "interfree_aux (Any, q, Some a)\<Longrightarrow> interfree_aux(Any, q, Some (AnnCond2 r b a))"
   8.162 +by(simp add: interfree_aux_def)
   8.163 +
   8.164 +lemma AnnWhile_atomics: "interfree_aux (Any, q, Some a) 
   8.165 +     \<Longrightarrow> interfree_aux(Any, q, Some (AnnWhile r b i a))"
   8.166 +by(simp add: interfree_aux_def)
   8.167 +
   8.168 +lemma Annatom_atomics: 
   8.169 +  "\<parallel>- (q \<inter> r) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r {x. True} a))"
   8.170 +by(simp add: interfree_aux_def oghoare_sound) 
   8.171 +
   8.172 +lemma AnnAwait_atomics: 
   8.173 +  "\<parallel>- (q \<inter> (r \<inter> b)) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r b a))"
   8.174 +by(simp add: interfree_aux_def oghoare_sound)
   8.175 +
   8.176 +constdefs 
   8.177 +  interfree_swap :: "('a ann_triple_op * ('a ann_triple_op) list) \<Rightarrow> bool"
   8.178 +  "interfree_swap == \<lambda>(x, xs). \<forall>y\<in>set xs. interfree_aux (com x, post x, com y)
   8.179 +  \<and> interfree_aux(com y, post y, com x)"
   8.180 +
   8.181 +lemma interfree_swap_Empty: "interfree_swap (x, [])"
   8.182 +by(simp add:interfree_swap_def)
   8.183 +
   8.184 +lemma interfree_swap_List:  
   8.185 +  "\<lbrakk> interfree_aux (com x, post x, com y); 
   8.186 +  interfree_aux (com y, post y ,com x); interfree_swap (x, xs) \<rbrakk> 
   8.187 +  \<Longrightarrow> interfree_swap (x, y#xs)"
   8.188 +by(simp add:interfree_swap_def)
   8.189 +
   8.190 +lemma interfree_swap_Map: "\<forall>k. i\<le>k \<and> k<j \<longrightarrow> interfree_aux (com x, post x, c k) 
   8.191 + \<and> interfree_aux (c k, Q k, com x)   
   8.192 + \<Longrightarrow> interfree_swap (x, map (\<lambda>k. (c k, Q k)) [i..j(])"
   8.193 +by(force simp add: interfree_swap_def less_diff_conv)
   8.194 +
   8.195 +lemma interfree_Empty: "interfree []"
   8.196 +by(simp add:interfree_def)
   8.197 +
   8.198 +lemma interfree_List: 
   8.199 +  "\<lbrakk> interfree_swap(x, xs); interfree xs \<rbrakk> \<Longrightarrow> interfree (x#xs)"
   8.200 +apply(simp add:interfree_def interfree_swap_def)
   8.201 +apply clarify
   8.202 +apply(case_tac i)
   8.203 + apply(case_tac j)
   8.204 +  apply simp_all
   8.205 +apply(case_tac j,simp+)
   8.206 +done
   8.207 +
   8.208 +lemma interfree_Map: 
   8.209 +  "(\<forall>i j. a\<le>i \<and> i<b \<and> a\<le>j \<and> j<b  \<and> i\<noteq>j \<longrightarrow> interfree_aux (c i, Q i, c j))  
   8.210 +  \<Longrightarrow> interfree (map (\<lambda>k. (c k, Q k)) [a..b(])"
   8.211 +by(force simp add: interfree_def less_diff_conv)
   8.212 +
   8.213 +constdefs map_ann_hoare :: "(('a ann_com_op * 'a assn) list) \<Rightarrow> bool " ("[\<turnstile>] _" [0] 45)
   8.214 +  "[\<turnstile>] Ts == (\<forall>i<length Ts. \<exists>c q. Ts!i=(Some c, q) \<and> \<turnstile> c q)"
   8.215 +
   8.216 +lemma MapAnnEmpty: "[\<turnstile>] []"
   8.217 +by(simp add:map_ann_hoare_def)
   8.218 +
   8.219 +lemma MapAnnList: "\<lbrakk> \<turnstile> c q ; [\<turnstile>] xs \<rbrakk> \<Longrightarrow> [\<turnstile>] (Some c,q)#xs"
   8.220 +apply(simp add:map_ann_hoare_def)
   8.221 +apply clarify
   8.222 +apply(case_tac i,simp+)
   8.223 +done
   8.224 +
   8.225 +lemma MapAnnMap: 
   8.226 +  "\<forall>k. i\<le>k \<and> k<j \<longrightarrow> \<turnstile> (c k) (Q k) \<Longrightarrow> [\<turnstile>] map (\<lambda>k. (Some (c k), Q k)) [i..j(]"
   8.227 +apply(simp add: map_ann_hoare_def less_diff_conv)
   8.228 +done
   8.229 +
   8.230 +lemma ParallelRule:"\<lbrakk> [\<turnstile>] Ts ; interfree Ts \<rbrakk>
   8.231 +  \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
   8.232 +          Parallel Ts 
   8.233 +        (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
   8.234 +apply(rule Parallel)
   8.235 + apply(simp add:map_ann_hoare_def)
   8.236 +apply simp
   8.237 +done
   8.238 +(*
   8.239 +lemma ParamParallelRule:
   8.240 + "\<lbrakk> \<forall>k<n. \<turnstile> (c k) (Q k); 
   8.241 +   \<forall>k l. k<n \<and> l<n  \<and> k\<noteq>l \<longrightarrow> interfree_aux (Some(c k), Q k, Some(c l)) \<rbrakk>
   8.242 +  \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<n} . pre(c i)) COBEGIN SCHEME [0\<le>i<n] (c i) (Q i) COEND  (\<Inter>i\<in>{i. i<n} . Q i )"
   8.243 +apply(rule ParallelConseqRule)
   8.244 +  apply simp
   8.245 +  apply clarify
   8.246 +  apply force
   8.247 + apply(rule ParallelRule)
   8.248 +  apply(rule MapAnnMap)
   8.249 +  apply simp
   8.250 + apply(rule interfree_Map)
   8.251 + apply simp
   8.252 +apply simp
   8.253 +apply clarify
   8.254 +apply force
   8.255 +done
   8.256 +*)
   8.257 +
   8.258 +text {* The following are some useful lemmas and simplification
   8.259 +tactics to control which theorems are used to simplify at each moment,
   8.260 +so that the original input does not suffer any unexpected
   8.261 +transformation. *}
   8.262 +
   8.263 +lemma Compl_Collect: "-(Collect b) = {x. \<not>(b x)}"
   8.264 +by fast
   8.265 +lemma list_length: "length []=0 \<and> length (x#xs) = Suc(length xs)"
   8.266 +by simp
   8.267 +lemma list_lemmas: "length []=0 \<and> length (x#xs) = Suc(length xs) 
   8.268 +\<and> (x#xs) ! 0=x \<and> (x#xs) ! Suc n = xs ! n"
   8.269 +by simp
   8.270 +lemma le_Suc_eq_insert: "{i. i <Suc n} = insert n {i. i< n}"
   8.271 +apply auto
   8.272 +by arith
   8.273 +lemmas primrecdef_list = "pre.simps" "assertions.simps" "atomics.simps" "atom_com.simps"
   8.274 +lemmas my_simp_list = list_lemmas fst_conv snd_conv
   8.275 +not_less0 refl le_Suc_eq_insert Suc_not_Zero Zero_not_Suc Suc_Suc_eq
   8.276 +Collect_mem_eq ball_simps option.simps primrecdef_list
   8.277 +lemmas ParallelConseq_list = INTER_def Collect_conj_eq length_map length_upt length_append list_length
   8.278 +
   8.279 +ML {*
   8.280 +val before_interfree_simp_tac = (simp_tac (HOL_basic_ss addsimps [thm "com.simps", thm "post.simps"]))
   8.281 +
   8.282 +val  interfree_simp_tac = (asm_simp_tac (HOL_ss addsimps [thm "split", thm "ball_Un", thm "ball_empty"]@(thms "my_simp_list")))
   8.283 +
   8.284 +val ParallelConseq = (simp_tac (HOL_basic_ss addsimps (thms "ParallelConseq_list")@(thms "my_simp_list")))
   8.285 +*}
   8.286 +
   8.287 +text {* The following tactic applies @{text tac} to each conjunct in a
   8.288 +subgoal of the form @{text "A \<Longrightarrow> a1 \<and> a2 \<and> .. \<and> an"}  returning
   8.289 +@{text n} subgoals, one for each conjunct: *}
   8.290 +
   8.291 +ML {*
   8.292 +fun conjI_Tac tac i st = st |>
   8.293 +       ( (EVERY [rtac conjI i,
   8.294 +          conjI_Tac tac (i+1),
   8.295 +          tac i]) ORELSE (tac i) )
   8.296 +*}
   8.297 +
   8.298 +
   8.299 +subsubsection {* Tactic for the generation of the verification conditions *} 
   8.300 +
   8.301 +text {* The tactic basically uses two subtactics:
   8.302 +
   8.303 +\begin{description}
   8.304 +
   8.305 +\item[HoareRuleTac] is called at the level of parallel programs, it        
   8.306 + uses the ParallelTac to solve parallel composition of programs.         
   8.307 + This verification has two parts, namely, (1) all component programs are 
   8.308 + correct and (2) they are interference free.  @{text HoareRuleTac} is
   8.309 + also called at the level of atomic regions, i.e.  @{text "\<langle> \<rangle>"} and
   8.310 + @{text "AWAIT b THEN _ END"}, and at each interference freedom test.
   8.311 +
   8.312 +\item[AnnHoareRuleTac] is for component programs which  
   8.313 + are annotated programs and so, there are not unknown assertions         
   8.314 + (no need to use the parameter precond, see NOTE).
   8.315 +
   8.316 + NOTE: precond(::bool) informs if the subgoal has the form @{text "\<parallel>- ?p c q"},
   8.317 + in this case we have precond=False and the generated  verification     
   8.318 + condition would have the form @{text "?p \<subseteq> \<dots>"} which can be solved by        
   8.319 + @{text "rtac subset_refl"}, if True we proceed to simplify it using
   8.320 + the simplification tactics above.
   8.321 +
   8.322 +\end{description}
   8.323 +*}
   8.324 +
   8.325 +ML {*
   8.326 +
   8.327 + fun WlpTac i = (rtac (thm "SeqRule") i) THEN (HoareRuleTac false (i+1))
   8.328 +and HoareRuleTac precond i st = st |>  
   8.329 +    ( (WlpTac i THEN HoareRuleTac precond i)
   8.330 +      ORELSE
   8.331 +      (FIRST[rtac (thm "SkipRule") i,
   8.332 +             rtac (thm "BasicRule") i,
   8.333 +             EVERY[rtac (thm "ParallelConseqRule") i,
   8.334 +                   ParallelConseq (i+2),
   8.335 +                   ParallelTac (i+1),
   8.336 +                   ParallelConseq i], 
   8.337 +             EVERY[rtac (thm "CondRule") i,
   8.338 +                   HoareRuleTac false (i+2),
   8.339 +                   HoareRuleTac false (i+1)],
   8.340 +             EVERY[rtac (thm "WhileRule") i,
   8.341 +                   HoareRuleTac true (i+1)],
   8.342 +             K all_tac i ]
   8.343 +       THEN (if precond then (K all_tac i) else (rtac (thm "subset_refl") i))))
   8.344 +
   8.345 +and  AnnWlpTac i = (rtac (thm "AnnSeq") i) THEN (AnnHoareRuleTac (i+1))
   8.346 +and AnnHoareRuleTac i st = st |>  
   8.347 +    ( (AnnWlpTac i THEN AnnHoareRuleTac i )
   8.348 +     ORELSE
   8.349 +      (FIRST[(rtac (thm "AnnskipRule") i),
   8.350 +             EVERY[rtac (thm "AnnatomRule") i,
   8.351 +                   HoareRuleTac true (i+1)],
   8.352 +             (rtac (thm "AnnwaitRule") i),
   8.353 +             rtac (thm "AnnBasic") i,
   8.354 +             EVERY[rtac (thm "AnnCond1") i,
   8.355 +                   AnnHoareRuleTac (i+3),
   8.356 +                   AnnHoareRuleTac (i+1)],
   8.357 +             EVERY[rtac (thm "AnnCond2") i,
   8.358 +                   AnnHoareRuleTac (i+1)],
   8.359 +             EVERY[rtac (thm "AnnWhile") i,
   8.360 +                   AnnHoareRuleTac (i+2)],
   8.361 +             EVERY[rtac (thm "AnnAwait") i,
   8.362 +                   HoareRuleTac true (i+1)],
   8.363 +             K all_tac i]))
   8.364 +
   8.365 +and ParallelTac i = EVERY[rtac (thm "ParallelRule") i,
   8.366 +                          interfree_Tac (i+1),
   8.367 +                           MapAnn_Tac i]
   8.368 +
   8.369 +and MapAnn_Tac i st = st |>
   8.370 +    (FIRST[rtac (thm "MapAnnEmpty") i,
   8.371 +           EVERY[rtac (thm "MapAnnList") i,
   8.372 +                 MapAnn_Tac (i+1),
   8.373 +                 AnnHoareRuleTac i],
   8.374 +           EVERY[rtac (thm "MapAnnMap") i,
   8.375 +                 rtac (thm "allI") i,rtac (thm "impI") i,
   8.376 +                 AnnHoareRuleTac i]])
   8.377 +
   8.378 +and interfree_swap_Tac i st = st |>
   8.379 +    (FIRST[rtac (thm "interfree_swap_Empty") i,
   8.380 +           EVERY[rtac (thm "interfree_swap_List") i,
   8.381 +                 interfree_swap_Tac (i+2),
   8.382 +                 interfree_aux_Tac (i+1),
   8.383 +                 interfree_aux_Tac i ],
   8.384 +           EVERY[rtac (thm "interfree_swap_Map") i,
   8.385 +                 rtac (thm "allI") i,rtac (thm "impI") i,
   8.386 +                 conjI_Tac (interfree_aux_Tac) i]])
   8.387 +
   8.388 +and interfree_Tac i st = st |> 
   8.389 +   (FIRST[rtac (thm "interfree_Empty") i,
   8.390 +          EVERY[rtac (thm "interfree_List") i,
   8.391 +                interfree_Tac (i+1),
   8.392 +                interfree_swap_Tac i],
   8.393 +          EVERY[rtac (thm "interfree_Map") i,
   8.394 +                rtac (thm "allI") i,rtac (thm "allI") i,rtac (thm "impI") i,
   8.395 +                interfree_aux_Tac i ]])
   8.396 +
   8.397 +and interfree_aux_Tac i = (before_interfree_simp_tac i ) THEN 
   8.398 +        (FIRST[rtac (thm "interfree_aux_rule1") i,
   8.399 +               dest_assertions_Tac i])
   8.400 +
   8.401 +and dest_assertions_Tac i st = st |>
   8.402 +    (FIRST[EVERY[rtac (thm "AnnBasic_assertions") i,
   8.403 +                 dest_atomics_Tac (i+1),
   8.404 +                 dest_atomics_Tac i],
   8.405 +           EVERY[rtac (thm "AnnSeq_assertions") i,
   8.406 +                 dest_assertions_Tac (i+1),
   8.407 +                 dest_assertions_Tac i],
   8.408 +           EVERY[rtac (thm "AnnCond1_assertions") i,
   8.409 +                 dest_assertions_Tac (i+2),
   8.410 +                 dest_assertions_Tac (i+1),
   8.411 +                 dest_atomics_Tac i],
   8.412 +           EVERY[rtac (thm "AnnCond2_assertions") i,
   8.413 +                 dest_assertions_Tac (i+1),
   8.414 +                 dest_atomics_Tac i],
   8.415 +           EVERY[rtac (thm "AnnWhile_assertions") i,
   8.416 +                 dest_assertions_Tac (i+2),
   8.417 +                 dest_atomics_Tac (i+1),
   8.418 +                 dest_atomics_Tac i],
   8.419 +           EVERY[rtac (thm "AnnAwait_assertions") i,
   8.420 +                 dest_atomics_Tac (i+1),
   8.421 +                 dest_atomics_Tac i],
   8.422 +           dest_atomics_Tac i])
   8.423 +
   8.424 +and dest_atomics_Tac i st = st |>
   8.425 +    (FIRST[EVERY[rtac (thm "AnnBasic_atomics") i,
   8.426 +                 HoareRuleTac true i],
   8.427 +           EVERY[rtac (thm "AnnSeq_atomics") i,
   8.428 +                 dest_atomics_Tac (i+1),
   8.429 +                 dest_atomics_Tac i],
   8.430 +           EVERY[rtac (thm "AnnCond1_atomics") i,
   8.431 +                 dest_atomics_Tac (i+1),
   8.432 +                 dest_atomics_Tac i],
   8.433 +           EVERY[rtac (thm "AnnCond2_atomics") i,
   8.434 +                 dest_atomics_Tac i],
   8.435 +           EVERY[rtac (thm "AnnWhile_atomics") i,
   8.436 +                 dest_atomics_Tac i],
   8.437 +           EVERY[rtac (thm "Annatom_atomics") i,
   8.438 +                 HoareRuleTac true i],
   8.439 +           EVERY[rtac (thm "AnnAwait_atomics") i,
   8.440 +                 HoareRuleTac true i],
   8.441 +                 K all_tac i])
   8.442 +*}
   8.443 +
   8.444 +
   8.445 +text {* The final tactic is given the name @{text oghoare}: *}
   8.446 +
   8.447 +ML {* 
   8.448 +fun oghoare_tac i thm = SUBGOAL (fn (term, _) =>
   8.449 +   (HoareRuleTac true i)) i thm
   8.450 +*}
   8.451 +
   8.452 +text {* Notice that the tactic for parallel programs @{text
   8.453 +"oghoare_tac"} is initially invoked with the value @{text true} for
   8.454 +the parameter @{text precond}.
   8.455 +
   8.456 +Parts of the tactic can be also individually used to generate the
   8.457 +verification conditions for annotated sequential programs and to
   8.458 +generate verification conditions out of interference freedom tests: *}
   8.459 +
   8.460 +ML {* fun annhoare_tac i thm = SUBGOAL (fn (term, _) =>
   8.461 +  (AnnHoareRuleTac i)) i thm
   8.462 +
   8.463 +fun interfree_aux_tac i thm = SUBGOAL (fn (term, _) =>
   8.464 +   (interfree_aux_Tac i)) i thm
   8.465 +*}
   8.466 +
   8.467 +text {* The so defined ML tactics are then ``exported'' to be used in
   8.468 +Isabelle proofs. *}
   8.469 +
   8.470 +method_setup oghoare = {*
   8.471 +  Method.no_args
   8.472 +    (Method.SIMPLE_METHOD' HEADGOAL (oghoare_tac)) *}
   8.473 +  "verification condition generator for the oghoare logic"
   8.474 +
   8.475 +method_setup annhoare = {*
   8.476 +  Method.no_args
   8.477 +    (Method.SIMPLE_METHOD' HEADGOAL (annhoare_tac)) *}
   8.478 +  "verification condition generator for the ann_hoare logic"
   8.479 +
   8.480 +method_setup interfree_aux = {*
   8.481 +  Method.no_args
   8.482 +    (Method.SIMPLE_METHOD' HEADGOAL (interfree_aux_tac)) *}
   8.483 +  "verification condition generator for interference freedom tests"
   8.484 +
   8.485 +text {* Tactics useful for dealing with the generated verification conditions: *}
   8.486 +
   8.487 +method_setup conjI_tac = {*
   8.488 +  Method.no_args
   8.489 +    (Method.SIMPLE_METHOD' HEADGOAL (conjI_Tac (K all_tac))) *}
   8.490 +  "verification condition generator for interference freedom tests"
   8.491 +
   8.492 +ML {*
   8.493 +fun disjE_Tac tac i st = st |>
   8.494 +       ( (EVERY [etac disjE i,
   8.495 +          disjE_Tac tac (i+1),
   8.496 +          tac i]) ORELSE (tac i) )
   8.497 +*}
   8.498 +
   8.499 +method_setup disjE_tac = {*
   8.500 +  Method.no_args
   8.501 +    (Method.SIMPLE_METHOD' HEADGOAL (disjE_Tac (K all_tac))) *}
   8.502 +  "verification condition generator for interference freedom tests"
   8.503 +
   8.504 +end
   8.505 \ No newline at end of file
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/HoareParallel/OG_Tran.thy	Tue Mar 05 17:11:25 2002 +0100
     9.3 @@ -0,0 +1,308 @@
     9.4 +
     9.5 +header {* \section{Operational Semantics} *}
     9.6 +
     9.7 +theory OG_Tran = OG_Com:
     9.8 +
     9.9 +types
    9.10 +  'a ann_com_op = "('a ann_com) option"
    9.11 +  'a ann_triple_op = "('a ann_com_op \<times> 'a assn)"
    9.12 +  
    9.13 +consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
    9.14 +primrec "com (c, q) = c"
    9.15 +
    9.16 +consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
    9.17 +primrec "post (c, q) = q"
    9.18 +
    9.19 +constdefs
    9.20 +  All_None :: "'a ann_triple_op list \<Rightarrow> bool"
    9.21 +  "All_None Ts \<equiv> \<forall>(c, q) \<in> set Ts. c = None"
    9.22 +
    9.23 +subsection {* The Transition Relation *}
    9.24 +
    9.25 +consts
    9.26 +  ann_transition :: "(('a ann_com_op \<times> 'a) \<times> ('a ann_com_op \<times> 'a)) set"        
    9.27 +  transition :: "(('a com \<times> 'a) \<times> ('a com \<times> 'a)) set"
    9.28 +    
    9.29 +syntax
    9.30 +  "_ann_transition" :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
    9.31 +                           ("_ -1\<rightarrow> _"[81,81] 100)
    9.32 +  "_ann_transition_n" :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a) 
    9.33 +                           \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)
    9.34 +  "_ann_transition_*" :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
    9.35 +                           ("_ -*\<rightarrow> _"[81,81] 100)
    9.36 +
    9.37 +  "_transition" :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  ("_ -P1\<rightarrow> _"[81,81] 100)
    9.38 +  "_transition_n" :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  
    9.39 +                          ("_ -P_\<rightarrow> _"[81,81,81] 100)  
    9.40 +  "_transition_*" :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  ("_ -P*\<rightarrow> _"[81,81] 100)
    9.41 +
    9.42 +text {* The corresponding syntax translations are: *}
    9.43 +
    9.44 +translations
    9.45 +  "con_0 -1\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition"
    9.46 +  "con_0 -n\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition^n"
    9.47 +  "con_0 -*\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition\<^sup>*"
    9.48 +   
    9.49 +  "con_0 -P1\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition"
    9.50 +  "con_0 -Pn\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition^n"
    9.51 +  "con_0 -P*\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition\<^sup>*"
    9.52 +
    9.53 +inductive ann_transition  transition
    9.54 +intros
    9.55 +  AnnBasic:  "(Some (AnnBasic r f), s) -1\<rightarrow> (None, f s)"
    9.56 +
    9.57 +  AnnSeq1: "(Some c0, s) -1\<rightarrow> (None, t) \<Longrightarrow> 
    9.58 +               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some c1, t)"
    9.59 +  AnnSeq2: "(Some c0, s) -1\<rightarrow> (Some c2, t) \<Longrightarrow> 
    9.60 +               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some (AnnSeq c2 c1), t)"
    9.61 +
    9.62 +  AnnCond1T: "s \<in> b  \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c1, s)"
    9.63 +  AnnCond1F: "s \<notin> b \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c2, s)"
    9.64 +
    9.65 +  AnnCond2T: "s \<in> b  \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (Some c, s)"
    9.66 +  AnnCond2F: "s \<notin> b \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (None, s)"
    9.67 +
    9.68 +  AnnWhileF: "s \<notin> b \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> (None, s)"
    9.69 +  AnnWhileT: "s \<in> b  \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> 
    9.70 +                         (Some (AnnSeq c (AnnWhile i b i c)), s)"
    9.71 +
    9.72 +  AnnAwait: "\<lbrakk> s \<in> b; atom_com c; (c, s) -P*\<rightarrow> (Parallel [], t) \<rbrakk> \<Longrightarrow>
    9.73 +	           (Some (AnnAwait r b c), s) -1\<rightarrow> (None, t)" 
    9.74 +
    9.75 +  Parallel: "\<lbrakk> i<length Ts; Ts!i = (Some c, q); (Some c, s) -1\<rightarrow> (r, t) \<rbrakk>
    9.76 +              \<Longrightarrow> (Parallel Ts, s) -P1\<rightarrow> (Parallel (Ts [i:=(r, q)]), t)"
    9.77 +
    9.78 +  Basic:  "(Basic f, s) -P1\<rightarrow> (Parallel [], f s)"
    9.79 +
    9.80 +  Seq1:   "All_None Ts \<Longrightarrow> (Seq (Parallel Ts) c, s) -P1\<rightarrow> (c, s)"
    9.81 +  Seq2:   "(c0, s) -P1\<rightarrow> (c2, t) \<Longrightarrow> (Seq c0 c1, s) -P1\<rightarrow> (Seq c2 c1, t)"
    9.82 +
    9.83 +  CondT: "s \<in> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c1, s)"
    9.84 +  CondF: "s \<notin> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c2, s)"
    9.85 +
    9.86 +  WhileF: "s \<notin> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Parallel [], s)"
    9.87 +  WhileT: "s \<in> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Seq c (While b i c), s)"
    9.88 +
    9.89 +monos "rtrancl_mono"
    9.90 +
    9.91 +subsection {* Definition of Semantics *}
    9.92 +
    9.93 +constdefs
    9.94 +  ann_sem :: "'a ann_com \<Rightarrow> 'a \<Rightarrow> 'a set"
    9.95 +  "ann_sem c \<equiv> \<lambda>s. {t. (Some c, s) -*\<rightarrow> (None, t)}"
    9.96 +
    9.97 +  ann_SEM :: "'a ann_com \<Rightarrow> 'a set \<Rightarrow> 'a set"
    9.98 +  "ann_SEM c S \<equiv> \<Union>ann_sem c ` S"  
    9.99 +
   9.100 +  sem :: "'a com \<Rightarrow> 'a \<Rightarrow> 'a set"
   9.101 +  "sem c \<equiv> \<lambda>s. {t. \<exists>Ts. (c, s) -P*\<rightarrow> (Parallel Ts, t) \<and> All_None Ts}"
   9.102 +
   9.103 +  SEM :: "'a com \<Rightarrow> 'a set \<Rightarrow> 'a set"
   9.104 +  "SEM c S \<equiv> \<Union>sem c ` S "
   9.105 +
   9.106 +syntax "_Omega" :: "'a com"    ("\<Omega>" 63)
   9.107 +translations  "\<Omega>" \<rightleftharpoons> "While UNIV UNIV (Basic id)"
   9.108 +
   9.109 +consts fwhile :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> nat \<Rightarrow> 'a com"
   9.110 +primrec 
   9.111 +   "fwhile b c 0 = \<Omega>"
   9.112 +   "fwhile b c (Suc n) = Cond b (Seq c (fwhile b c n)) (Basic id)"
   9.113 +
   9.114 +subsubsection {* Proofs *}
   9.115 +
   9.116 +declare ann_transition_transition.intros [intro]
   9.117 +inductive_cases transition_cases: 
   9.118 +    "(Parallel T,s) -P1\<rightarrow> t"  
   9.119 +    "(Basic f, s) -P1\<rightarrow> t"
   9.120 +    "(Seq c1 c2, s) -P1\<rightarrow> t" 
   9.121 +    "(Cond b c1 c2, s) -P1\<rightarrow> t"
   9.122 +    "(While b i c, s) -P1\<rightarrow> t"
   9.123 +
   9.124 +lemma Parallel_empty_lemma [rule_format (no_asm)]: 
   9.125 +  "(Parallel [],s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=[] \<and> n=0 \<and> s=t"
   9.126 +apply(induct n)
   9.127 + apply(simp (no_asm))
   9.128 +apply clarify
   9.129 +apply(drule rel_pow_Suc_D2)
   9.130 +apply(force elim:transition_cases)
   9.131 +done
   9.132 +
   9.133 +lemma Parallel_AllNone_lemma [rule_format (no_asm)]: 
   9.134 + "All_None Ss \<longrightarrow> (Parallel Ss,s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=Ss \<and> n=0 \<and> s=t"
   9.135 +apply(induct "n")
   9.136 + apply(simp (no_asm))
   9.137 +apply clarify
   9.138 +apply(drule rel_pow_Suc_D2)
   9.139 +apply clarify
   9.140 +apply(erule transition_cases,simp_all)
   9.141 +apply(force dest:nth_mem simp add:All_None_def)
   9.142 +done
   9.143 +
   9.144 +lemma Parallel_AllNone: "All_None Ts \<Longrightarrow> (SEM (Parallel Ts) X) = X"
   9.145 +apply (unfold SEM_def sem_def)
   9.146 +apply auto
   9.147 +apply(drule rtrancl_imp_UN_rel_pow)
   9.148 +apply clarify
   9.149 +apply(drule Parallel_AllNone_lemma)
   9.150 +apply auto
   9.151 +done
   9.152 +
   9.153 +lemma Parallel_empty: "Ts=[] \<Longrightarrow> (SEM (Parallel Ts) X) = X"
   9.154 +apply(rule Parallel_AllNone)
   9.155 +apply(simp add:All_None_def)
   9.156 +done
   9.157 +
   9.158 +text {* Set of lemmas from Apt and Olderog "Verification of sequential
   9.159 +and concurrent programs", page 63. *}
   9.160 +
   9.161 +lemma L3_5i: "X\<subseteq>Y \<Longrightarrow> SEM c X \<subseteq> SEM c Y" 
   9.162 +apply (unfold SEM_def)
   9.163 +apply force
   9.164 +done
   9.165 +
   9.166 +lemma L3_5ii_lemma1: 
   9.167 + "\<lbrakk> (c1, s1) -P*\<rightarrow> (Parallel Ts, s2); All_None Ts;  
   9.168 +  (c2, s2) -P*\<rightarrow> (Parallel Ss, s3); All_None Ss \<rbrakk> 
   9.169 + \<Longrightarrow> (Seq c1 c2, s1) -P*\<rightarrow> (Parallel Ss, s3)"
   9.170 +apply(erule converse_rtrancl_induct2)
   9.171 +apply(force intro:converse_rtrancl_into_rtrancl)+
   9.172 +done
   9.173 +
   9.174 +lemma L3_5ii_lemma2 [rule_format (no_asm)]: 
   9.175 + "\<forall>c1 c2 s t. (Seq c1 c2, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow>  
   9.176 +  (All_None Ts) \<longrightarrow> (\<exists>y m Rs. (c1,s) -P*\<rightarrow> (Parallel Rs, y) \<and> 
   9.177 +  (All_None Rs) \<and> (c2, y) -Pm\<rightarrow> (Parallel Ts, t) \<and>  m \<le> n)"
   9.178 +apply(induct "n")
   9.179 + apply(force)
   9.180 +apply(safe dest!: rel_pow_Suc_D2)
   9.181 +apply(erule transition_cases,simp_all)
   9.182 + apply (fast intro!: le_SucI)
   9.183 +apply (fast intro!: le_SucI elim!: rel_pow_imp_rtrancl converse_rtrancl_into_rtrancl)
   9.184 +done
   9.185 +
   9.186 +lemma L3_5ii_lemma3: 
   9.187 + "\<lbrakk>(Seq c1 c2,s) -P*\<rightarrow> (Parallel Ts,t); All_None Ts\<rbrakk> \<Longrightarrow> 
   9.188 +    (\<exists>y Rs. (c1,s) -P*\<rightarrow> (Parallel Rs,y) \<and> All_None Rs 
   9.189 +   \<and> (c2,y) -P*\<rightarrow> (Parallel Ts,t))"
   9.190 +apply(drule rtrancl_imp_UN_rel_pow)
   9.191 +apply(fast dest: L3_5ii_lemma2 rel_pow_imp_rtrancl)
   9.192 +done
   9.193 +
   9.194 +lemma L3_5ii: "SEM (Seq c1 c2) X = SEM c2 (SEM c1 X)"
   9.195 +apply (unfold SEM_def sem_def)
   9.196 +apply auto
   9.197 + apply(fast dest: L3_5ii_lemma3)
   9.198 +apply(fast elim: L3_5ii_lemma1)
   9.199 +done
   9.200 +
   9.201 +lemma L3_5iii: "SEM (Seq (Seq c1 c2) c3) X = SEM (Seq c1 (Seq c2 c3)) X"
   9.202 +apply (simp (no_asm) add: L3_5ii)
   9.203 +done
   9.204 +
   9.205 +lemma L3_5iv:
   9.206 + "SEM (Cond b c1 c2) X = (SEM c1 (X \<inter> b)) Un (SEM c2 (X \<inter> (-b)))"
   9.207 +apply (unfold SEM_def sem_def)
   9.208 +apply auto
   9.209 +apply(erule converse_rtranclE)
   9.210 + prefer 2
   9.211 + apply (erule transition_cases,simp_all)
   9.212 +  apply(fast intro: converse_rtrancl_into_rtrancl elim: transition_cases)+
   9.213 +done
   9.214 +
   9.215 +
   9.216 +lemma  L3_5v_lemma1[rule_format]: 
   9.217 + "(S,s) -Pn\<rightarrow> (T,t) \<longrightarrow> S=\<Omega> \<longrightarrow> (\<not>(\<exists>Rs. T=(Parallel Rs) \<and> All_None Rs))"
   9.218 +apply (unfold UNIV_def)
   9.219 +apply(rule nat_less_induct)
   9.220 +apply safe
   9.221 +apply(erule rel_pow_E2)
   9.222 + apply simp_all
   9.223 +apply(erule transition_cases)
   9.224 + apply simp_all
   9.225 +apply(erule rel_pow_E2)
   9.226 + apply(simp add: Id_def)
   9.227 +apply(erule transition_cases,simp_all)
   9.228 +apply clarify
   9.229 +apply(erule transition_cases,simp_all)
   9.230 +apply(erule rel_pow_E2,simp)
   9.231 +apply clarify
   9.232 +apply(erule transition_cases)
   9.233 + apply simp+
   9.234 +    apply clarify
   9.235 +    apply(erule transition_cases)
   9.236 +apply simp_all
   9.237 +done
   9.238 +
   9.239 +lemma L3_5v_lemma2: "\<lbrakk>(\<Omega>, s) -P*\<rightarrow> (Parallel Ts, t); All_None Ts \<rbrakk> \<Longrightarrow> False"
   9.240 +apply(fast dest: rtrancl_imp_UN_rel_pow L3_5v_lemma1)
   9.241 +done
   9.242 +
   9.243 +lemma L3_5v_lemma3: "SEM (\<Omega>) S = {}"
   9.244 +apply (unfold SEM_def sem_def)
   9.245 +apply(fast dest: L3_5v_lemma2)
   9.246 +done
   9.247 +
   9.248 +lemma L3_5v_lemma4 [rule_format]: 
   9.249 + "\<forall>s. (While b i c, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
   9.250 +  (\<exists>k. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t))"
   9.251 +apply(rule nat_less_induct)
   9.252 +apply safe
   9.253 +apply(erule rel_pow_E2)
   9.254 + apply safe
   9.255 +apply(erule transition_cases,simp_all)
   9.256 + apply (rule_tac x = "1" in exI)
   9.257 + apply(force dest: Parallel_empty_lemma intro: converse_rtrancl_into_rtrancl simp add: Id_def)
   9.258 +apply safe
   9.259 +apply(drule L3_5ii_lemma2)
   9.260 + apply safe
   9.261 +apply(drule le_imp_less_Suc)
   9.262 +apply (erule allE , erule impE,assumption)
   9.263 +apply (erule allE , erule impE, assumption)
   9.264 +apply safe
   9.265 +apply (rule_tac x = "k+1" in exI)
   9.266 +apply(simp (no_asm))
   9.267 +apply(rule converse_rtrancl_into_rtrancl)
   9.268 + apply fast
   9.269 +apply(fast elim: L3_5ii_lemma1)
   9.270 +done
   9.271 +
   9.272 +lemma L3_5v_lemma5 [rule_format]: 
   9.273 + "\<forall>s. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
   9.274 +  (While b i c, s) -P*\<rightarrow> (Parallel Ts,t)"
   9.275 +apply(induct "k")
   9.276 + apply(force dest: L3_5v_lemma2)
   9.277 +apply safe
   9.278 +apply(erule converse_rtranclE)
   9.279 + apply simp_all
   9.280 +apply(erule transition_cases,simp_all)
   9.281 + apply(rule converse_rtrancl_into_rtrancl)
   9.282 +  apply(fast)
   9.283 + apply(fast elim!: L3_5ii_lemma1 dest: L3_5ii_lemma3)
   9.284 +apply(drule rtrancl_imp_UN_rel_pow)
   9.285 +apply clarify
   9.286 +apply(erule rel_pow_E2)
   9.287 + apply simp_all
   9.288 +apply(erule transition_cases,simp_all)
   9.289 +apply(fast dest: Parallel_empty_lemma)
   9.290 +done
   9.291 +
   9.292 +lemma L3_5v: "SEM (While b i c) = (\<lambda>x. (\<Union>k. SEM (fwhile b c k) x))"
   9.293 +apply(rule ext)
   9.294 +apply (simp add: SEM_def sem_def)
   9.295 +apply safe
   9.296 + apply(drule rtrancl_imp_UN_rel_pow,simp)
   9.297 + apply clarify
   9.298 + apply(fast dest:L3_5v_lemma4)
   9.299 +apply(fast intro: L3_5v_lemma5)
   9.300 +done
   9.301 +
   9.302 +section {* Validity of Correctness Formulas *}
   9.303 +
   9.304 +constdefs 
   9.305 +  com_validity :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>= _// _//_)" [90,55,90] 50)
   9.306 +  "\<parallel>= p c q \<equiv> SEM c p \<subseteq> q"
   9.307 +
   9.308 +  ann_com_validity :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"   ("\<Turnstile> _ _" [60,90] 45)
   9.309 +  "\<Turnstile> c q \<equiv> ann_SEM c (pre c) \<subseteq> q"
   9.310 +
   9.311 +end
   9.312 \ No newline at end of file
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/HOL/HoareParallel/Quote_Antiquote.thy	Tue Mar 05 17:11:25 2002 +0100
    10.3 @@ -0,0 +1,24 @@
    10.4 +
    10.5 +header {* \section{Concrete Syntax} *}
    10.6 +
    10.7 +theory Quote_Antiquote = Main:
    10.8 +
    10.9 +syntax
   10.10 +  "_quote"     :: "'b \<Rightarrow> ('a \<Rightarrow> 'b)"                ("(\<guillemotleft>_\<guillemotright>)" [0] 1000)
   10.11 +  "_antiquote" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'b"                ("\<acute>_" [1000] 1000)
   10.12 +  "_Assert"    :: "'a \<Rightarrow> 'a set"                    ("(.{_}.)" [0] 1000)
   10.13 +
   10.14 +syntax (xsymbols)
   10.15 +  "_Assert"    :: "'a \<Rightarrow> 'a set"            ("(\<lbrace>_\<rbrace>)" [0] 1000)
   10.16 +
   10.17 +translations
   10.18 +  ".{b}." \<rightharpoonup> "Collect \<guillemotleft>b\<guillemotright>"
   10.19 +
   10.20 +parse_translation {*
   10.21 +  let
   10.22 +    fun quote_tr [t] = Syntax.quote_tr "_antiquote" t
   10.23 +      | quote_tr ts = raise TERM ("quote_tr", ts);
   10.24 +  in [("_quote", quote_tr)] end
   10.25 +*}
   10.26 +
   10.27 +end
   10.28 \ No newline at end of file
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/HOL/HoareParallel/RG_Com.thy	Tue Mar 05 17:11:25 2002 +0100
    11.3 @@ -0,0 +1,25 @@
    11.4 +
    11.5 +header {* \chapter{The Rely-Guarantee Method} 
    11.6 +
    11.7 +\section {Abstract Syntax}
    11.8 +*}
    11.9 +
   11.10 +theory RG_Com = Main:
   11.11 +
   11.12 +text {* Semantics of assertions and boolean expressions (bexp) as sets
   11.13 +of states.  Syntax of commands @{text com} and parallel commands
   11.14 +@{text par_com}. *}
   11.15 +
   11.16 +types
   11.17 +  'a bexp = "'a set"
   11.18 +
   11.19 +datatype 'a com = 
   11.20 +    Basic "'a \<Rightarrow>'a"
   11.21 +  | Seq "'a com" "'a com"
   11.22 +  | Cond "'a bexp" "'a com" "'a com"         
   11.23 +  | While "'a bexp" "'a com"       
   11.24 +  | Await "'a bexp" "'a com"                 
   11.25 +
   11.26 +types 'a par_com = "(('a com) option) list"
   11.27 +
   11.28 +end
   11.29 \ No newline at end of file
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOL/HoareParallel/RG_Examples.thy	Tue Mar 05 17:11:25 2002 +0100
    12.3 @@ -0,0 +1,408 @@
    12.4 +
    12.5 +header {* \section{Examples} *}
    12.6 +
    12.7 +theory RG_Examples = RG_Syntax:
    12.8 +
    12.9 +lemmas definitions [simp]= stable_def Pre_def Rely_def Guar_def Post_def Com_def 
   12.10 +
   12.11 +subsection {* Set Elements of an Array to Zero *}
   12.12 +
   12.13 +lemma le_less_trans2: "\<lbrakk>(j::nat)<k; i\<le> j\<rbrakk> \<Longrightarrow> i<k"
   12.14 +by simp
   12.15 +
   12.16 +lemma add_le_less_mono: "\<lbrakk> (a::nat) < c; b\<le>d \<rbrakk> \<Longrightarrow> a + b < c + d"
   12.17 +by simp
   12.18 +
   12.19 +record Example1 =
   12.20 +  A :: "nat list"
   12.21 +
   12.22 +lemma Example1: 
   12.23 + "\<turnstile> COBEGIN
   12.24 +      SCHEME [0 \<le> i < n]
   12.25 +     (\<acute>A := \<acute>A [i := 0], 
   12.26 +     \<lbrace> n < length \<acute>A \<rbrace>, 
   12.27 +     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> \<ordmasculine>A ! i = \<ordfeminine>A ! i \<rbrace>, 
   12.28 +     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> (\<forall>j<n. i \<noteq> j \<longrightarrow> \<ordmasculine>A ! j = \<ordfeminine>A ! j) \<rbrace>, 
   12.29 +     \<lbrace> \<acute>A ! i = 0 \<rbrace>) 
   12.30 +    COEND
   12.31 + SAT [\<lbrace> n < length \<acute>A \<rbrace>, \<lbrace> \<ordmasculine>A = \<ordfeminine>A \<rbrace>, \<lbrace> True \<rbrace>, \<lbrace> \<forall>i < n. \<acute>A ! i = 0 \<rbrace>]"
   12.32 +apply(rule Parallel)
   12.33 +    apply simp
   12.34 +    apply clarify
   12.35 +    apply simp
   12.36 +    apply(erule disjE)
   12.37 +     apply simp
   12.38 +    apply clarify
   12.39 +    apply simp
   12.40 +   apply auto
   12.41 +apply(rule Basic)
   12.42 +apply auto
   12.43 +done
   12.44 +
   12.45 +lemma Example1_parameterized: 
   12.46 +"k < t \<Longrightarrow>
   12.47 +  \<turnstile> COBEGIN 
   12.48 +    SCHEME [k*n\<le>i<(Suc k)*n] (\<acute>A:=\<acute>A[i:=0], 
   12.49 +   \<lbrace>t*n < length \<acute>A\<rbrace>, 
   12.50 +   \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> \<ordmasculine>A!i = \<ordfeminine>A!i\<rbrace>, 
   12.51 +   \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> (\<forall>j<length \<ordmasculine>A . i\<noteq>j \<longrightarrow> \<ordmasculine>A!j = \<ordfeminine>A!j)\<rbrace>, 
   12.52 +   \<lbrace>\<acute>A!i=0\<rbrace>) 
   12.53 +   COEND  
   12.54 + SAT [\<lbrace>t*n < length \<acute>A\<rbrace>, 
   12.55 +      \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> (\<forall>i<n. \<ordmasculine>A!(k*n+i)=\<ordfeminine>A!(k*n+i))\<rbrace>, 
   12.56 +      \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> 
   12.57 +      (\<forall>i<length \<ordmasculine>A . (i<k*n \<longrightarrow> \<ordmasculine>A!i = \<ordfeminine>A!i) \<and> ((Suc k)*n \<le> i\<longrightarrow> \<ordmasculine>A!i = \<ordfeminine>A!i))\<rbrace>, 
   12.58 +      \<lbrace>\<forall>i<n. \<acute>A!(k*n+i) = 0\<rbrace>]"
   12.59 +apply(rule Parallel)
   12.60 +    apply simp
   12.61 +    apply clarify
   12.62 +    apply simp
   12.63 +    apply(erule disjE)
   12.64 +     apply clarify
   12.65 +     apply simp
   12.66 +    apply clarify
   12.67 +    apply simp
   12.68 +    apply clarify
   12.69 +    apply simp
   12.70 +    apply(erule_tac x="k*n +i" in allE)
   12.71 +    apply(subgoal_tac "k*n+i <length (A b)")
   12.72 +     apply force
   12.73 +    apply(erule le_less_trans2) 
   12.74 +    apply(case_tac t,simp+)
   12.75 +    apply (simp add:add_commute)
   12.76 +    apply(rule add_le_mono)
   12.77 +     apply simp
   12.78 +    apply simp
   12.79 +   apply simp
   12.80 +   apply clarify
   12.81 +   apply(rotate_tac -1)
   12.82 +   apply force
   12.83 +  apply force
   12.84 + apply force
   12.85 +apply simp
   12.86 +apply clarify
   12.87 +apply(rule Basic)
   12.88 +   apply simp
   12.89 +   apply clarify
   12.90 +   apply (subgoal_tac "k*n+i< length (A x)")
   12.91 +    apply simp
   12.92 +   apply(erule le_less_trans2)
   12.93 +   apply(case_tac t,simp+)
   12.94 +   apply (simp add:add_commute)
   12.95 +   apply(rule add_le_mono)
   12.96 +    apply simp
   12.97 +   apply simp
   12.98 +  apply force+
   12.99 +done
  12.100 +
  12.101 +subsection {* Increment a Variable in Parallel *}
  12.102 +
  12.103 +subsubsection {* Two components *}
  12.104 +
  12.105 +record Example2 =
  12.106 +  x  :: nat
  12.107 +  c_0 :: nat
  12.108 +  c_1 :: nat
  12.109 +
  12.110 +lemma Example2: 
  12.111 + "\<turnstile>  COBEGIN
  12.112 +    (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_0:=\<acute>c_0 + 1 \<rangle>, 
  12.113 +     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1  \<and> \<acute>c_0=0\<rbrace>, 
  12.114 +     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
  12.115 +        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
  12.116 +        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
  12.117 +     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
  12.118 +         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
  12.119 +         \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
  12.120 +     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_0=1 \<rbrace>)
  12.121 +  \<parallel>
  12.122 +      (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_1:=\<acute>c_1+1 \<rangle>, 
  12.123 +     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=0 \<rbrace>, 
  12.124 +     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
  12.125 +        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
  12.126 +        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
  12.127 +     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
  12.128 +         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
  12.129 +        \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
  12.130 +     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=1\<rbrace>)
  12.131 + COEND
  12.132 + SAT [\<lbrace>\<acute>x=0 \<and> \<acute>c_0=0 \<and> \<acute>c_1=0\<rbrace>, 
  12.133 +      \<lbrace>\<ordmasculine>x=\<ordfeminine>x \<and>  \<ordmasculine>c_0= \<ordfeminine>c_0 \<and> \<ordmasculine>c_1=\<ordfeminine>c_1\<rbrace>,
  12.134 +      \<lbrace>True\<rbrace>,
  12.135 +      \<lbrace>\<acute>x=2\<rbrace>]"
  12.136 +apply(rule Parallel)
  12.137 +   apply simp_all
  12.138 +   apply clarify
  12.139 +   apply(case_tac i)
  12.140 +    apply simp
  12.141 +    apply(erule disjE)
  12.142 +     apply clarify
  12.143 +     apply simp
  12.144 +    apply clarify
  12.145 +    apply simp
  12.146 +    apply(case_tac j,simp)
  12.147 +    apply simp
  12.148 +   apply simp
  12.149 +   apply(erule disjE)
  12.150 +    apply clarify
  12.151 +    apply simp
  12.152 +   apply clarify
  12.153 +   apply simp
  12.154 +   apply(case_tac j,simp,simp)
  12.155 +  apply clarify
  12.156 +  apply(case_tac i,simp,simp)
  12.157 + apply clarify   
  12.158 + apply simp
  12.159 + apply(erule_tac x=0 in all_dupE)
  12.160 + apply(erule_tac x=1 in allE,simp)
  12.161 +apply clarify
  12.162 +apply(case_tac i,simp)
  12.163 + apply(rule Await)
  12.164 +  apply simp_all
  12.165 + apply(clarify)
  12.166 + apply(rule Seq)
  12.167 +  prefer 2
  12.168 +  apply(rule Basic)
  12.169 +   apply simp_all
  12.170 +  apply(rule subset_refl)
  12.171 + apply(rule Basic)
  12.172 + apply simp_all
  12.173 + apply clarify
  12.174 + apply simp
  12.175 +apply(rule Await)
  12.176 + apply simp_all
  12.177 +apply(clarify)
  12.178 +apply(rule Seq)
  12.179 + prefer 2
  12.180 + apply(rule Basic)
  12.181 +  apply simp_all
  12.182 + apply(rule subset_refl)
  12.183 +apply(rule Basic)
  12.184 +apply simp_all
  12.185 +apply clarify
  12.186 +apply simp
  12.187 +done
  12.188 +
  12.189 +subsubsection {* Parameterized *}
  12.190 +
  12.191 +lemma Example2_lemma1: "j<n \<Longrightarrow> (\<Sum>i<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
  12.192 +apply(induct n)
  12.193 + apply simp_all
  12.194 +apply(force simp add: less_Suc_eq)
  12.195 +done
  12.196 +
  12.197 +lemma Example2_lemma2_aux: 
  12.198 + "j<n \<Longrightarrow> (\<Sum>i<n. (b i::nat)) = (\<Sum>i<j. b i) + b j + (\<Sum>i<n-(Suc j) . b (Suc j + i))"
  12.199 +apply(induct n)
  12.200 + apply simp_all
  12.201 +apply(simp add:less_Suc_eq)
  12.202 + apply(auto)
  12.203 +apply(subgoal_tac "n - j = Suc(n- Suc j)")
  12.204 +  apply simp
  12.205 +apply arith
  12.206 +done 
  12.207 +
  12.208 +lemma Example2_lemma2_aux2: "j\<le> s \<Longrightarrow> (\<Sum>i<j. (b (s:=t)) i) = (\<Sum>i<j. b i)"
  12.209 +apply(induct j)
  12.210 + apply simp_all
  12.211 +done
  12.212 +
  12.213 +lemma Example2_lemma2: "\<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i< n. b i)=(\<Sum>i< n. (b (j:=1)) i)"
  12.214 +apply(frule_tac b="(b (j:=1))" in Example2_lemma2_aux)
  12.215 +apply(erule_tac  t="Summation (b(j := 1)) n" in ssubst)
  12.216 +apply(frule_tac b=b in Example2_lemma2_aux)
  12.217 +apply(erule_tac  t="Summation b n" in ssubst)
  12.218 +apply(subgoal_tac "Suc (Summation b j + b j + (\<Sum>i<n - Suc j. b (Suc j + i)))=(Summation b j + Suc (b j) + (\<Sum>i<n - Suc j. b (Suc j + i)))")
  12.219 + apply(rotate_tac -1)
  12.220 + apply(erule ssubst)
  12.221 + apply(subgoal_tac "j\<le>j")
  12.222 +  apply(drule_tac b="b" and t=1 in Example2_lemma2_aux2)
  12.223 +  apply(rotate_tac -1)
  12.224 +  apply(erule ssubst)
  12.225 +apply simp_all
  12.226 +done
  12.227 +
  12.228 +lemma Example2_lemma2_Suc0: "\<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i< n. b i)=(\<Sum>i< n. (b (j:=Suc 0)) i)"
  12.229 +by(simp add:Example2_lemma2)
  12.230 +
  12.231 +lemma Example2_lemma3: "\<forall>i< n. b i = 1 \<Longrightarrow> (\<Sum>i<n. b i)= n"
  12.232 +apply (induct n)
  12.233 +apply auto
  12.234 +done
  12.235 +
  12.236 +record Example2_parameterized =   
  12.237 +  C :: "nat \<Rightarrow> nat"
  12.238 +  y  :: nat
  12.239 +
  12.240 +lemma Example2_parameterized: "0<n \<Longrightarrow> 
  12.241 +  \<turnstile> COBEGIN SCHEME  [0\<le>i<n]
  12.242 +     (\<langle> \<acute>y:=\<acute>y+1;; \<acute>C:=\<acute>C (i:=1) \<rangle>, 
  12.243 +     \<lbrace>\<acute>y=(\<Sum>i<n. \<acute>C i) \<and> \<acute>C i=0\<rbrace>, 
  12.244 +     \<lbrace>\<ordmasculine>C i = \<ordfeminine>C i \<and> 
  12.245 +      (\<ordmasculine>y=(\<Sum>i<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i<n. \<ordfeminine>C i))\<rbrace>,  
  12.246 +     \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>C j = \<ordfeminine>C j) \<and> 
  12.247 +       (\<ordmasculine>y=(\<Sum>i<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i<n. \<ordfeminine>C i))\<rbrace>,
  12.248 +     \<lbrace>\<acute>y=(\<Sum>i<n. \<acute>C i) \<and> \<acute>C i=1\<rbrace>) 
  12.249 +    COEND
  12.250 + SAT [\<lbrace>\<acute>y=0 \<and> (\<Sum>i<n. \<acute>C i)=0 \<rbrace>, \<lbrace>\<ordmasculine>C=\<ordfeminine>C \<and> \<ordmasculine>y=\<ordfeminine>y\<rbrace>, \<lbrace>True\<rbrace>, \<lbrace>\<acute>y=n\<rbrace>]"
  12.251 +apply(rule Parallel)
  12.252 +apply force
  12.253 +apply force
  12.254 +apply(force elim:Example2_lemma1)
  12.255 +apply clarify
  12.256 +apply simp
  12.257 +apply(force intro:Example2_lemma3)
  12.258 +apply clarify
  12.259 +apply simp
  12.260 +apply(rule Await)
  12.261 +apply simp_all
  12.262 +apply clarify
  12.263 +apply(rule Seq)
  12.264 +prefer 2
  12.265 +apply(rule Basic)
  12.266 +apply(rule subset_refl)
  12.267 +apply simp+
  12.268 +apply(rule Basic)
  12.269 +apply simp
  12.270 +apply clarify
  12.271 +apply simp
  12.272 +apply(force elim:Example2_lemma2_Suc0)
  12.273 +apply simp+
  12.274 +done
  12.275 +
  12.276 +subsection {* Find Least Element *}
  12.277 +
  12.278 +text {* A previous lemma: *}
  12.279 +
  12.280 +lemma mod_aux :"\<lbrakk>i < (n::nat); a mod n = i;  j < a + n; j mod n = i; a < j\<rbrakk> \<Longrightarrow> False"
  12.281 +apply(subgoal_tac "a=a div n*n + a mod n" )
  12.282 + prefer 2 apply (simp (no_asm_use) only: mod_div_equality [symmetric])
  12.283 +apply(subgoal_tac "j=j div n*n + j mod n")
  12.284 + prefer 2 apply (simp (no_asm_use) only: mod_div_equality [symmetric])
  12.285 +apply simp
  12.286 +apply(subgoal_tac "a div n*n < j div n*n")
  12.287 +prefer 2 apply arith
  12.288 +apply(subgoal_tac "j div n*n < (a div n + 1)*n")
  12.289 +prefer 2 apply simp 
  12.290 +apply (simp only:mult_less_cancel2)
  12.291 +apply arith
  12.292 +done
  12.293 +
  12.294 +record Example3 =
  12.295 +  X :: "nat \<Rightarrow> nat"
  12.296 +  Y :: "nat \<Rightarrow> nat"
  12.297 +
  12.298 +lemma Example3: "m mod n=0 \<Longrightarrow> 
  12.299 + \<turnstile> COBEGIN 
  12.300 + SCHEME [0\<le>i<n]
  12.301 + (WHILE (\<forall>j<n. \<acute>X i < \<acute>Y j)  DO 
  12.302 +   IF P(B!(\<acute>X i)) THEN \<acute>Y:=\<acute>Y (i:=\<acute>X i) 
  12.303 +   ELSE \<acute>X:= \<acute>X (i:=(\<acute>X i)+ n) FI 
  12.304 +  OD,
  12.305 + \<lbrace>(\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i)\<rbrace>,
  12.306 + \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y j \<le> \<ordmasculine>Y j) \<and> \<ordmasculine>X i = \<ordfeminine>X i \<and> 
  12.307 +   \<ordmasculine>Y i = \<ordfeminine>Y i\<rbrace>,
  12.308 + \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X j = \<ordfeminine>X j \<and> \<ordmasculine>Y j = \<ordfeminine>Y j) \<and>   
  12.309 +   \<ordfeminine>Y i \<le> \<ordmasculine>Y i\<rbrace>,
  12.310 + \<lbrace>(\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y j \<le> \<acute>X i) \<rbrace>) 
  12.311 + COEND
  12.312 + SAT [\<lbrace> \<forall>i<n. \<acute>X i=i \<and> \<acute>Y i=m+i \<rbrace>,\<lbrace>\<ordmasculine>X=\<ordfeminine>X \<and> \<ordmasculine>Y=\<ordfeminine>Y\<rbrace>,\<lbrace>True\<rbrace>,
  12.313 +  \<lbrace>\<forall>i<n. (\<acute>X i) mod n=i \<and> (\<forall>j<\<acute>X i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> 
  12.314 +    (\<acute>Y i<m \<longrightarrow> P(B!(\<acute>Y i)) \<and> \<acute>Y i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y j \<le> \<acute>X i)\<rbrace>]"
  12.315 +apply(rule Parallel)
  12.316 +(*5*)
  12.317 +apply force+
  12.318 +apply clarify
  12.319 +apply simp
  12.320 +apply(rule While)
  12.321 +    apply force
  12.322 +   apply force
  12.323 +  apply force
  12.324 + apply(rule_tac "pre'"="\<lbrace> \<acute>X i mod n = i \<and> (\<forall>j. j<\<acute>X i \<longrightarrow> j mod n = i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y i < n * q \<longrightarrow> P (B!(\<acute>Y i))) \<and> \<acute>X i<\<acute>Y i\<rbrace>" in Conseq)
  12.325 +     apply force
  12.326 +    apply(rule subset_refl)+
  12.327 + apply(rule Cond)
  12.328 +    apply force
  12.329 +   apply(rule Basic)
  12.330 +      apply force
  12.331 +     apply force
  12.332 +    apply force
  12.333 +   apply force
  12.334 +  apply(rule Basic)
  12.335 +     apply simp
  12.336 +     apply clarify
  12.337 +     apply simp
  12.338 +     apply(case_tac "X x (j mod n)\<le> j")
  12.339 +      apply(drule le_imp_less_or_eq)
  12.340 +      apply(erule disjE)
  12.341 +       apply(drule_tac j=j and n=n and i="j mod n" and a="X x (j mod n)" in mod_aux)
  12.342 +        apply assumption+
  12.343 +       apply simp+
  12.344 +     apply(erule_tac x=j in allE)
  12.345 +     apply force
  12.346 +    apply simp
  12.347 +    apply clarify
  12.348 +    apply(rule conjI)
  12.349 +     apply clarify  
  12.350 +     apply simp
  12.351 +     apply(erule not_sym)
  12.352 +    apply force
  12.353 +apply force+
  12.354 +done
  12.355 +
  12.356 +text {* Same but with a list as auxiliary variable: *}
  12.357 +
  12.358 +record Example3_list =
  12.359 +  X :: "nat list"
  12.360 +  Y :: "nat list"
  12.361 +
  12.362 +lemma Example3_list: "m mod n=0 \<Longrightarrow> \<turnstile> (COBEGIN SCHEME [0\<le>i<n]
  12.363 + (WHILE (\<forall>j<n. \<acute>X!i < \<acute>Y!j)  DO 
  12.364 +     IF P(B!(\<acute>X!i)) THEN \<acute>Y:=\<acute>Y[i:=\<acute>X!i] ELSE \<acute>X:= \<acute>X[i:=(\<acute>X!i)+ n] FI 
  12.365 +  OD,
  12.366 + \<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> (\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i)\<rbrace>,
  12.367 + \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y!j \<le> \<ordmasculine>Y!j) \<and> \<ordmasculine>X!i = \<ordfeminine>X!i \<and> 
  12.368 +   \<ordmasculine>Y!i = \<ordfeminine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
  12.369 + \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X!j = \<ordfeminine>X!j \<and> \<ordmasculine>Y!j = \<ordfeminine>Y!j) \<and>   
  12.370 +   \<ordfeminine>Y!i \<le> \<ordmasculine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
  12.371 + \<lbrace>(\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y!j \<le> \<acute>X!i) \<rbrace>) COEND)
  12.372 + SAT [\<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> (\<forall>i<n. \<acute>X!i=i \<and> \<acute>Y!i=m+i) \<rbrace>,
  12.373 +      \<lbrace>\<ordmasculine>X=\<ordfeminine>X \<and> \<ordmasculine>Y=\<ordfeminine>Y\<rbrace>,
  12.374 +      \<lbrace>True\<rbrace>,
  12.375 +      \<lbrace>\<forall>i<n. (\<acute>X!i) mod n=i \<and> (\<forall>j<\<acute>X!i. j mod n=i \<longrightarrow> \<not>P(B!j)) \<and> 
  12.376 +        (\<acute>Y!i<m \<longrightarrow> P(B!(\<acute>Y!i)) \<and> \<acute>Y!i\<le> m+i) \<and> (\<exists>j<n. \<acute>Y!j \<le> \<acute>X!i)\<rbrace>]"
  12.377 +apply(rule Parallel)
  12.378 +(*5*)
  12.379 +apply force+
  12.380 +apply clarify
  12.381 +apply simp
  12.382 +apply(rule While)
  12.383 +    apply force
  12.384 +   apply force
  12.385 +  apply force
  12.386 + apply(rule_tac "pre'"="\<lbrace>n<length \<acute>X \<and> n<length \<acute>Y \<and> \<acute>X ! i mod n = i \<and> (\<forall>j. j < \<acute>X ! i \<longrightarrow> j mod n = i \<longrightarrow> \<not> P (B ! j)) \<and> (\<acute>Y ! i < n * q \<longrightarrow> P (B ! (\<acute>Y ! i))) \<and> \<acute>X!i<\<acute>Y!i\<rbrace>" in Conseq)
  12.387 +     apply force
  12.388 +    apply(rule subset_refl)+
  12.389 + apply(rule Cond)
  12.390 +    apply force
  12.391 +   apply(rule Basic)
  12.392 +      apply force
  12.393 +     apply force
  12.394 +    apply force
  12.395 +   apply force
  12.396 +  apply(rule Basic)
  12.397 +     apply simp
  12.398 +     apply clarify
  12.399 +     apply simp
  12.400 +     apply(rule allI)
  12.401 +     apply(rule impI)+
  12.402 +     apply(case_tac "X x ! i\<le> j")
  12.403 +      apply(drule le_imp_less_or_eq)
  12.404 +      apply(erule disjE)
  12.405 +       apply(drule_tac j=j and n=n and i=i and a="X x ! i" in mod_aux)
  12.406 +        apply assumption+
  12.407 +       apply simp
  12.408 +apply force+
  12.409 +done
  12.410 +
  12.411 +end
  12.412 \ No newline at end of file
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/HoareParallel/RG_Hoare.thy	Tue Mar 05 17:11:25 2002 +0100
    13.3 @@ -0,0 +1,1495 @@
    13.4 +
    13.5 +header {* \section{The Proof System} *}
    13.6 +
    13.7 +theory RG_Hoare = RG_Tran:
    13.8 +
    13.9 +subsection {* Proof System for Component Programs *}
   13.10 +
   13.11 +constdefs
   13.12 +  stable :: "'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> bool"  
   13.13 +  "stable \<equiv> \<lambda>f g. (\<forall>x y. x \<in> f \<longrightarrow> (x, y) \<in> g \<longrightarrow> y \<in> f)" 
   13.14 +
   13.15 +consts rghoare :: "('a rgformula) set" 
   13.16 +syntax 
   13.17 +  "_rghoare" :: "['a com, 'a set, ('a \<times> 'a) set, ('a \<times> 'a) set, 'a set] \<Rightarrow> bool"  
   13.18 +                ("\<turnstile> _ sat [_, _, _, _]" [60,0,0,0,0] 45)
   13.19 +translations 
   13.20 +  "\<turnstile> P sat [pre, rely, guar, post]" \<rightleftharpoons> "(P, pre, rely, guar, post) \<in> rghoare"
   13.21 +
   13.22 +inductive rghoare
   13.23 +intros
   13.24 +  Basic: "\<lbrakk> pre \<subseteq> {s. f s \<in> post}; {(s,t). s \<in> pre \<and> t=f s} \<subseteq> guar; 
   13.25 +            stable pre rely; stable post rely \<rbrakk> 
   13.26 +           \<Longrightarrow> \<turnstile> Basic f sat [pre, rely, guar, post]"
   13.27 +
   13.28 +  Seq: "\<lbrakk> \<turnstile> P sat [pre, rely, guar, mid]; \<turnstile> Q sat [mid, rely, guar, post] \<rbrakk> 
   13.29 +           \<Longrightarrow> \<turnstile> Seq P Q sat [pre, rely, guar, post]"
   13.30 +
   13.31 +  Cond: "\<lbrakk> stable pre rely; \<turnstile> P1 sat [pre \<inter> b, rely, guar, post];
   13.32 +           \<turnstile> P2 sat [pre \<inter> -b, rely, guar, post]; \<forall>s. (s,s)\<in>guar \<rbrakk>
   13.33 +          \<Longrightarrow> \<turnstile> Cond b P1 P2 sat [pre, rely, guar, post]"
   13.34 +
   13.35 +  While: "\<lbrakk> stable pre rely; (pre \<inter> -b) \<subseteq> post; stable post rely;
   13.36 +            \<turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s,s)\<in>guar \<rbrakk>
   13.37 +          \<Longrightarrow> \<turnstile> While b P sat [pre, rely, guar, post]"
   13.38 +
   13.39 +  Await: "\<lbrakk> stable pre rely; stable post rely; 
   13.40 +            \<forall>V. \<turnstile> P sat [pre \<inter> b \<inter> {V}, {(s, t). s = t}, UNIV, {s. (V, s) \<in> guar} \<inter> post] \<rbrakk>
   13.41 +           \<Longrightarrow> \<turnstile> Await b P sat [pre, rely, guar, post]"
   13.42 +  
   13.43 +  Conseq: "\<lbrakk> pre \<subseteq> pre'; rely \<subseteq> rely'; guar' \<subseteq> guar; post' \<subseteq> post;
   13.44 +             \<turnstile> P sat [pre', rely', guar', post'] \<rbrakk>
   13.45 +            \<Longrightarrow> \<turnstile> P sat [pre, rely, guar, post]"
   13.46 +
   13.47 +constdefs 
   13.48 +  Pre :: "'a rgformula \<Rightarrow> 'a set"
   13.49 +  "Pre x \<equiv> fst(snd x)"
   13.50 +  Post :: "'a rgformula \<Rightarrow> 'a set"
   13.51 +  "Post x \<equiv> snd(snd(snd(snd x)))"
   13.52 +  Rely :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
   13.53 +  "Rely x \<equiv> fst(snd(snd x))"
   13.54 +  Guar :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
   13.55 +  "Guar x \<equiv> fst(snd(snd(snd x)))"
   13.56 +  Com :: "'a rgformula \<Rightarrow> 'a com"
   13.57 +  "Com x \<equiv> fst x"
   13.58 +
   13.59 +subsection {* Proof System for Parallel Programs *}
   13.60 +
   13.61 +types 'a par_rgformula = "('a rgformula) list \<times> 'a set \<times> ('a \<times> 'a) set \<times> ('a \<times> 'a) set \<times> 'a set"
   13.62 +
   13.63 +consts par_rghoare :: "('a par_rgformula) set" 
   13.64 +syntax 
   13.65 +  "_par_rghoare" :: "('a rgformula) list \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set
   13.66 +                  \<Rightarrow> bool"    ("\<turnstile> _ SAT [_, _, _, _]" [60,0,0,0,0] 45)
   13.67 +translations 
   13.68 +  "\<turnstile> Ps SAT [pre, rely, guar, post]" \<rightleftharpoons> "(Ps, pre, rely, guar, post) \<in> par_rghoare"
   13.69 +
   13.70 +inductive par_rghoare
   13.71 +intros
   13.72 +  Parallel: 
   13.73 +  "\<lbrakk> \<forall>i<length xs. rely \<union> (\<Union>j\<in>{j. j<length xs \<and> j\<noteq>i}. Guar(xs!j)) \<subseteq> Rely(xs!i);
   13.74 +    (\<Union>j\<in>{j. j<length xs}. Guar(xs!j)) \<subseteq> guar;
   13.75 +     pre \<subseteq> (\<Inter>i\<in>{i. i<length xs}. Pre(xs!i)); 
   13.76 +    (\<Inter>i\<in>{i. i<length xs}. Post(xs!i)) \<subseteq> post;
   13.77 +    \<forall>i<length xs. \<turnstile> Com(xs!i) sat [Pre(xs!i),Rely(xs!i),Guar(xs!i),Post(xs!i)] \<rbrakk>
   13.78 +   \<Longrightarrow>  \<turnstile> xs SAT [pre, rely, guar, post]"
   13.79 +
   13.80 +section {* Soundness*}
   13.81 +
   13.82 +subsubsection {* Some previous lemmas *}
   13.83 +
   13.84 +lemma tl_of_assum_in_assum: 
   13.85 +  "(P, s) # (P, t) # xs \<in> assum (pre, rely) \<Longrightarrow> stable pre rely 
   13.86 +  \<Longrightarrow> (P, t) # xs \<in> assum (pre, rely)"
   13.87 +apply(simp add:assum_def)
   13.88 +apply clarify
   13.89 +apply(rule conjI)
   13.90 + apply(erule_tac x=0 in allE)
   13.91 + apply(simp (no_asm_use)only:stable_def)
   13.92 + apply(erule allE,erule allE,erule impE,assumption,erule mp)
   13.93 + apply(simp add:Env)
   13.94 +apply clarify
   13.95 +apply(erule_tac x="Suc i" in allE)
   13.96 +apply simp
   13.97 +done
   13.98 +
   13.99 +lemma etran_in_comm: 
  13.100 +  "(P, t) # xs \<in> comm(guar, post) \<Longrightarrow> (P, s) # (P, t) # xs \<in> comm(guar, post)"
  13.101 +apply(simp add:comm_def)
  13.102 +apply clarify
  13.103 +apply(case_tac i,simp+)
  13.104 +done
  13.105 +
  13.106 +lemma ctran_in_comm: 
  13.107 +  "\<lbrakk>(s, s) \<in> guar; (Q, s) # xs \<in> comm(guar, post)\<rbrakk> 
  13.108 +  \<Longrightarrow> (P, s) # (Q, s) # xs \<in> comm(guar, post)"
  13.109 +apply(simp add:comm_def)
  13.110 +apply clarify
  13.111 +apply(case_tac i,simp+)
  13.112 +done
  13.113 +
  13.114 +lemma takecptn_is_cptn [rule_format, elim!]: 
  13.115 +  "\<forall>j. c \<in> cptn \<longrightarrow> take (Suc j) c \<in> cptn"
  13.116 +apply(induct "c")
  13.117 + apply(force elim: cptn.elims)
  13.118 +apply clarify
  13.119 +apply(case_tac j) 
  13.120 + apply simp
  13.121 + apply(rule CptnOne)
  13.122 +apply simp
  13.123 +apply(force intro:cptn.intros elim:cptn.elims)
  13.124 +done
  13.125 +
  13.126 +lemma dropcptn_is_cptn [rule_format,elim!]: 
  13.127 +  "\<forall>j<length c. c \<in> cptn \<longrightarrow> drop j c \<in> cptn"
  13.128 +apply(induct "c")
  13.129 + apply(force elim: cptn.elims)
  13.130 +apply clarify
  13.131 +apply(case_tac j,simp+) 
  13.132 +apply(erule cptn.elims)
  13.133 +  apply simp
  13.134 + apply force
  13.135 +apply force
  13.136 +done
  13.137 +
  13.138 +lemma takepar_cptn_is_par_cptn [rule_format,elim]: 
  13.139 +  "\<forall>j. c \<in> par_cptn \<longrightarrow> take (Suc j) c \<in> par_cptn"
  13.140 +apply(induct "c")
  13.141 + apply(force elim: cptn.elims)
  13.142 +apply clarify
  13.143 +apply(case_tac j,simp) 
  13.144 + apply(rule ParCptnOne)
  13.145 +apply(force intro:par_cptn.intros elim:par_cptn.elims)
  13.146 +done
  13.147 +
  13.148 +lemma droppar_cptn_is_par_cptn [rule_format]:
  13.149 +  "\<forall>j<length c. c \<in> par_cptn \<longrightarrow> drop j c \<in> par_cptn"
  13.150 +apply(induct "c")
  13.151 + apply(force elim: par_cptn.elims)
  13.152 +apply clarify
  13.153 +apply(case_tac j,simp+) 
  13.154 +apply(erule par_cptn.elims)
  13.155 +  apply simp
  13.156 + apply force
  13.157 +apply force
  13.158 +done
  13.159 +
  13.160 +lemma tl_of_cptn_is_cptn: "\<lbrakk>x # xs \<in> cptn; xs \<noteq> []\<rbrakk> \<Longrightarrow> xs  \<in> cptn"
  13.161 +apply(subgoal_tac "1 < length (x # xs)") 
  13.162 + apply(drule dropcptn_is_cptn,simp+)
  13.163 +done
  13.164 +
  13.165 +lemma not_ctran_None [rule_format]: 
  13.166 +  "\<forall>s. (None, s)#xs \<in> cptn \<longrightarrow> (\<forall>i<length xs. ((None, s)#xs)!i -e\<rightarrow> xs!i)"
  13.167 +apply(induct xs,simp+)
  13.168 +apply clarify
  13.169 +apply(erule cptn.elims,simp)
  13.170 + apply simp
  13.171 + apply(case_tac i,simp)
  13.172 +  apply(rule Env)
  13.173 + apply simp
  13.174 +apply(force elim:ctran.elims)
  13.175 +done
  13.176 +
  13.177 +lemma cptn_not_empty [simp]:"[] \<notin> cptn"
  13.178 +apply(force elim:cptn.elims)
  13.179 +done
  13.180 +
  13.181 +lemma etran_or_ctran [rule_format]: 
  13.182 +  "\<forall>m i. x\<in>cptn \<longrightarrow> m \<le> length x 
  13.183 +  \<longrightarrow> (\<forall>i. Suc i < m \<longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i) \<longrightarrow> Suc i < m \<longrightarrow> x!i -e\<rightarrow> x!Suc i"
  13.184 +apply(induct x,simp)
  13.185 +apply clarify
  13.186 +apply(erule cptn.elims,simp)
  13.187 + apply(case_tac i,simp)
  13.188 +  apply(rule Env)
  13.189 + apply simp
  13.190 + apply(erule_tac x="m - 1" in allE)
  13.191 + apply(case_tac m,simp,simp)
  13.192 + apply(subgoal_tac "(\<forall>i. Suc i < nata \<longrightarrow> (((P, t) # xs) ! i, xs ! i) \<notin> ctran)")
  13.193 +  apply force
  13.194 + apply clarify
  13.195 + apply(erule_tac x="Suc ia" in allE,simp)
  13.196 +apply(erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (?J j) \<notin> ctran" in allE,simp)
  13.197 +done
  13.198 +
  13.199 +lemma etran_or_ctran2 [rule_format]: 
  13.200 +  "\<forall>i. Suc i<length x \<longrightarrow> x\<in>cptn \<longrightarrow> (x!i -c\<rightarrow> x!Suc i \<longrightarrow> \<not> x!i -e\<rightarrow> x!Suc i)
  13.201 +  \<or> (x!i -e\<rightarrow> x!Suc i \<longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i)"
  13.202 +apply(induct x)
  13.203 + apply simp
  13.204 +apply clarify
  13.205 +apply(erule cptn.elims,simp)
  13.206 + apply(case_tac i,simp+)
  13.207 +apply(case_tac i,simp)
  13.208 + apply(force elim:etran.elims)
  13.209 +apply simp
  13.210 +done
  13.211 +
  13.212 +lemma etran_or_ctran2_disjI1: 
  13.213 +  "\<lbrakk> x\<in>cptn; Suc i<length x; x!i -c\<rightarrow> x!Suc i\<rbrakk> \<Longrightarrow> \<not> x!i -e\<rightarrow> x!Suc i"
  13.214 +by(drule etran_or_ctran2,simp_all)
  13.215 +
  13.216 +lemma etran_or_ctran2_disjI2: 
  13.217 +  "\<lbrakk> x\<in>cptn; Suc i<length x; x!i -e\<rightarrow> x!Suc i\<rbrakk> \<Longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i"
  13.218 +by(drule etran_or_ctran2,simp_all)
  13.219 +
  13.220 +lemma not_ctran_None2 [rule_format]: 
  13.221 +  "\<lbrakk> (None, s) # xs \<in>cptn; i<length xs\<rbrakk> \<Longrightarrow> \<not> ((None, s) # xs) ! i -c\<rightarrow> xs ! i"
  13.222 +apply(frule not_ctran_None,simp)
  13.223 +apply(case_tac i,simp)
  13.224 + apply(force elim:etran.elims)
  13.225 +apply simp
  13.226 +apply(rule etran_or_ctran2_disjI2,simp_all)
  13.227 +apply(force intro:tl_of_cptn_is_cptn)
  13.228 +done
  13.229 +
  13.230 +lemma Ex_first_occurrence [rule_format]: "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i<m. \<not> P i))";
  13.231 +apply(rule nat_less_induct)
  13.232 +apply clarify
  13.233 +apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
  13.234 +apply auto
  13.235 +done
  13.236 + 
  13.237 +lemma stability [rule_format]: 
  13.238 +  "\<forall>j k. x \<in> cptn \<longrightarrow> stable p rely \<longrightarrow> j\<le>k \<longrightarrow> k<length x \<longrightarrow> snd(x!j)\<in>p  \<longrightarrow>
  13.239 +  (\<forall>i. (Suc i)<length x \<longrightarrow> (x!i -e\<rightarrow> x!(Suc i)) \<longrightarrow> (snd(x!i), snd(x!(Suc i))) \<in> rely) \<longrightarrow> 
  13.240 +  (\<forall>i. j\<le>i \<and> i<k \<longrightarrow> x!i -e\<rightarrow> x!Suc i) \<longrightarrow> snd(x!k)\<in>p \<and> fst(x!j)=fst(x!k)"
  13.241 +apply(induct x)
  13.242 + apply clarify
  13.243 + apply(force elim:cptn.elims)
  13.244 +apply clarify
  13.245 +apply(erule cptn.elims,simp)
  13.246 + apply simp
  13.247 + apply(case_tac k,simp,simp)
  13.248 + apply(case_tac j,simp) 
  13.249 +  apply(erule_tac x=0 in allE)
  13.250 +  apply(erule_tac x="nat" and P="\<lambda>j. (0\<le>j) \<longrightarrow> (?J j)" in allE,simp)
  13.251 +  apply(subgoal_tac "t\<in>p")
  13.252 +   apply(subgoal_tac "(\<forall>i. i < length xs \<longrightarrow> ((P, t) # xs) ! i -e\<rightarrow> xs ! i \<longrightarrow> (snd (((P, t) # xs) ! i), snd (xs ! i)) \<in> rely)")
  13.253 +    apply clarify
  13.254 +    apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
  13.255 +   apply clarify
  13.256 +   apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
  13.257 +  apply(erule_tac x=0 and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran \<longrightarrow> ?T j" in allE,simp)
  13.258 +  apply(simp(no_asm_use) only:stable_def)
  13.259 +  apply(erule_tac x=s in allE)
  13.260 +  apply(erule_tac x=t in allE)
  13.261 +  apply simp 
  13.262 +  apply(erule mp)
  13.263 +  apply(erule mp)
  13.264 +  apply(rule Env)
  13.265 + apply simp
  13.266 + apply(erule_tac x="nata" in allE)
  13.267 + apply(erule_tac x="nat" and P="\<lambda>j. (?s\<le>j) \<longrightarrow> (?J j)" in allE,simp)
  13.268 + apply(subgoal_tac "(\<forall>i. i < length xs \<longrightarrow> ((P, t) # xs) ! i -e\<rightarrow> xs ! i \<longrightarrow> (snd (((P, t) # xs) ! i), snd (xs ! i)) \<in> rely)")
  13.269 +  apply clarify
  13.270 +  apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
  13.271 + apply clarify
  13.272 + apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
  13.273 +apply(case_tac k,simp,simp)
  13.274 +apply(case_tac j)
  13.275 + apply(erule_tac x=0 and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
  13.276 + apply(erule etran.elims,simp)
  13.277 +apply(erule_tac x="nata" in allE)
  13.278 +apply(erule_tac x="nat" and P="\<lambda>j. (?s\<le>j) \<longrightarrow> (?J j)" in allE,simp)
  13.279 +apply(subgoal_tac "(\<forall>i. i < length xs \<longrightarrow> ((Q, t) # xs) ! i -e\<rightarrow> xs ! i \<longrightarrow> (snd (((Q, t) # xs) ! i), snd (xs ! i)) \<in> rely)")
  13.280 + apply clarify
  13.281 + apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
  13.282 +apply clarify
  13.283 +apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
  13.284 +done
  13.285 +
  13.286 +subsection {* Soundness of the System for Component Programs *}
  13.287 +
  13.288 +subsubsection {* Soundness of the Basic rule *}
  13.289 +
  13.290 +lemma unique_ctran_Basic [rule_format]: 
  13.291 +  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Basic f), s) \<longrightarrow> 
  13.292 +  Suc i<length x \<longrightarrow> x!i -c\<rightarrow> x!Suc i \<longrightarrow> (\<forall>j. Suc j<length x \<longrightarrow> i\<noteq>j \<longrightarrow> x!j -e\<rightarrow> x!Suc j)"
  13.293 +apply(induct x,simp)
  13.294 +apply simp
  13.295 +apply clarify
  13.296 +apply(erule cptn.elims,simp)
  13.297 + apply(case_tac i,simp+)
  13.298 + apply clarify
  13.299 + apply(case_tac j,simp)
  13.300 +  apply(rule Env)
  13.301 + apply simp
  13.302 +apply clarify
  13.303 +apply simp
  13.304 +apply(case_tac i)
  13.305 + apply(case_tac j,simp,simp)
  13.306 + apply(erule ctran.elims,simp_all)
  13.307 + apply(force elim: not_ctran_None)
  13.308 +apply(ind_cases "((Some (Basic f), sa), Q, t) \<in> ctran")
  13.309 +apply simp
  13.310 +apply(drule_tac i=nat in not_ctran_None,simp)
  13.311 +apply(erule etran.elims,simp)
  13.312 +done
  13.313 +
  13.314 +lemma exists_ctran_Basic_None [rule_format]: 
  13.315 +  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Basic f), s) 
  13.316 +  \<longrightarrow> i<length x \<longrightarrow> fst(x!i)=None \<longrightarrow> (\<exists>j<i. x!j -c\<rightarrow> x!Suc j)"
  13.317 +apply(induct x,simp)
  13.318 +apply simp
  13.319 +apply clarify
  13.320 +apply(erule cptn.elims,simp)
  13.321 + apply(case_tac i,simp,simp)
  13.322 + apply(erule_tac x=nat in allE,simp)
  13.323 + apply clarify
  13.324 + apply(rule_tac x="Suc j" in exI,simp,simp)
  13.325 +apply clarify
  13.326 +apply(case_tac i,simp,simp)
  13.327 +apply(rule_tac x=0 in exI,simp)
  13.328 +done
  13.329 +
  13.330 +lemma Basic_sound: 
  13.331 +  " \<lbrakk>pre \<subseteq> {s. f s \<in> post}; {(s, t). s \<in> pre \<and> t = f s} \<subseteq> guar; 
  13.332 +  stable pre rely; stable post rely\<rbrakk>
  13.333 +  \<Longrightarrow> \<Turnstile> Basic f sat [pre, rely, guar, post]"
  13.334 +apply(unfold com_validity_def)
  13.335 +apply clarify
  13.336 +apply(simp add:comm_def)
  13.337 +apply(rule conjI)
  13.338 + apply clarify
  13.339 + apply(simp add:cp_def assum_def)
  13.340 + apply clarify
  13.341 + apply(frule_tac j=0 and k=i and p=pre in stability)
  13.342 +       apply simp_all
  13.343 +   apply(erule_tac x=ia in allE,simp)
  13.344 +  apply(erule_tac i=i and f=f in unique_ctran_Basic,simp_all)
  13.345 + apply(erule subsetD,simp)
  13.346 + apply(case_tac "x!i")
  13.347 + apply clarify
  13.348 + apply(drule_tac s="Some (Basic f)" in sym,simp)
  13.349 + apply(thin_tac "\<forall>j. ?H j")
  13.350 + apply(force elim:ctran.elims)
  13.351 +apply clarify
  13.352 +apply(simp add:cp_def)
  13.353 +apply clarify
  13.354 +apply(frule_tac i="length x - 1" and f=f in exists_ctran_Basic_None,simp+)
  13.355 +  apply(case_tac x,simp+)
  13.356 +  apply(rule last_fst_esp,simp add:last_length)
  13.357 + apply (case_tac x,simp+)
  13.358 +apply(simp add:assum_def)
  13.359 +apply clarify
  13.360 +apply(frule_tac j=0 and k="j" and p=pre in stability)
  13.361 +      apply simp_all
  13.362 +    apply arith
  13.363 +  apply(erule_tac x=i in allE,simp)
  13.364 + apply(erule_tac i=j and f=f in unique_ctran_Basic,simp_all)
  13.365 +  apply arith
  13.366 + apply arith
  13.367 +apply(case_tac "x!j")
  13.368 +apply clarify
  13.369 +apply simp
  13.370 +apply(drule_tac s="Some (Basic f)" in sym,simp)
  13.371 +apply(case_tac "x!Suc j",simp)
  13.372 +apply(rule ctran.elims,simp)
  13.373 +apply(simp_all)
  13.374 +apply(drule_tac c=sa in subsetD,simp)
  13.375 +apply clarify
  13.376 +apply(frule_tac j="Suc j" and k="length x - 1" and p=post in stability,simp_all)
  13.377 + apply(case_tac x,simp+)
  13.378 + apply(erule_tac x=i in allE)
  13.379 +apply(erule_tac i=j and f=f in unique_ctran_Basic,simp_all)
  13.380 +  apply arith+
  13.381 +apply(case_tac x)
  13.382 +apply(simp add:last_length)+
  13.383 +done
  13.384 +
  13.385 +subsubsection{* Soundness of the Await rule *}
  13.386 +
  13.387 +lemma unique_ctran_Await [rule_format]: 
  13.388 +  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Await b c), s) \<longrightarrow> 
  13.389 +  Suc i<length x \<longrightarrow> x!i -c\<rightarrow> x!Suc i \<longrightarrow> (\<forall>j. Suc j<length x \<longrightarrow> i\<noteq>j \<longrightarrow> x!j -e\<rightarrow> x!Suc j)"
  13.390 +apply(induct x,simp+)
  13.391 +apply clarify
  13.392 +apply(erule cptn.elims,simp)
  13.393 + apply(case_tac i,simp+)
  13.394 + apply clarify
  13.395 + apply(case_tac j,simp)
  13.396 +  apply(rule Env)
  13.397 + apply simp
  13.398 +apply clarify
  13.399 +apply simp
  13.400 +apply(case_tac i)
  13.401 + apply(case_tac j,simp,simp)
  13.402 + apply(erule ctran.elims,simp_all)
  13.403 + apply(force elim: not_ctran_None)
  13.404 +apply(ind_cases "((Some (Await b c), sa), Q, t) \<in> ctran",simp)
  13.405 +apply(drule_tac i=nat in not_ctran_None,simp)
  13.406 +apply(erule etran.elims,simp)
  13.407 +done
  13.408 +
  13.409 +lemma exists_ctran_Await_None [rule_format]: 
  13.410 +  "\<forall>s i.  x \<in> cptn \<longrightarrow> x ! 0 = (Some (Await b c), s) 
  13.411 +  \<longrightarrow> i<length x \<longrightarrow> fst(x!i)=None \<longrightarrow> (\<exists>j<i. x!j -c\<rightarrow> x!Suc j)"
  13.412 +apply(induct x,simp+)
  13.413 +apply clarify
  13.414 +apply(erule cptn.elims,simp)
  13.415 + apply(case_tac i,simp+)
  13.416 + apply(erule_tac x=nat in allE,simp)
  13.417 + apply clarify
  13.418 + apply(rule_tac x="Suc j" in exI,simp,simp)
  13.419 +apply clarify
  13.420 +apply(case_tac i,simp,simp)
  13.421 +apply(rule_tac x=0 in exI,simp)
  13.422 +done
  13.423 +
  13.424 +lemma Star_imp_cptn: 
  13.425 +  "(P, s) -c*\<rightarrow> (R, t) \<Longrightarrow> \<exists>l \<in> cp P s. (last l)=(R, t)
  13.426 +  \<and> (\<forall>i. Suc i<length l \<longrightarrow> l!i -c\<rightarrow> l!Suc i)"
  13.427 +apply (erule converse_rtrancl_induct2)
  13.428 + apply(rule_tac x="[(R,t)]" in bexI)
  13.429 +  apply simp
  13.430 + apply(simp add:cp_def)
  13.431 + apply(rule CptnOne)
  13.432 +apply clarify
  13.433 +apply(rule_tac x="(a, b)#l" in bexI)
  13.434 + apply (rule conjI)
  13.435 +  apply(case_tac l,simp add:cp_def)
  13.436 +  apply(simp add:last_length)
  13.437 + apply clarify
  13.438 +apply(case_tac i,simp)
  13.439 +apply(simp add:cp_def)
  13.440 +apply force
  13.441 +apply(simp add:cp_def)
  13.442 + apply(case_tac l)
  13.443 + apply(force elim:cptn.elims)
  13.444 +apply simp
  13.445 +apply(erule CptnComp)
  13.446 +apply clarify
  13.447 +done
  13.448 + 
  13.449 +lemma Await_sound: 
  13.450 +  "\<lbrakk>stable pre rely; stable post rely;
  13.451 +  \<forall>V. \<turnstile> P sat [pre \<inter> b \<inter> {s. s = V}, {(s, t). s = t}, UNIV, {s. (V, s) \<in> guar} \<inter> post] \<and>
  13.452 +  \<Turnstile> P sat [pre \<inter> b \<inter> {s. s = V}, {(s, t). s = t}, UNIV, {s. (V, s) \<in> guar} \<inter> post] \<rbrakk>
  13.453 +  \<Longrightarrow> \<Turnstile> Await b P sat [pre, rely, guar, post]"
  13.454 +apply(unfold com_validity_def)
  13.455 +apply clarify
  13.456 +apply(simp add:comm_def)
  13.457 +apply(rule conjI)
  13.458 + apply clarify
  13.459 + apply(simp add:cp_def assum_def)
  13.460 + apply clarify
  13.461 + apply(frule_tac j=0 and k=i and p=pre in stability,simp_all)
  13.462 +   apply(erule_tac x=ia in allE,simp)
  13.463 +  apply(subgoal_tac "x\<in> cp (Some(Await b P)) s")
  13.464 +  apply(erule_tac i=i in unique_ctran_Await,force,simp_all)
  13.465 +  apply(simp add:cp_def)
  13.466 +--{* here starts the different part. *}
  13.467 + apply(erule ctran.elims,simp_all)
  13.468 + apply(drule Star_imp_cptn) 
  13.469 + apply clarify
  13.470 + apply(erule_tac x=sa in allE)
  13.471 + apply clarify
  13.472 + apply(erule_tac x=sa in allE)
  13.473 + apply(drule_tac c=l in subsetD)
  13.474 +  apply (simp add:cp_def)
  13.475 +  apply clarify
  13.476 +  apply(erule_tac x=ia and P="\<lambda>i. ?H i \<longrightarrow> (?J i,?I i)\<in>ctran" in allE,simp)
  13.477 +  apply(erule etran.elims,simp)
  13.478 + apply simp
  13.479 +apply clarify
  13.480 +apply(simp add:cp_def)
  13.481 +apply clarify
  13.482 +apply(frule_tac i="length x - 1" in exists_ctran_Await_None,force)
  13.483 +  apply (case_tac x,simp+)
  13.484 + apply(rule last_fst_esp,simp add:last_length)
  13.485 + apply(case_tac x, (simp add:cptn_not_empty)+)
  13.486 +apply clarify
  13.487 +apply(simp add:assum_def)
  13.488 +apply clarify
  13.489 +apply(frule_tac j=0 and k="j" and p=pre in stability,simp_all)
  13.490 +   apply arith
  13.491 +  apply(erule_tac x=i in allE,simp)
  13.492 + apply(erule_tac i=j in unique_ctran_Await,force,simp_all)
  13.493 +  apply arith
  13.494 + apply arith
  13.495 +apply(case_tac "x!j")
  13.496 +apply clarify
  13.497 +apply simp
  13.498 +apply(drule_tac s="Some (Await b P)" in sym,simp)
  13.499 +apply(case_tac "x!Suc j",simp)
  13.500 +apply(rule ctran.elims,simp)
  13.501 +apply(simp_all)
  13.502 +apply(drule Star_imp_cptn) 
  13.503 +apply clarify
  13.504 +apply(erule_tac x=sa in allE)
  13.505 +apply clarify
  13.506 +apply(erule_tac x=sa in allE)
  13.507 +apply(drule_tac c=l in subsetD)
  13.508 + apply (simp add:cp_def)
  13.509 + apply clarify
  13.510 + apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> (?J i,?I i)\<in>ctran" in allE,simp)
  13.511 + apply(erule etran.elims,simp)
  13.512 +apply simp
  13.513 +apply clarify
  13.514 +apply(frule_tac j="Suc j" and k="length x - 1" and p=post in stability,simp_all)
  13.515 + apply(case_tac x,simp+)
  13.516 + apply(erule_tac x=i in allE)
  13.517 +apply(erule_tac i=j in unique_ctran_Await,force,simp_all)
  13.518 + apply arith+
  13.519 +apply(case_tac x)
  13.520 +apply(simp add:last_length)+
  13.521 +done
  13.522 +
  13.523 +subsubsection{* Soundness of the Conditional rule *}
  13.524 +
  13.525 +lemma last_length2 [rule_format]: "xs\<noteq>[] \<longrightarrow> (last xs)=(xs!(length xs - (Suc 0)))"
  13.526 +apply(induct xs,simp+)
  13.527 +apply(case_tac "length list",simp+)
  13.528 +done
  13.529 +
  13.530 +lemma last_drop: "Suc m<length x \<Longrightarrow> last(drop (Suc m) x) = last x"
  13.531 +apply(case_tac "(drop (Suc m) x)\<noteq>[]")
  13.532 + apply(drule last_length2)
  13.533 + apply(erule ssubst)
  13.534 + apply(simp only:length_drop)
  13.535 + apply(subgoal_tac "Suc m + (length x - Suc m - (Suc 0)) \<le> length x")
  13.536 +  apply(simp only:nth_drop)
  13.537 +  apply(case_tac "x\<noteq>[]")
  13.538 +   apply(drule last_length2)
  13.539 +   apply(erule ssubst)
  13.540 +   apply simp
  13.541 +   apply(subgoal_tac "Suc (length x - 2)=(length x - Suc 0)")
  13.542 +    apply simp
  13.543 +   apply arith
  13.544 +  apply simp
  13.545 + apply arith
  13.546 +apply (simp add:length_greater_0_conv [THEN sym])
  13.547 +done
  13.548 +
  13.549 +lemma Cond_sound: 
  13.550 +  "\<lbrakk> stable pre rely; \<Turnstile> P1 sat [pre \<inter> b, rely, guar, post]; 
  13.551 +  \<Turnstile> P2 sat [pre \<inter> - b, rely, guar, post]; \<forall>s. (s,s)\<in>guar\<rbrakk>
  13.552 +  \<Longrightarrow> \<Turnstile> (Cond b P1 P2) sat [pre, rely, guar, post]"
  13.553 +apply(unfold com_validity_def)
  13.554 +apply clarify
  13.555 +apply(simp add:cp_def comm_def)
  13.556 +apply(case_tac "\<exists>i. Suc i<length x \<and> x!i -c\<rightarrow> x!Suc i")
  13.557 + prefer 2
  13.558 + apply simp
  13.559 + apply clarify
  13.560 + apply(frule_tac j="0" and k="length x - 1" and p=pre in stability,simp+)
  13.561 +     apply(case_tac x,simp+)
  13.562 +    apply(simp add:assum_def)
  13.563 +   apply(simp add:assum_def)
  13.564 +  apply(erule_tac m="length x" in etran_or_ctran,simp+)
  13.565 +  apply(case_tac x,simp+)
  13.566 + apply(case_tac x, (simp add:last_length)+)
  13.567 +apply(erule exE)
  13.568 +apply(drule_tac n=i and P="\<lambda>i. ?H i \<and> (?J i,?I i)\<in> ctran" in Ex_first_occurrence)
  13.569 +apply clarify
  13.570 +apply (simp add:assum_def)
  13.571 +apply(frule_tac j=0 and k="m" and p=pre in stability,simp+)
  13.572 + apply(erule_tac m="Suc m" in etran_or_ctran,simp+)
  13.573 +apply(erule ctran.elims,simp_all)
  13.574 + apply(erule_tac x="sa" in allE)
  13.575 + apply(drule_tac c="drop (Suc m) x" in subsetD)
  13.576 +  apply simp
  13.577 +  apply(rule conjI)
  13.578 +   apply force
  13.579 +  apply clarify
  13.580 +  apply(subgoal_tac "(Suc m) + i \<le> length x")
  13.581 +   apply(subgoal_tac "(Suc m) + (Suc i) \<le> length x")
  13.582 +    apply(rotate_tac -2)
  13.583 +    apply simp
  13.584 +    apply(erule_tac x="Suc (m + i)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE)
  13.585 +    apply(subgoal_tac "Suc (Suc (m + i)) < length x",simp)
  13.586 +    apply arith
  13.587 +   apply arith
  13.588 +  apply arith
  13.589 + apply simp
  13.590 + apply(rule conjI)
  13.591 +  apply clarify
  13.592 +  apply(case_tac "i\<le>m")
  13.593 +   apply(drule le_imp_less_or_eq)
  13.594 +   apply(erule disjE)
  13.595 +    apply(erule_tac x=i in allE, erule impE, assumption)
  13.596 +    apply simp+
  13.597 +  apply(erule_tac x="i - (Suc m)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> (?I j)\<in>guar" in allE)
  13.598 +  apply(subgoal_tac "(Suc m)+(i - Suc m) \<le> length x")
  13.599 +   apply(subgoal_tac "(Suc m)+Suc (i - Suc m) \<le> length x")
  13.600 +    apply(rotate_tac -2)
  13.601 +    apply simp
  13.602 +    apply(erule mp)
  13.603 +    apply arith
  13.604 +   apply arith
  13.605 +  apply arith
  13.606 + apply(simp add:last_drop)
  13.607 +apply(case_tac "length (drop (Suc m) x)",simp)
  13.608 +apply(erule_tac x="sa" in allE)
  13.609 +back
  13.610 +apply(drule_tac c="drop (Suc m) x" in subsetD,simp)
  13.611 + apply(rule conjI)
  13.612 +  apply force
  13.613 + apply clarify
  13.614 + apply(subgoal_tac "(Suc m) + i \<le> length x")
  13.615 +  apply(subgoal_tac "(Suc m) + (Suc i) \<le> length x")
  13.616 +   apply(rotate_tac -2)
  13.617 +   apply simp
  13.618 +   apply(erule_tac x="Suc (m + i)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE)
  13.619 +   apply(subgoal_tac "Suc (Suc (m + i)) < length x")
  13.620 +    apply simp
  13.621 +   apply arith
  13.622 +  apply arith
  13.623 + apply arith
  13.624 +apply simp
  13.625 +apply clarify
  13.626 +apply(rule conjI)
  13.627 + apply clarify
  13.628 + apply(case_tac "i\<le>m")
  13.629 +  apply(drule le_imp_less_or_eq)
  13.630 +  apply(erule disjE)
  13.631 +   apply(erule_tac x=i in allE, erule impE, assumption)
  13.632 +   apply simp
  13.633 +  apply simp
  13.634 + apply(erule_tac x="i - (Suc m)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> (?I j)\<in>guar" in allE)
  13.635 + apply(subgoal_tac "(Suc m)+(i - Suc m) \<le> length x")
  13.636 +  apply(subgoal_tac "(Suc m)+Suc (i - Suc m) \<le> length x")
  13.637 +   apply(rotate_tac -2)
  13.638 +   apply simp
  13.639 +   apply(erule mp)
  13.640 +   apply arith
  13.641 +  apply arith
  13.642 + apply arith
  13.643 +apply(simp add:last_drop)
  13.644 +done  
  13.645 +
  13.646 +subsubsection{* Soundness of the Sequential rule *}
  13.647 +
  13.648 +inductive_cases Seq_cases [elim!]: "(Some (Seq P Q), s) -c\<rightarrow> t"
  13.649 +
  13.650 +lemma last_lift_not_None: "fst ((lift Q) ((x#xs)!(length xs))) \<noteq> None"
  13.651 +apply(subgoal_tac "length xs<length (x # xs)")
  13.652 + apply(drule_tac Q=Q in  lift_nth)
  13.653 + apply(erule ssubst)
  13.654 + apply (simp add:lift_def)
  13.655 + apply(case_tac "(x # xs) ! length xs",simp)
  13.656 +apply simp
  13.657 +done
  13.658 +
  13.659 +lemma Seq_sound1 [rule_format]: 
  13.660 +  "x\<in> cptn_mod \<Longrightarrow> \<forall>s P. x !0=(Some (Seq P Q), s) \<longrightarrow> 
  13.661 +  (\<forall>i<length x. fst(x!i)\<noteq>Some Q) \<longrightarrow> 
  13.662 +  (\<exists>xs\<in> cp (Some P) s. x=map (lift Q) xs)"
  13.663 +apply(erule cptn_mod.induct)
  13.664 +apply(unfold cp_def)
  13.665 +apply safe
  13.666 +apply simp_all
  13.667 +    apply(simp add:lift_def)
  13.668 +    apply(rule_tac x="[(Some Pa, sa)]" in exI,simp add:CptnOne)
  13.669 +   apply(subgoal_tac "(\<forall>i < Suc (length xs). fst (((Some (Seq Pa Q), t) # xs) ! i) \<noteq> Some Q)")
  13.670 +    apply clarify
  13.671 +    apply(case_tac xsa,simp,simp)
  13.672 +    apply(rule_tac x="(Some Pa, sa) #(Some Pa, t) # list" in exI,simp)
  13.673 +    apply(rule conjI,erule CptnEnv)
  13.674 +    apply(simp add:lift_def)
  13.675 +   apply clarify
  13.676 +   apply(erule_tac x="Suc i" in allE, simp)
  13.677 +  apply(ind_cases "((Some (Seq Pa Q), sa), None, t) \<in> ctran")
  13.678 + apply(rule_tac x="(Some P, sa) # xs" in exI, simp add:cptn_iff_cptn_mod lift_def)
  13.679 +apply(erule_tac x="length xs" in allE, simp)
  13.680 +apply(simp only:Cons_lift_append)
  13.681 +apply(subgoal_tac "length xs < length ((Some P, sa) # xs)")
  13.682 + apply(simp only :nth_append length_map last_length nth_map)
  13.683 + apply(case_tac "last((Some P, sa) # xs)")
  13.684 + apply(simp add:lift_def)
  13.685 +apply simp
  13.686 +done
  13.687 +
  13.688 +lemma Seq_sound2 [rule_format]: 
  13.689 +  "x \<in> cptn \<Longrightarrow> \<forall>s P i. x!0=(Some (Seq P Q), s) \<longrightarrow> i<length x \<longrightarrow> fst(x!i)=Some Q \<longrightarrow>
  13.690 +  (\<forall>j<i. fst(x!j)\<noteq>(Some Q)) \<longrightarrow>
  13.691 +  (\<exists>xs ys. xs \<in> cp (Some P) s \<and> length xs=Suc i \<and> ys \<in> cp (Some Q) (snd(xs !i)) \<and> x=(map (lift Q) xs)@tl ys)"
  13.692 +apply(erule cptn.induct)
  13.693 +apply(unfold cp_def)
  13.694 +apply safe
  13.695 +apply simp_all
  13.696 + apply(case_tac i,simp+)
  13.697 + apply(erule allE,erule impE,assumption,simp)
  13.698 + apply clarify
  13.699 + apply(subgoal_tac "(\<forall>j < nat. fst (((Some (Seq Pa Q), t) # xs) ! j) \<noteq> Some Q)",clarify)
  13.700 +  prefer 2
  13.701 +  apply force
  13.702 + apply(case_tac xsa,simp,simp)
  13.703 + apply(rule_tac x="(Some Pa, sa) #(Some Pa, t) # list" in exI,simp)
  13.704 + apply(rule conjI,erule CptnEnv)
  13.705 + apply(simp add:lift_def)
  13.706 + apply(rule_tac x=ys in exI,simp)
  13.707 +apply(ind_cases "((Some (Seq Pa Q), sa), t) \<in> ctran")
  13.708 + apply simp
  13.709 + apply(rule_tac x="(Some Pa, sa)#[(None, ta)]" in exI,simp)
  13.710 + apply(rule conjI)
  13.711 +  apply(drule_tac xs="[]" in CptnComp,force simp add:CptnOne,simp)
  13.712 + apply(case_tac i, simp+)
  13.713 + apply(case_tac nat,simp+)
  13.714 + apply(rule_tac x="(Some Q,ta)#xs" in exI,simp add:lift_def)
  13.715 + apply(case_tac nat,simp+)
  13.716 + apply(force)
  13.717 +apply(case_tac i, simp+)
  13.718 +apply(case_tac nat,simp+)
  13.719 +apply(erule_tac x="Suc nata" in allE,simp)
  13.720 +apply clarify
  13.721 +apply(subgoal_tac "(\<forall>j<Suc nata. fst (((Some (Seq P2 Q), ta) # xs) ! j) \<noteq> Some Q)",clarify)
  13.722 + prefer 2
  13.723 + apply clarify
  13.724 + apply force
  13.725 +apply(rule_tac x="(Some Pa, sa)#(Some P2, ta)#(tl xsa)" in exI,simp)
  13.726 +apply(rule conjI,erule CptnComp)
  13.727 +apply(rule nth_tl_if,force,simp+)
  13.728 +apply(rule_tac x=ys in exI,simp)
  13.729 +apply(rule conjI)
  13.730 +apply(rule nth_tl_if,force,simp+)
  13.731 + apply(rule tl_zero,simp+)
  13.732 + apply force
  13.733 +apply(rule conjI,simp add:lift_def)
  13.734 +apply(subgoal_tac "lift Q (Some P2, ta) =(Some (Seq P2 Q), ta)") 
  13.735 + apply(simp add:Cons_lift del:map.simps)
  13.736 + apply(rule nth_tl_if)
  13.737 +   apply force
  13.738 +  apply simp+
  13.739 +apply(simp add:lift_def)
  13.740 +done
  13.741 +(*
  13.742 +lemma last_lift_not_None3: "fst (last (map (lift Q) (x#xs))) \<noteq> None"
  13.743 +apply(simp only:last_length [THEN sym])
  13.744 +apply(subgoal_tac "length xs<length (x # xs)")
  13.745 + apply(drule_tac Q=Q in  lift_nth)
  13.746 + apply(erule ssubst)
  13.747 + apply (simp add:lift_def)
  13.748 + apply(case_tac "(x # xs) ! length xs",simp)
  13.749 +apply simp
  13.750 +done
  13.751 +*)
  13.752 +
  13.753 +lemma last_lift_not_None2: "fst ((lift Q) (last (x#xs))) \<noteq> None"
  13.754 +apply(simp only:last_length [THEN sym])
  13.755 +apply(subgoal_tac "length xs<length (x # xs)")
  13.756 + apply(drule_tac Q=Q in  lift_nth)
  13.757 + apply(erule ssubst)
  13.758 + apply (simp add:lift_def)
  13.759 + apply(case_tac "(x # xs) ! length xs",simp)
  13.760 +apply simp
  13.761 +done
  13.762 +
  13.763 +lemma last_lift_not_None: "fst ((lift Q) ((x#xs)!(length xs))) \<noteq> None"
  13.764 +apply(subgoal_tac "length xs<length (x # xs)")
  13.765 + apply(drule_tac Q=Q in  lift_nth)
  13.766 + apply(erule ssubst)
  13.767 + apply (simp add:lift_def)
  13.768 + apply(case_tac "(x # xs) ! length xs",simp)
  13.769 +apply simp
  13.770 +done
  13.771 +
  13.772 +lemma Seq_sound: 
  13.773 +  "\<lbrakk>\<Turnstile> P sat [pre, rely, guar, mid]; \<Turnstile> Q sat [mid, rely, guar, post]\<rbrakk>
  13.774 +  \<Longrightarrow> \<Turnstile> Seq P Q sat [pre, rely, guar, post]"
  13.775 +apply(unfold com_validity_def)
  13.776 +apply clarify
  13.777 +apply(case_tac "\<exists>i<length x. fst(x!i)=Some Q")
  13.778 + prefer 2
  13.779 + apply (simp add:cp_def cptn_iff_cptn_mod)
  13.780 + apply clarify
  13.781 + apply(frule_tac Seq_sound1,force)
  13.782 +  apply force
  13.783 + apply clarify
  13.784 + apply(erule_tac x=s in allE,simp)
  13.785 + apply(drule_tac c=xs in subsetD,simp add:cp_def cptn_iff_cptn_mod)
  13.786 +  apply(simp add:assum_def)
  13.787 +  apply clarify
  13.788 +  apply(erule_tac P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE,erule impE, assumption)
  13.789 +  apply(simp add:snd_lift)
  13.790 +  apply(erule mp)
  13.791 +  apply(force elim:etran.elims intro:Env simp add:lift_def)
  13.792 + apply(simp add:comm_def)
  13.793 + apply(rule conjI)
  13.794 +  apply clarify
  13.795 +  apply(erule_tac P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE,erule impE, assumption)
  13.796 +  apply(simp add:snd_lift)
  13.797 +  apply(erule mp)
  13.798 +  apply(case_tac "(xs!i)")
  13.799 +  apply(case_tac "(xs! Suc i)")
  13.800 +  apply(case_tac "fst(xs!i)")
  13.801 +   apply(erule_tac x=i in allE, simp add:lift_def)
  13.802 +  apply(case_tac "fst(xs!Suc i)")
  13.803 +   apply(force simp add:lift_def)
  13.804 +  apply(force simp add:lift_def)
  13.805 + apply clarify
  13.806 + apply(case_tac xs,simp add:cp_def)
  13.807 + apply clarify
  13.808 + apply (simp del:map.simps)
  13.809 + apply(subgoal_tac "(map (lift Q) ((a, b) # list))\<noteq>[]")
  13.810 +  apply(drule last_length2)
  13.811 +  apply (simp del:map.simps)
  13.812 +  apply(simp only:last_lift_not_None)
  13.813 + apply simp
  13.814 +--{* @{text "\<exists>i<length x. fst (x ! i) = Some Q"} *}
  13.815 +apply(erule exE)
  13.816 +apply(drule_tac n=i and P="\<lambda>i. i < length x \<and> fst (x ! i) = Some Q" in Ex_first_occurrence)
  13.817 +apply clarify
  13.818 +apply (simp add:cp_def)
  13.819 + apply clarify
  13.820 + apply(frule_tac i=m in Seq_sound2,force)
  13.821 +  apply simp+
  13.822 +apply clarify
  13.823 +apply(simp add:comm_def)
  13.824 +apply(erule_tac x=s in allE)
  13.825 +apply(drule_tac c=xs in subsetD,simp)
  13.826 + apply(case_tac "xs=[]",simp)
  13.827 + apply(simp add:cp_def assum_def nth_append)
  13.828 + apply clarify
  13.829 + apply(erule_tac x=i in allE)
  13.830 +  back 
  13.831 + apply(simp add:snd_lift)
  13.832 + apply(erule mp)
  13.833 + apply(force elim:etran.elims intro:Env simp add:lift_def)
  13.834 +apply simp
  13.835 +apply clarify
  13.836 +apply(erule_tac x="snd(xs!m)" in allE)
  13.837 +apply(drule_tac c=ys in subsetD,simp add:cp_def assum_def)
  13.838 + apply(case_tac "xs\<noteq>[]")
  13.839 + apply(drule last_length2,simp)
  13.840 + apply(rule conjI)
  13.841 +  apply(erule mp)
  13.842 +  apply(case_tac "xs!m")
  13.843 +  apply(case_tac "fst(xs!m)",simp)
  13.844 +  apply(simp add:lift_def nth_append)
  13.845 + apply clarify
  13.846 + apply(erule_tac x="m+i" in allE)
  13.847 + back
  13.848 + back
  13.849 + apply(case_tac ys,(simp add:nth_append)+)
  13.850 + apply (case_tac i, (simp add:snd_lift)+)
  13.851 +  apply(erule mp)
  13.852 +  apply(case_tac "xs!m")
  13.853 +  apply(force elim:etran.elims intro:Env simp add:lift_def)
  13.854 + apply simp 
  13.855 +apply simp
  13.856 +apply clarify
  13.857 +apply(rule conjI,clarify)
  13.858 + apply(case_tac "i<m",simp add:nth_append)
  13.859 +  apply(simp add:snd_lift)
  13.860 +  apply(erule allE, erule impE, assumption, erule mp)
  13.861 +  apply(case_tac "(xs ! i)")
  13.862 +  apply(case_tac "(xs ! Suc i)")   
  13.863 +  apply(case_tac "fst(xs ! i)",force simp add:lift_def)   
  13.864 +  apply(case_tac "fst(xs ! Suc i)")
  13.865 +   apply (force simp add:lift_def)
  13.866 +  apply (force simp add:lift_def)
  13.867 + apply(erule_tac x="i-m" in allE) 
  13.868 + back
  13.869 + back
  13.870 + apply(subgoal_tac "Suc (i - m) < length ys",simp)
  13.871 +  prefer 2
  13.872 +  apply arith
  13.873 + apply(simp add:nth_append snd_lift)
  13.874 + apply(rule conjI,clarify)
  13.875 +  apply(subgoal_tac "i=m")
  13.876 +   prefer 2
  13.877 +   apply arith
  13.878 +  apply clarify
  13.879 +  apply(simp add:cp_def)
  13.880 +  apply(rule tl_zero)
  13.881 +    apply(erule mp)
  13.882 +    apply(case_tac "lift Q (xs!m)",simp add:snd_lift)
  13.883 +    apply(case_tac "xs!m",case_tac "fst(xs!m)",simp add:lift_def snd_lift)
  13.884 +     apply(case_tac ys,simp+)
  13.885 +    apply(simp add:lift_def)
  13.886 +   apply simp 
  13.887 +  apply force
  13.888 + apply clarify
  13.889 + apply(rule tl_zero)
  13.890 +   apply(rule tl_zero)
  13.891 +     apply (subgoal_tac "i-m=Suc(i-Suc m)")
  13.892 +      apply simp
  13.893 +      apply(erule mp)
  13.894 +      apply(case_tac ys,simp+)
  13.895 +     apply arith
  13.896 +    apply arith
  13.897 +   apply force
  13.898 +  apply arith
  13.899 + apply force
  13.900 +apply clarify
  13.901 +apply(case_tac "(map (lift Q) xs @ tl ys)\<noteq>[]")
  13.902 + apply(drule last_length2)
  13.903 + apply(simp add: snd_lift nth_append)
  13.904 + apply(rule conjI,clarify)
  13.905 +  apply(case_tac ys,simp+)
  13.906 + apply clarify
  13.907 + apply(case_tac ys,simp+)
  13.908 + apply(drule last_length2,simp)
  13.909 +apply simp
  13.910 +done
  13.911 +
  13.912 +subsubsection{* Soundness of the While rule *}
  13.913 +
  13.914 +lemma assum_after_body: 
  13.915 +  "\<lbrakk> \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; 
  13.916 +  (Some P, s) # xs \<in> cptn_mod; fst (((Some P, s) # xs)!length xs) = None; s \<in> b;
  13.917 +  (Some (While b P), s) # (Some (Seq P (While b P)), s) # map (lift (While b P)) xs @ ys \<in> assum (pre, rely)\<rbrakk>
  13.918 +  \<Longrightarrow> (Some (While b P), snd (((Some P, s) # xs)!length xs)) # ys \<in> assum (pre, rely)"
  13.919 +apply(simp add:assum_def com_validity_def cp_def cptn_iff_cptn_mod)
  13.920 +apply clarify
  13.921 +apply(erule_tac x=s in allE)
  13.922 +apply(drule_tac c="(Some P, s) # xs" in subsetD,simp)
  13.923 + apply clarify
  13.924 + apply(erule_tac x="Suc i" in allE)
  13.925 + apply simp
  13.926 + apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
  13.927 + apply(erule mp)
  13.928 + apply(erule etran.elims,simp)
  13.929 + apply(case_tac "fst(((Some P, s) # xs) ! i)")
  13.930 +  apply(force intro:Env simp add:lift_def)
  13.931 + apply(force intro:Env simp add:lift_def)
  13.932 +apply(rule conjI)
  13.933 + apply(simp add:comm_def last_length)
  13.934 +apply clarify
  13.935 +apply(erule_tac x="Suc(length xs + i)" in allE,simp)
  13.936 +apply(case_tac i, simp add:nth_append Cons_lift_append snd_lift del:map.simps)
  13.937 + apply(erule mp)
  13.938 + apply(case_tac "((Some P, s) # xs) ! length xs")
  13.939 + apply(simp add:lift_def)
  13.940 +apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
  13.941 +done
  13.942 +
  13.943 +lemma last_append[rule_format]:
  13.944 +  "\<forall>xs. ys\<noteq>[] \<longrightarrow> ((xs@ys)!(length (xs@ys) - (Suc 0)))=(ys!(length ys - (Suc 0)))"
  13.945 +apply(induct ys)
  13.946 + apply simp
  13.947 +apply clarify
  13.948 +apply (simp add:nth_append length_append)
  13.949 +done
  13.950 +
  13.951 +lemma assum_after_body: 
  13.952 +  "\<lbrakk> \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; 
  13.953 +  (Some P, s) # xs \<in> cptn_mod; fst (last ((Some P, s) # xs)) = None; s \<in> b;
  13.954 +  (Some (While b P), s) # (Some (Seq P (While b P)), s) # map (lift (While b P)) xs @ ys 
  13.955 +   \<in> assum (pre, rely)\<rbrakk>
  13.956 +  \<Longrightarrow> (Some (While b P), snd (last ((Some P, s) # xs))) # ys \<in> assum (pre, rely)"
  13.957 +apply(simp add:assum_def com_validity_def cp_def cptn_iff_cptn_mod)
  13.958 +apply clarify
  13.959 +apply(erule_tac x=s in allE)
  13.960 +apply(drule_tac c="(Some P, s) # xs" in subsetD,simp)
  13.961 + apply clarify
  13.962 + apply(erule_tac x="Suc i" in allE)
  13.963 + apply simp
  13.964 + apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
  13.965 + apply(erule mp)
  13.966 + apply(erule etran.elims,simp)
  13.967 + apply(case_tac "fst(((Some P, s) # xs) ! i)")
  13.968 +  apply(force intro:Env simp add:lift_def)
  13.969 + apply(force intro:Env simp add:lift_def)
  13.970 +apply(rule conjI)
  13.971 + apply clarify
  13.972 + apply(simp add:comm_def last_length)
  13.973 +apply clarify
  13.974 +apply(rule conjI)
  13.975 + apply(simp add:comm_def)
  13.976 +apply clarify
  13.977 +apply(erule_tac x="Suc(length xs + i)" in allE,simp)
  13.978 +apply(case_tac i, simp add:nth_append Cons_lift_append snd_lift del:map.simps)
  13.979 + apply(simp add:last_length)
  13.980 + apply(erule mp)
  13.981 + apply(case_tac "last xs")
  13.982 + apply(simp add:lift_def)
  13.983 +apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
  13.984 +done
  13.985 +
  13.986 +lemma last_append2:"ys\<noteq>[] \<Longrightarrow> last (xs@ys)=(last ys)"
  13.987 +apply(frule last_length2)
  13.988 +apply simp
  13.989 +apply(subgoal_tac "xs@ys\<noteq>[]")
  13.990 +apply(drule last_length2)
  13.991 +back
  13.992 +apply simp
  13.993 +apply(drule_tac xs=xs in last_append)
  13.994 +apply simp
  13.995 +apply simp
  13.996 +done
  13.997 +
  13.998 +lemma While_sound_aux [rule_format]: 
  13.999 +  "\<lbrakk> pre \<inter> - b \<subseteq> post; \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s, s) \<in> guar;
 13.1000 +   stable pre rely;  stable post rely; x \<in> cptn_mod \<rbrakk> 
 13.1001 +  \<Longrightarrow>  \<forall>s xs. x=(Some(While b P),s)#xs \<longrightarrow> x\<in>assum(pre, rely) \<longrightarrow> x \<in> comm (guar, post)"
 13.1002 +apply(erule cptn_mod.induct)
 13.1003 +apply safe
 13.1004 +apply (simp_all del:last.simps)
 13.1005 +--{* 5 subgoals left *}
 13.1006 +apply(simp add:comm_def)
 13.1007 +--{* 4 subgoals left *}
 13.1008 +apply(rule etran_in_comm)
 13.1009 +apply(erule mp)
 13.1010 +apply(erule tl_of_assum_in_assum,simp)
 13.1011 +--{* While-None *}
 13.1012 +apply(ind_cases "((Some (While b P), s), None, t) \<in> ctran")
 13.1013 +apply(simp add:comm_def)
 13.1014 +apply(simp add:cptn_iff_cptn_mod [THEN sym])
 13.1015 +apply(rule conjI,clarify)
 13.1016 + apply(force simp add:assum_def)
 13.1017 +apply clarify
 13.1018 +apply(rule conjI, clarify)
 13.1019 + apply(case_tac i,simp,simp)
 13.1020 + apply(force simp add:not_ctran_None2)
 13.1021 +apply(subgoal_tac "\<forall>i. Suc i < length ((None, sa) # xs) \<longrightarrow> (((None, sa) # xs) ! i, ((None, sa) # xs) ! Suc i)\<in> etran")
 13.1022 + prefer 2
 13.1023 + apply clarify
 13.1024 + apply(rule_tac m="length ((None, s) # xs)" in etran_or_ctran,simp+)
 13.1025 + apply(erule not_ctran_None2,simp)
 13.1026 + apply simp+
 13.1027 +apply(frule_tac j="0" and k="length ((None, s) # xs) - 1" and p=post in stability,simp+)
 13.1028 +   apply(force simp add:assum_def subsetD)
 13.1029 +  apply(simp add:assum_def)
 13.1030 +  apply clarify
 13.1031 +  apply(erule_tac x="i" in allE,simp) 
 13.1032 +  apply(erule_tac x="Suc i" in allE,simp) 
 13.1033 + apply simp
 13.1034 +apply clarify
 13.1035 +apply (simp add:last_length)
 13.1036 +--{* WhileOne *}
 13.1037 +apply(thin_tac "P = While b P \<longrightarrow> ?Q")
 13.1038 +apply(rule ctran_in_comm,simp)
 13.1039 +apply(simp add:Cons_lift del:map.simps)
 13.1040 +apply(simp add:comm_def del:map.simps)
 13.1041 +apply(rule conjI)
 13.1042 + apply clarify
 13.1043 + apply(case_tac "fst(((Some P, sa) # xs) ! i)")
 13.1044 +  apply(case_tac "((Some P, sa) # xs) ! i")
 13.1045 +  apply (simp add:lift_def)
 13.1046 +  apply(ind_cases "(Some (While b P), ba) -c\<rightarrow> t")
 13.1047 +   apply simp
 13.1048 +  apply simp
 13.1049 + apply(simp add:snd_lift del:map.simps)
 13.1050 + apply(simp only:com_validity_def cp_def cptn_iff_cptn_mod)
 13.1051 + apply(erule_tac x=sa in allE)
 13.1052 + apply(drule_tac c="(Some P, sa) # xs" in subsetD)
 13.1053 +  apply (simp add:assum_def del:map.simps)
 13.1054 +  apply clarify
 13.1055 +  apply(erule_tac x="Suc ia" in allE,simp add:snd_lift del:map.simps)
 13.1056 +  apply(erule mp)
 13.1057 +  apply(case_tac "fst(((Some P, sa) # xs) ! ia)")
 13.1058 +   apply(erule etran.elims,simp add:lift_def)
 13.1059 +   apply(rule Env)
 13.1060 +  apply(erule etran.elims,simp add:lift_def)
 13.1061 +  apply(rule Env)
 13.1062 + apply (simp add:comm_def del:map.simps)
 13.1063 + apply clarify
 13.1064 + apply(erule allE,erule impE,assumption)
 13.1065 + apply(erule mp)
 13.1066 + apply(case_tac "((Some P, sa) # xs) ! i")
 13.1067 + apply(case_tac "xs!i")
 13.1068 + apply(simp add:lift_def)
 13.1069 + apply(case_tac "fst(xs!i)")
 13.1070 +  apply force
 13.1071 + apply force
 13.1072 +--{* last=None *}
 13.1073 +apply clarify
 13.1074 +apply(subgoal_tac "(map (lift (While b P)) ((Some P, sa) # xs))\<noteq>[]")
 13.1075 + apply(drule last_length2)
 13.1076 + apply (simp del:map.simps)
 13.1077 + apply(simp only:last_lift_not_None)
 13.1078 +apply simp
 13.1079 +--{* WhileMore *}
 13.1080 +apply(thin_tac "P = While b P \<longrightarrow> ?Q")
 13.1081 +apply(rule ctran_in_comm,simp del:last.simps)
 13.1082 +--{* metiendo la hipotesis antes de dividir la conclusion. *}
 13.1083 +apply(subgoal_tac "(Some (While b P), snd (last ((Some P, sa) # xs))) # ys \<in> assum (pre, rely)")
 13.1084 + apply (simp del:last.simps)
 13.1085 + prefer 2
 13.1086 + apply(erule assum_after_body)
 13.1087 +  apply (simp del:last.simps)+
 13.1088 +--{* lo de antes. *}
 13.1089 +apply(simp add:comm_def del:map.simps last.simps)
 13.1090 +apply(rule conjI)
 13.1091 + apply clarify
 13.1092 + apply(simp only:Cons_lift_append)
 13.1093 + apply(case_tac "i<length xs")
 13.1094 +  apply(simp add:nth_append del:map.simps last.simps)
 13.1095 +  apply(case_tac "fst(((Some P, sa) # xs) ! i)")
 13.1096 +   apply(case_tac "((Some P, sa) # xs) ! i")
 13.1097 +   apply (simp add:lift_def del:last.simps)
 13.1098 +   apply(ind_cases "(Some (While b P), ba) -c\<rightarrow> t")
 13.1099 +    apply simp
 13.1100 +   apply simp
 13.1101 +  apply(simp add:snd_lift del:map.simps last.simps)
 13.1102 +  apply(thin_tac " \<forall>i. i < length ys \<longrightarrow> ?P i")
 13.1103 +  apply(simp only:com_validity_def cp_def cptn_iff_cptn_mod)
 13.1104 +  apply(erule_tac x=sa in allE)
 13.1105 +  apply(drule_tac c="(Some P, sa) # xs" in subsetD)
 13.1106 +   apply (simp add:assum_def del:map.simps last.simps)
 13.1107 +   apply clarify
 13.1108 +   apply(erule_tac x="Suc ia" in allE,simp add:nth_append snd_lift del:map.simps last.simps, erule mp)
 13.1109 +   apply(case_tac "fst(((Some P, sa) # xs) ! ia)")
 13.1110 +    apply(erule etran.elims,simp add:lift_def)
 13.1111 +    apply(rule Env)
 13.1112 +   apply(erule etran.elims,simp add:lift_def)
 13.1113 +   apply(rule Env)
 13.1114 +  apply (simp add:comm_def del:map.simps)
 13.1115 +  apply clarify
 13.1116 +  apply(erule allE,erule impE,assumption)
 13.1117 +  apply(erule mp)
 13.1118 +  apply(case_tac "((Some P, sa) # xs) ! i")
 13.1119 +  apply(case_tac "xs!i")
 13.1120 +  apply(simp add:lift_def)
 13.1121 +  apply(case_tac "fst(xs!i)")
 13.1122 +   apply force
 13.1123 + apply force
 13.1124 +--{*  @{text "i \<ge> length xs"} *}
 13.1125 +apply(subgoal_tac "i-length xs <length ys") 
 13.1126 + prefer 2
 13.1127 + apply arith
 13.1128 +apply(erule_tac x="i-length xs" in allE,clarify)
 13.1129 +apply(case_tac "i=length xs")
 13.1130 + apply (simp add:nth_append snd_lift del:map.simps last.simps)
 13.1131 + apply(simp add:last_length del:last.simps)
 13.1132 + apply(erule mp)
 13.1133 + apply(case_tac "last((Some P, sa) # xs)")
 13.1134 + apply(simp add:lift_def del:last.simps)
 13.1135 +--{* @{text "i>length xs"} *} 
 13.1136 +apply(case_tac "i-length xs")
 13.1137 + apply arith
 13.1138 +apply(simp add:nth_append del:map.simps last.simps)
 13.1139 +apply(rule conjI,clarify,arith)
 13.1140 +apply clarify
 13.1141 +apply(subgoal_tac "i- Suc (length xs)=nat")
 13.1142 + prefer 2
 13.1143 + apply arith
 13.1144 +apply simp
 13.1145 +--{* last=None *}
 13.1146 +apply clarify
 13.1147 +apply(case_tac ys)
 13.1148 + apply(simp add:Cons_lift del:map.simps last.simps)
 13.1149 + apply(subgoal_tac "(map (lift (While b P)) ((Some P, sa) # xs))\<noteq>[]")
 13.1150 +  apply(drule last_length2)
 13.1151 +  apply (simp del:map.simps)
 13.1152 +  apply(simp only:last_lift_not_None)
 13.1153 + apply simp
 13.1154 +apply(subgoal_tac "((Some (Seq P (While b P)), sa) # map (lift (While b P)) xs @ ys)\<noteq>[]")
 13.1155 + apply(drule last_length2)
 13.1156 + apply (simp del:map.simps last.simps)
 13.1157 + apply(simp add:nth_append del:last.simps)
 13.1158 + apply(subgoal_tac "((Some (While b P), snd (last ((Some P, sa) # xs))) # a # list)\<noteq>[]")
 13.1159 +  apply(drule last_length2)
 13.1160 +  apply (simp del:map.simps last.simps)
 13.1161 + apply simp
 13.1162 +apply simp
 13.1163 +done
 13.1164 +
 13.1165 +lemma While_sound: 
 13.1166 +  "\<lbrakk>stable pre rely; pre \<inter> - b \<subseteq> post; stable post rely;
 13.1167 +    \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s,s)\<in>guar\<rbrakk>
 13.1168 +  \<Longrightarrow> \<Turnstile> While b P sat [pre, rely, guar, post]"
 13.1169 +apply(unfold com_validity_def)
 13.1170 +apply clarify
 13.1171 +apply(erule_tac xs="tl x" in While_sound_aux)
 13.1172 + apply(simp add:com_validity_def)
 13.1173 + apply force
 13.1174 + apply simp_all
 13.1175 +apply(simp add:cptn_iff_cptn_mod cp_def)
 13.1176 +apply(simp add:cp_def)
 13.1177 +apply clarify
 13.1178 +apply(rule nth_equalityI)
 13.1179 + apply simp_all
 13.1180 + apply(case_tac x,simp+)
 13.1181 +apply clarify
 13.1182 +apply(case_tac i,simp+)
 13.1183 +apply(case_tac x,simp+)
 13.1184 +done
 13.1185 +
 13.1186 +subsubsection{* Soundness of the Rule of Consequence *}
 13.1187 +
 13.1188 +lemma Conseq_sound: 
 13.1189 +  "\<lbrakk>pre \<subseteq> pre'; rely \<subseteq> rely'; guar' \<subseteq> guar; post' \<subseteq> post; 
 13.1190 +  \<Turnstile> P sat [pre', rely', guar', post']\<rbrakk>
 13.1191 +  \<Longrightarrow> \<Turnstile> P sat [pre, rely, guar, post]"
 13.1192 +apply(simp add:com_validity_def assum_def comm_def)
 13.1193 +apply clarify
 13.1194 +apply(erule_tac x=s in allE)
 13.1195 +apply(drule_tac c=x in subsetD)
 13.1196 + apply force
 13.1197 +apply force
 13.1198 +done
 13.1199 +
 13.1200 +subsubsection {* Soundness of the system for sequential component programs *}
 13.1201 +
 13.1202 +theorem rgsound: 
 13.1203 +  "\<turnstile> P sat [pre, rely, guar, post] \<Longrightarrow> \<Turnstile> P sat [pre, rely, guar, post]"
 13.1204 +apply(erule rghoare.induct)
 13.1205 + apply(force elim:Basic_sound)
 13.1206 + apply(force elim:Seq_sound)
 13.1207 + apply(force elim:Cond_sound)
 13.1208 + apply(force elim:While_sound)
 13.1209 + apply(force elim:Await_sound)
 13.1210 +apply(erule Conseq_sound,simp+)
 13.1211 +done     
 13.1212 +
 13.1213 +subsection {* Soundness of the System for Parallel Programs *}
 13.1214 +
 13.1215 +constdefs
 13.1216 +  ParallelCom :: "('a rgformula) list \<Rightarrow> 'a par_com"
 13.1217 +  "ParallelCom Ps \<equiv> map (Some \<circ> fst) Ps" 
 13.1218 +
 13.1219 +lemma two: 
 13.1220 +  "\<lbrakk> \<forall>i<length xs. rely \<union> (\<Union>j\<in>{j. j < length xs \<and> j \<noteq> i}. Guar (xs ! j)) \<subseteq> Rely (xs ! i);
 13.1221 +  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
 13.1222 +  \<forall>i<length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
 13.1223 +  length xs=length clist; x \<in> par_cp (ParallelCom xs) s; x\<in>par_assum(pre, rely);
 13.1224 +  \<forall>i<length clist. clist!i\<in>cp (Some(Com(xs!i))) s; x \<propto> clist \<rbrakk>
 13.1225 +  \<Longrightarrow> \<forall>j i. i<length clist \<and> Suc j<length x \<longrightarrow> (clist!i!j) -c\<rightarrow> (clist!i!Suc j) 
 13.1226 +  \<longrightarrow> (snd(clist!i!j), snd(clist!i!Suc j)) \<in> Guar(xs!i)"
 13.1227 +apply(unfold par_cp_def)
 13.1228 +--{* By contradiction: *}
 13.1229 +apply(subgoal_tac "True")
 13.1230 + prefer 2
 13.1231 + apply simp 
 13.1232 +apply(erule_tac Q="True" in contrapos_pp)
 13.1233 +apply simp
 13.1234 +apply(erule exE)
 13.1235 +--{* the first c-tran that does not satisfy the guarantee-condition is from @{text "\<sigma>_i"} at step @{text "m"}. *}
 13.1236 +apply(drule_tac n=j and P="\<lambda>j. \<exists>i. ?H i j" in Ex_first_occurrence)
 13.1237 +apply(erule exE)
 13.1238 +apply clarify
 13.1239 +--{* @{text "\<sigma>_i \<in> A(pre, rely_1)"} *}
 13.1240 +apply(subgoal_tac "take (Suc (Suc m)) (clist!i) \<in> assum(Pre(xs!i), Rely(xs!i))")
 13.1241 +--{* but this contradicts @{text "\<Turnstile> \<sigma>_i sat [pre_i,rely_i,guar_i,post_i]"} *}
 13.1242 + apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> \<Turnstile> (?J i) sat [?I i,?K i,?M i,?N i]" in allE,erule impE,assumption)
 13.1243 + apply(simp add:com_validity_def)
 13.1244 + apply(erule_tac x=s in allE)
 13.1245 + apply(simp add:cp_def comm_def)
 13.1246 + apply(drule_tac c="take (Suc (Suc m)) (clist ! i)" in subsetD)
 13.1247 +  apply simp
 13.1248 +  apply(erule_tac x=i in allE, erule impE, assumption,erule conjE)
 13.1249 +  apply(erule takecptn_is_cptn)
 13.1250 + apply simp
 13.1251 + apply clarify
 13.1252 + apply(erule_tac x=m and P="\<lambda>j. ?I j \<and> ?J j \<longrightarrow> ?H j" in allE)
 13.1253 + apply (simp add:conjoin_def same_length_def)
 13.1254 +apply(simp add:assum_def)
 13.1255 +apply(rule conjI)
 13.1256 + apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow>  ?I j \<in>cp (?K j) (?J j)" in allE)
 13.1257 + apply(simp add:cp_def par_assum_def)
 13.1258 + apply(drule_tac c="s" in subsetD,simp)
 13.1259 + apply simp
 13.1260 +apply clarify
 13.1261 +apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> ?M \<union> UNION (?S j) (?T j) \<subseteq>  (?L j)" in allE)
 13.1262 +apply simp
 13.1263 +apply(erule subsetD)
 13.1264 +apply simp
 13.1265 +apply(simp add:conjoin_def compat_label_def)
 13.1266 +apply clarify
 13.1267 +apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (?P j) \<or> ?Q j" in allE,simp)
 13.1268 +--{* each etran in @{text "\<sigma>_1[0\<dots>m]"} corresponds to  *}
 13.1269 +apply(erule disjE)
 13.1270 +--{* a c-tran in some @{text "\<sigma>_{ib}"}  *}
 13.1271 + apply clarify
 13.1272 + apply(case_tac "i=ib",simp)
 13.1273 +  apply(erule etran.elims,simp)
 13.1274 + apply(erule_tac x="ib" and P="\<lambda>i. ?H i \<longrightarrow> (?I i) \<or> (?J i)" in allE,simp)
 13.1275 + apply(erule disjE,arith)
 13.1276 + apply(case_tac "ia=m",simp)
 13.1277 +  apply(erule etran.elims,simp)
 13.1278 + apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (\<forall> i. ?P i j)" in allE)
 13.1279 + apply(subgoal_tac "ia<m",simp)
 13.1280 +  prefer 2
 13.1281 +  apply arith
 13.1282 + apply(erule_tac x=ib and P="\<lambda>j. (?I j, ?H j)\<in> ctran \<longrightarrow> (?P i j)" in allE,simp)
 13.1283 + apply(simp add:same_state_def)
 13.1284 + apply(erule_tac x=i and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in all_dupE,simp)
 13.1285 + apply(erule_tac x=ib and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in allE,simp)
 13.1286 + apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
 13.1287 + apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
 13.1288 + apply(erule_tac x="Suc ia" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
 13.1289 + apply(erule_tac x="Suc ia" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
 13.1290 + apply simp
 13.1291 +--{* or an e-tran in @{text "\<sigma>"}, 
 13.1292 +therefore it satisfies @{text "rely \<or> guar_{ib}"} *}
 13.1293 +apply (force simp add:par_assum_def same_state_def)
 13.1294 +done
 13.1295 +
 13.1296 +lemma three [rule_format]: 
 13.1297 +  "\<lbrakk> xs\<noteq>[]; \<forall>i<length xs. rely \<union> (\<Union>j\<in>{j. j < length xs \<and> j \<noteq> i}. Guar (xs ! j)) \<subseteq> Rely (xs ! i);
 13.1298 +  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
 13.1299 +  \<forall>i<length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
 13.1300 +  length xs=length clist; x \<in> par_cp (ParallelCom xs) s; x\<in>par_assum(pre, rely);
 13.1301 +  \<forall>i<length clist. clist!i\<in>cp (Some(Com(xs!i))) s; x \<propto> clist \<rbrakk>
 13.1302 +  \<Longrightarrow> \<forall>j i. i<length clist \<and> Suc j<length x \<longrightarrow> (clist!i!j) -e\<rightarrow> (clist!i!Suc j) 
 13.1303 +  \<longrightarrow> (snd(clist!i!j), snd(clist!i!Suc j)) \<in> rely \<union> (\<Union>j\<in>{j. j < length xs \<and> j \<noteq> i}. Guar (xs ! j))"
 13.1304 +apply(drule two)
 13.1305 + apply simp_all
 13.1306 +apply clarify
 13.1307 +apply(simp add:conjoin_def compat_label_def)
 13.1308 +apply clarify
 13.1309 +apply(erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (?J j \<and> (\<exists>i. ?P i j)) \<or> ?I j" in allE,simp)
 13.1310 +apply(erule disjE)
 13.1311 + prefer 2
 13.1312 + apply(force simp add:same_state_def par_assum_def)
 13.1313 +apply clarify
 13.1314 +apply(case_tac "i=ia",simp)
 13.1315 + apply(erule etran.elims,simp)
 13.1316 +apply(erule_tac x="ia" and P="\<lambda>i. ?H i \<longrightarrow> (?I i) \<or> (?J i)" in allE,simp)
 13.1317 + apply(erule disjE,arith)
 13.1318 +apply(erule_tac x=j and P="\<lambda>j. \<forall>i. ?S j i \<longrightarrow> (?I j i, ?H j i)\<in> ctran \<longrightarrow> (?P i j)" in allE)
 13.1319 +apply(erule_tac x=ia and P="\<lambda>j. ?S j \<longrightarrow> (?I j, ?H j)\<in> ctran \<longrightarrow> (?P j)" in allE)
 13.1320 +apply(simp add:same_state_def)
 13.1321 +apply(erule_tac x=i and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in all_dupE,simp)
 13.1322 +apply(erule_tac x=ia and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in allE,simp)
 13.1323 +apply(erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
 13.1324 +apply(erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
 13.1325 +apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
 13.1326 +apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
 13.1327 +apply simp
 13.1328 +done
 13.1329 +
 13.1330 +lemma four: 
 13.1331 +  "\<lbrakk>xs\<noteq>[]; \<forall>i < length xs. rely \<union> (\<Union>j\<in>{j. j < length xs \<and> j \<noteq> i}. Guar (xs ! j)) \<subseteq> Rely (xs ! i);
 13.1332 +  (\<Union>j\<in>{j. j < length xs}. Guar (xs ! j)) \<subseteq> guar; pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
 13.1333 +  \<forall>i < length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
 13.1334 +  x \<in> par_cp (ParallelCom xs) s; x \<in> par_assum (pre, rely); Suc i < length x; x ! i -pc\<rightarrow> x ! Suc i\<rbrakk>
 13.1335 +  \<Longrightarrow> (snd (x ! i), snd (x ! Suc i)) \<in> guar"
 13.1336 +apply(simp add: ParallelCom_def)
 13.1337 +apply(subgoal_tac "(map (Some \<circ> fst) xs)\<noteq>[]")
 13.1338 + prefer 2
 13.1339 + apply simp
 13.1340 +apply(frule rev_subsetD)
 13.1341 + apply(erule one [THEN equalityD1])
 13.1342 +apply(erule subsetD)
 13.1343 +apply simp
 13.1344 +apply clarify
 13.1345 +apply(drule_tac pre=pre and rely=rely and  x=x and s=s and xs=xs and clist=clist in two)
 13.1346 +apply(assumption+)
 13.1347 +     apply(erule sym)
 13.1348 +    apply(simp add:ParallelCom_def)
 13.1349 +   apply assumption
 13.1350 +  apply(simp add:Com_def)
 13.1351 + apply assumption
 13.1352 +apply(simp add:conjoin_def same_program_def)
 13.1353 +apply clarify
 13.1354 +apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in all_dupE)
 13.1355 +apply(erule_tac x="Suc i" and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in allE)
 13.1356 +apply(erule par_ctran.elims,simp)
 13.1357 +apply(erule_tac x=i and P="\<lambda>j. \<forall>i. ?S j i \<longrightarrow> (?I j i, ?H j i)\<in> ctran \<longrightarrow> (?P i j)" in allE)
 13.1358 +apply(erule_tac x=ia and P="\<lambda>j. ?S j \<longrightarrow> (?I j, ?H j)\<in> ctran \<longrightarrow> (?P j)" in allE)
 13.1359 +apply(rule_tac x=ia in exI)
 13.1360 +apply(simp add:same_state_def)
 13.1361 +apply(erule_tac x=ia and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in all_dupE,simp)
 13.1362 +apply(erule_tac x=ia and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in allE,simp)
 13.1363 +apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
 13.1364 +apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE,simp)
 13.1365 +apply(erule_tac x="Suc i" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
 13.1366 +apply(erule mp)
 13.1367 +apply(subgoal_tac "r=fst(clist ! ia ! Suc i)",simp)
 13.1368 +apply(drule_tac i=ia in list_eq_if)
 13.1369 +back
 13.1370 +apply simp_all
 13.1371 +done
 13.1372 +
 13.1373 +lemma parcptn_not_empty [simp]:"[] \<notin> par_cptn"
 13.1374 +apply(force elim:par_cptn.elims)
 13.1375 +done
 13.1376 +
 13.1377 +lemma five: 
 13.1378 +  "\<lbrakk>xs\<noteq>[]; \<forall>i<length xs. rely \<union> (\<Union>j\<in>{j. j < length xs \<and> j \<noteq> i}. Guar (xs ! j)) \<subseteq> Rely (xs ! i);
 13.1379 +  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i)); (\<Inter>i\<in>{i. i < length xs}. Post (xs ! i)) \<subseteq> post;
 13.1380 +  \<forall>i < length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
 13.1381 +  x \<in> par_cp (ParallelCom xs) s; x \<in> par_assum (pre, rely); All_None (fst (last x)) \<rbrakk>
 13.1382 +  \<Longrightarrow> snd (last x) \<in> post"
 13.1383 +apply(simp add: ParallelCom_def)
 13.1384 +apply(subgoal_tac "(map (Some \<circ> fst) xs)\<noteq>[]")
 13.1385 + prefer 2
 13.1386 + apply simp
 13.1387 +apply(frule rev_subsetD)
 13.1388 + apply(erule one [THEN equalityD1])
 13.1389 +apply(erule subsetD)
 13.1390 +apply simp
 13.1391 +apply clarify
 13.1392 +apply(subgoal_tac "\<forall>i<length clist. clist!i\<in>assum(Pre(xs!i), Rely(xs!i))")
 13.1393 + apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> \<Turnstile> (?J i) sat [?I i,?K i,?M i,?N i]" in allE,erule impE,assumption)
 13.1394 + apply(simp add:com_validity_def)
 13.1395 + apply(erule_tac x=s in allE)
 13.1396 + apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (?I j) \<in> cp (?J j) s" in allE,simp)
 13.1397 + apply(drule_tac c="clist!i" in subsetD)
 13.1398 +  apply (force simp add:Com_def)
 13.1399 + apply(simp add:comm_def conjoin_def same_program_def del:last.simps)
 13.1400 + apply clarify
 13.1401 + apply(erule_tac x="length x - 1" and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in allE)
 13.1402 + apply (simp add:All_None_def same_length_def)
 13.1403 + apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> length(?J j)=(?K j)" in allE)
 13.1404 + apply(subgoal_tac "length x - 1 < length x",simp)
 13.1405 +  apply(case_tac "x\<noteq>[]")
 13.1406 +   apply(drule last_length2,simp)
 13.1407 +   apply(erule_tac x="clist!i" in ballE)
 13.1408 +    apply(simp add:same_state_def)
 13.1409 +    apply(subgoal_tac "clist!i\<noteq>[]")
 13.1410 +     apply(drule_tac xs="clist!i" in last_length2,simp)
 13.1411 +    apply(case_tac x)
 13.1412 +     apply (force simp add:par_cp_def)
 13.1413 +    apply (force simp add:par_cp_def)
 13.1414 +   apply force
 13.1415 +  apply (force simp add:par_cp_def)
 13.1416 + apply(case_tac x)
 13.1417 +  apply (force simp add:par_cp_def)
 13.1418 + apply (force simp add:par_cp_def)
 13.1419 +apply clarify
 13.1420 +apply(simp add:assum_def)
 13.1421 +apply(rule conjI)
 13.1422 + apply(simp add:conjoin_def same_state_def par_cp_def)
 13.1423 + apply clarify
 13.1424 + apply(erule_tac x=ia and P="\<lambda>j. (?T j) \<longrightarrow> (\<forall>i. (?H j i) \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in allE,simp)
 13.1425 + apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
 13.1426 + apply(case_tac x,simp+)
 13.1427 + apply (simp add:par_assum_def)
 13.1428 + apply clarify
 13.1429 + apply(drule_tac c="snd (clist ! ia ! 0)" in subsetD)
 13.1430 + apply assumption
 13.1431 + apply simp
 13.1432 +apply clarify
 13.1433 +apply(erule_tac x=ia in all_dupE)
 13.1434 +apply simp
 13.1435 +apply(rule subsetD)
 13.1436 + apply simp
 13.1437 +apply(erule_tac pre=pre and rely=rely and x=x and s=s in  three)
 13.1438 + apply(erule_tac x=ic in allE,erule mp)
 13.1439 + apply simp_all
 13.1440 + apply(simp add:ParallelCom_def)
 13.1441 + apply(force simp add:Com_def)
 13.1442 +apply(simp add:conjoin_def same_length_def)
 13.1443 +done
 13.1444 +
 13.1445 +lemma ParallelEmpty [rule_format]: 
 13.1446 +  "\<forall>i s. x \<in> par_cp (ParallelCom []) s \<longrightarrow> 
 13.1447 +  Suc i < length x \<longrightarrow> (x ! i, x ! Suc i) \<notin> par_ctran"
 13.1448 +apply(induct_tac x)
 13.1449 + apply(simp add:par_cp_def ParallelCom_def)
 13.1450 +apply clarify
 13.1451 +apply(case_tac list,simp,simp)
 13.1452 +apply(case_tac i)
 13.1453 + apply(simp add:par_cp_def ParallelCom_def)
 13.1454 + apply(erule par_ctran.elims,simp)
 13.1455 +apply(simp add:par_cp_def ParallelCom_def)
 13.1456 +apply clarify
 13.1457 +apply(erule par_cptn.elims,simp)
 13.1458 + apply simp
 13.1459 +apply(erule par_ctran.elims)
 13.1460 +back
 13.1461 +apply simp
 13.1462 +done
 13.1463 +
 13.1464 +theorem par_rgsound: 
 13.1465 +  "\<turnstile> c SAT [pre, rely, guar, post] \<Longrightarrow> \<Turnstile> (ParallelCom c) SAT [pre, rely, guar, post]"
 13.1466 +apply(erule par_rghoare.induct)
 13.1467 +apply(case_tac xs,simp)
 13.1468 + apply(simp add:par_com_validity_def par_comm_def)
 13.1469 + apply clarify
 13.1470 + apply(case_tac "post=UNIV",simp)
 13.1471 +  apply clarify
 13.1472 +  apply(drule ParallelEmpty)
 13.1473 +   apply assumption
 13.1474 +  apply simp
 13.1475 + apply clarify
 13.1476 + apply simp
 13.1477 +apply(subgoal_tac "xs\<noteq>[]")
 13.1478 + prefer 2
 13.1479 + apply simp
 13.1480 +apply(thin_tac "xs = a # list")
 13.1481 +apply(simp add:par_com_validity_def par_comm_def)
 13.1482 +apply clarify
 13.1483 +apply(rule conjI)
 13.1484 + apply clarify
 13.1485 + apply(erule_tac pre=pre and rely=rely and guar=guar and x=x and s=s and xs=xs in four)
 13.1486 +        apply(assumption+)
 13.1487 +     apply clarify
 13.1488 +     apply (erule allE, erule impE, assumption,erule rgsound)
 13.1489 +    apply(assumption+)
 13.1490 +apply clarify
 13.1491 +apply(erule_tac pre=pre and rely=rely and post=post and x=x and s=s and xs=xs in five)
 13.1492 +      apply(assumption+)
 13.1493 +   apply clarify
 13.1494 +   apply (erule allE, erule impE, assumption,erule rgsound)
 13.1495 +  apply(assumption+) 
 13.1496 +done
 13.1497 +
 13.1498 +end
 13.1499 \ No newline at end of file
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOL/HoareParallel/RG_Syntax.thy	Tue Mar 05 17:11:25 2002 +0100
    14.3 @@ -0,0 +1,90 @@
    14.4 +
    14.5 +header {* \section{Concrete Syntax} *}
    14.6 +
    14.7 +theory RG_Syntax = Quote_Antiquote + RG_Hoare:
    14.8 +
    14.9 +syntax
   14.10 +  "_Assign"    :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"                     ("(\<acute>_ :=/ _)" [70, 65] 61)
   14.11 +  "_skip"      :: "'a com"                                  ("SKIP")
   14.12 +  "_Seq"       :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com"              ("(_;;/ _)" [60,61] 60)
   14.13 +  "_Cond"      :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("(0IF _/ THEN _/ ELSE _/FI)" [0, 0, 0] 61)
   14.14 +  "_Cond2"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0IF _ THEN _ FI)" [0,0] 56)
   14.15 +  "_While"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0WHILE _ /DO _ /OD)"  [0, 0] 61)
   14.16 +  "_Await"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0AWAIT _ /THEN /_ /END)"  [0,0] 61)
   14.17 +  "_Atom"      :: "'a com \<Rightarrow> 'a com"                        ("(\<langle>_\<rangle>)" 61)
   14.18 +  "_Wait"      :: "'a bexp \<Rightarrow> 'a com"                       ("(0WAIT _ END)" 61)
   14.19 +
   14.20 +translations
   14.21 +  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
   14.22 +  "SKIP" \<rightleftharpoons> "Basic id"
   14.23 +  "c1;; c2" \<rightleftharpoons> "Seq c1 c2"
   14.24 +  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
   14.25 +  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
   14.26 +  "WHILE b DO c OD" \<rightharpoonup> "While .{b}. c"
   14.27 +  "AWAIT b THEN c END" \<rightleftharpoons> "Await .{b}. c"
   14.28 +  "\<langle>c\<rangle>" \<rightleftharpoons> "AWAIT True THEN c END"
   14.29 +  "WAIT b END" \<rightleftharpoons> "AWAIT b THEN SKIP END"
   14.30 +
   14.31 +nonterminals
   14.32 +  prgs
   14.33 +
   14.34 +syntax
   14.35 +  "_PAR"        :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" 60)
   14.36 +  "_prg"        :: "'a \<Rightarrow> prgs"              ("_" 57)
   14.37 +  "_prgs"       :: "['a, prgs] \<Rightarrow> prgs"      ("_//\<parallel>//_" [60,57] 57)
   14.38 +
   14.39 +translations
   14.40 +  "_prg a" \<rightharpoonup> "[a]"
   14.41 +  "_prgs a ps" \<rightharpoonup> "a # ps"
   14.42 +  "_PAR ps" \<rightharpoonup> "ps"
   14.43 +
   14.44 +syntax
   14.45 +  "_prg_scheme" :: "['a, 'a, 'a, 'a] \<Rightarrow> prgs"  ("SCHEME [_ \<le> _ < _] _" [0,0,0,60] 57)
   14.46 +
   14.47 +translations
   14.48 +  "_prg_scheme j i k c" \<rightleftharpoons> "(map (\<lambda>i. c) [j..k(])"
   14.49 +
   14.50 +text {* Translations for variables before and after a transition: *}
   14.51 +
   14.52 +syntax 
   14.53 +  "_before" :: "id \<Rightarrow> 'a" ("\<ordmasculine>_")
   14.54 +  "_after"  :: "id \<Rightarrow> 'a" ("\<ordfeminine>_")
   14.55 + 
   14.56 +translations
   14.57 +  "\<ordmasculine>x" \<rightleftharpoons> "x \<acute>fst"
   14.58 +  "\<ordfeminine>x" \<rightleftharpoons> "x \<acute>snd"
   14.59 +
   14.60 +print_translation {*
   14.61 +  let
   14.62 +    fun quote_tr' f (t :: ts) =
   14.63 +          Term.list_comb (f $ Syntax.quote_tr' "_antiquote" t, ts)
   14.64 +      | quote_tr' _ _ = raise Match;
   14.65 +
   14.66 +    val assert_tr' = quote_tr' (Syntax.const "_Assert");
   14.67 +
   14.68 +    fun bexp_tr' name ((Const ("Collect", _) $ t) :: ts) =
   14.69 +          quote_tr' (Syntax.const name) (t :: ts)
   14.70 +      | bexp_tr' _ _ = raise Match;
   14.71 +
   14.72 +    fun upd_tr' (x_upd, T) =
   14.73 +      (case try (unsuffix RecordPackage.updateN) x_upd of
   14.74 +        Some x => (x, if T = dummyT then T else Term.domain_type T)
   14.75 +      | None => raise Match);
   14.76 +
   14.77 +    fun update_name_tr' (Free x) = Free (upd_tr' x)
   14.78 +      | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
   14.79 +          c $ Free (upd_tr' x)
   14.80 +      | update_name_tr' (Const x) = Const (upd_tr' x)
   14.81 +      | update_name_tr' _ = raise Match;
   14.82 +
   14.83 +    fun assign_tr' (Abs (x, _, f $ t $ Bound 0) :: ts) =
   14.84 +          quote_tr' (Syntax.const "_Assign" $ update_name_tr' f)
   14.85 +            (Abs (x, dummyT, t) :: ts)
   14.86 +      | assign_tr' _ = raise Match;
   14.87 +  in
   14.88 +    [("Collect", assert_tr'), ("Basic", assign_tr'),
   14.89 +      ("Cond", bexp_tr' "_Cond"), ("While", bexp_tr' "_While_inv")]
   14.90 +  end
   14.91 +*}
   14.92 +
   14.93 +end
   14.94 \ No newline at end of file
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/HoareParallel/RG_Tran.thy	Tue Mar 05 17:11:25 2002 +0100
    15.3 @@ -0,0 +1,1076 @@
    15.4 +
    15.5 +header {* \section{Operational Semantics} *}
    15.6 +
    15.7 +theory RG_Tran = RG_Com:
    15.8 +
    15.9 +subsection {* Semantics of Component Programs *}
   15.10 +
   15.11 +subsubsection {* Environment transitions *}
   15.12 +
   15.13 +types 'a conf = "(('a com) option) \<times> 'a"
   15.14 +
   15.15 +consts etran    :: "('a conf \<times> 'a conf) set" 
   15.16 +syntax  "_etran"  :: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"  ("_ -e\<rightarrow> _" [81,81] 80)
   15.17 +translations  "P -e\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> etran"
   15.18 +inductive etran
   15.19 +intros
   15.20 +  Env: "(P, s) -e\<rightarrow> (P, t)"
   15.21 +
   15.22 +subsubsection {* Component transitions *}
   15.23 +
   15.24 +consts ctran    :: "('a conf \<times> 'a conf) set"
   15.25 +syntax
   15.26 +  "_ctran"  :: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"   ("_ -c\<rightarrow> _" [81,81] 80)
   15.27 +  "_ctran_*":: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"   ("_ -c*\<rightarrow> _" [81,81] 80)
   15.28 +translations
   15.29 +  "P -c\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> ctran"
   15.30 +  "P -c*\<rightarrow> Q" \<rightleftharpoons> "(P,Q) \<in> ctran^*"
   15.31 +
   15.32 +inductive  ctran 
   15.33 +intros
   15.34 +  Basic:  "(Some(Basic f), s) -c\<rightarrow> (None, f s)"
   15.35 +
   15.36 +  Seq1:   "(Some P0, s) -c\<rightarrow> (None, t) \<Longrightarrow> (Some(Seq P0 P1), s) -c\<rightarrow> (Some P1, t)"
   15.37 +
   15.38 +  Seq2:   "(Some P0, s) -c\<rightarrow> (Some P2, t) \<Longrightarrow> (Some(Seq P0 P1), s) -c\<rightarrow> (Some(Seq P2 P1), t)"
   15.39 +
   15.40 +  CondT: "s\<in>b  \<Longrightarrow> (Some(Cond b P1 P2), s) -c\<rightarrow> (Some P1, s)"
   15.41 +  CondF: "s\<notin>b \<Longrightarrow> (Some(Cond b P1 P2), s) -c\<rightarrow> (Some P2, s)"
   15.42 +
   15.43 +  WhileF: "s\<notin>b \<Longrightarrow> (Some(While b P), s) -c\<rightarrow> (None, s)"
   15.44 +  WhileT: "s\<in>b  \<Longrightarrow> (Some(While b P), s) -c\<rightarrow> (Some(Seq P (While b P)), s)"
   15.45 +
   15.46 +  Await:  "\<lbrakk>s\<in>b; (Some P, s) -c*\<rightarrow> (None, t)\<rbrakk> \<Longrightarrow> (Some(Await b P), s) -c\<rightarrow> (None, t)" 
   15.47 +
   15.48 +monos "rtrancl_mono"
   15.49 +
   15.50 +subsection {* Semantics of Parallel Programs *}
   15.51 +
   15.52 +types 'a par_conf = "('a par_com) \<times> 'a"
   15.53 +consts
   15.54 +  par_etran :: "('a par_conf \<times> 'a par_conf) set"
   15.55 +  par_ctran :: "('a par_conf \<times> 'a par_conf) set"
   15.56 +syntax
   15.57 +  "_par_etran":: "['a par_conf,'a par_conf] \<Rightarrow> bool" ("_ -pe\<rightarrow> _" [81,81] 80)
   15.58 +  "_par_ctran":: "['a par_conf,'a par_conf] \<Rightarrow> bool" ("_ -pc\<rightarrow> _" [81,81] 80)
   15.59 +translations
   15.60 +  "P -pe\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> par_etran"
   15.61 +  "P -pc\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> par_ctran"
   15.62 +
   15.63 +inductive  par_etran
   15.64 +intros
   15.65 +  ParEnv:  "(Ps, s) -pe\<rightarrow> (Ps, t)"
   15.66 +
   15.67 +inductive  par_ctran
   15.68 +intros
   15.69 +  ParComp: "\<lbrakk>i<length Ps; (Ps!i, s) -c\<rightarrow> (r, t)\<rbrakk> \<Longrightarrow> (Ps, s) -pc\<rightarrow> (Ps[i:=r], t)"
   15.70 +
   15.71 +subsection {* Computations *}
   15.72 +
   15.73 +subsubsection {* Sequential computations *}
   15.74 +
   15.75 +types 'a confs = "('a conf) list"
   15.76 +consts cptn :: "('a confs) set"
   15.77 +inductive  "cptn"
   15.78 +intros
   15.79 +  CptnOne: "[(P,s)] \<in> cptn"
   15.80 +  CptnEnv: "(P, t)#xs \<in> cptn \<Longrightarrow> (P,s)#(P,t)#xs \<in> cptn"
   15.81 +  CptnComp: "\<lbrakk>(P,s) -c\<rightarrow> (Q,t); (Q, t)#xs \<in> cptn \<rbrakk> \<Longrightarrow> (P,s)#(Q,t)#xs \<in> cptn"
   15.82 +
   15.83 +constdefs
   15.84 +  cp :: "('a com) option \<Rightarrow> 'a \<Rightarrow> ('a confs) set"
   15.85 +  "cp P s \<equiv> {l. l!0=(P,s) \<and> l \<in> cptn}"  
   15.86 +
   15.87 +subsubsection {* Parallel computations *}
   15.88 +
   15.89 +types  'a par_confs = "('a par_conf) list"
   15.90 +consts par_cptn :: "('a par_confs) set"
   15.91 +inductive  "par_cptn"
   15.92 +intros
   15.93 +  ParCptnOne: "[(P,s)] \<in> par_cptn"
   15.94 +  ParCptnEnv: "(P,t)#xs \<in> par_cptn \<Longrightarrow> (P,s)#(P,t)#xs \<in> par_cptn"
   15.95 +  ParCptnComp: "\<lbrakk> (P,s) -pc\<rightarrow> (Q,t); (Q,t)#xs \<in> par_cptn \<rbrakk> \<Longrightarrow> (P,s)#(Q,t)#xs \<in> par_cptn"
   15.96 +
   15.97 +constdefs
   15.98 +  par_cp :: "'a par_com \<Rightarrow> 'a \<Rightarrow> ('a par_confs) set"
   15.99 +  "par_cp P s \<equiv> {l. l!0=(P,s) \<and> l \<in> par_cptn}"  
  15.100 +
  15.101 +subsection{* Modular Definition of Computation *}
  15.102 +
  15.103 +constdefs 
  15.104 +  lift :: "'a com \<Rightarrow> 'a conf \<Rightarrow> 'a conf"
  15.105 +  "lift Q \<equiv> \<lambda>(P, s). (if P=None then (Some Q,s) else (Some(Seq (the P) Q), s))"
  15.106 +
  15.107 +consts  cptn_mod :: "('a confs) set"
  15.108 +inductive  "cptn_mod"
  15.109 +intros
  15.110 +  CptnModOne: "[(P, s)] \<in> cptn_mod"
  15.111 +  CptnModEnv: "(P, t)#xs \<in> cptn_mod \<Longrightarrow> (P, s)#(P, t)#xs \<in> cptn_mod"
  15.112 +  CptnModNone: "\<lbrakk>(Some P, s) -c\<rightarrow> (None, t); (None, t)#xs \<in> cptn_mod \<rbrakk> \<Longrightarrow> (Some P,s)#(None, t)#xs \<in>cptn_mod"
  15.113 +  CptnModCondT: "\<lbrakk>(Some P0, s)#ys \<in> cptn_mod; s \<in> b \<rbrakk> \<Longrightarrow> (Some(Cond b P0 P1), s)#(Some P0, s)#ys \<in> cptn_mod"
  15.114 +  CptnModCondF: "\<lbrakk>(Some P1, s)#ys \<in> cptn_mod; s \<notin> b \<rbrakk> \<Longrightarrow> (Some(Cond b P0 P1), s)#(Some P1, s)#ys \<in> cptn_mod"
  15.115 +  CptnModSeq1: "\<lbrakk>(Some P0, s)#xs \<in> cptn_mod; zs=map (lift P1) xs \<rbrakk>
  15.116 +                 \<Longrightarrow> (Some(Seq P0 P1), s)#zs \<in> cptn_mod"
  15.117 +  CptnModSeq2: 
  15.118 +  "\<lbrakk>(Some P0, s)#xs \<in> cptn_mod; fst(last ((Some P0, s)#xs)) = None; 
  15.119 +  (Some P1, snd(last ((Some P0, s)#xs)))#ys \<in> cptn_mod; 
  15.120 +  zs=(map (lift P1) xs)@ys \<rbrakk> \<Longrightarrow> (Some(Seq P0 P1), s)#zs \<in> cptn_mod"
  15.121 +
  15.122 +  CptnModWhile1: 
  15.123 +  "\<lbrakk> (Some P, s)#xs \<in> cptn_mod; s \<in> b; zs=map (lift (While b P)) xs \<rbrakk> 
  15.124 +  \<Longrightarrow> (Some(While b P), s)#(Some(Seq P (While b P)), s)#zs \<in> cptn_mod"
  15.125 +  CptnModWhile2: 
  15.126 +  "\<lbrakk> (Some P, s)#xs \<in> cptn_mod; fst(last ((Some P, s)#xs))=None; s \<in> b; 
  15.127 +  zs=(map (lift (While b P)) xs)@ys; 
  15.128 +  (Some(While b P), snd(last ((Some P, s)#xs)))#ys \<in> cptn_mod\<rbrakk> 
  15.129 +  \<Longrightarrow> (Some(While b P), s)#(Some(Seq P (While b P)), s)#zs \<in> cptn_mod"
  15.130 +
  15.131 +subsection {* Equivalence of Both Definitions.*}
  15.132 +
  15.133 +lemma last_length: "((a#xs)!(length xs))=last (a#xs)"
  15.134 +apply simp
  15.135 +apply(induct xs,simp+)
  15.136 +apply(case_tac list)
  15.137 +apply simp_all
  15.138 +done
  15.139 +
  15.140 +lemma div_seq [rule_format]: "list \<in> cptn_mod \<Longrightarrow>
  15.141 + (\<forall>s P Q zs. list=(Some (Seq P Q), s)#zs \<longrightarrow>
  15.142 +  (\<exists>xs. (Some P, s)#xs \<in> cptn_mod  \<and> (zs=(map (lift Q) xs) \<or>
  15.143 +  ( fst(((Some P, s)#xs)!length xs)=None \<and> 
  15.144 +  (\<exists>ys. (Some Q, snd(((Some P, s)#xs)!length xs))#ys \<in> cptn_mod  
  15.145 +  \<and> zs=(map (lift (Q)) xs)@ys)))))"
  15.146 +apply(erule cptn_mod.induct)
  15.147 +apply simp_all
  15.148 +    apply clarify
  15.149 +    apply(force intro:CptnModOne)
  15.150 +   apply clarify
  15.151 +   apply(erule_tac x=Pa in allE)
  15.152 +   apply(erule_tac x=Q in allE)
  15.153 +   apply simp
  15.154 +   apply clarify
  15.155 +   apply(erule disjE)
  15.156 +    apply(rule_tac x="(Some Pa,t)#xsa" in exI)
  15.157 +    apply(rule conjI)
  15.158 +     apply clarify
  15.159 +     apply(erule CptnModEnv)
  15.160 +    apply(rule disjI1)
  15.161 +    apply(simp add:lift_def)
  15.162 +   apply clarify
  15.163 +   apply(rule_tac x="(Some Pa,t)#xsa" in exI)
  15.164 +   apply(rule conjI)
  15.165 +    apply(erule CptnModEnv)
  15.166 +   apply(rule disjI2)
  15.167 +   apply(rule conjI)
  15.168 +    apply(case_tac xsa,simp,simp)
  15.169 +   apply(rule_tac x="ys" in exI)
  15.170 +   apply(rule conjI)
  15.171 +    apply simp
  15.172 +   apply(simp add:lift_def)
  15.173 +  apply clarify
  15.174 +  apply(erule ctran.elims,simp_all)
  15.175 + apply clarify
  15.176 + apply(rule_tac x="xs" in exI)
  15.177 + apply simp
  15.178 + apply clarify
  15.179 +apply(rule_tac x="xs" in exI)
  15.180 +apply(simp add: last_length)
  15.181 +done
  15.182 +
  15.183 +lemma cptn_onlyif_cptn_mod_aux [rule_format]:
  15.184 +  "\<forall>s Q t xs.((Some a, s), Q, t) \<in> ctran \<longrightarrow> (Q, t) # xs \<in> cptn_mod 
  15.185 +  \<longrightarrow> (Some a, s) # (Q, t) # xs \<in> cptn_mod"
  15.186 +apply(induct a)
  15.187 +apply simp_all
  15.188 +--{* basic *}
  15.189 +apply clarify
  15.190 +apply(erule ctran.elims,simp_all)
  15.191 +apply(rule CptnModNone,rule Basic,simp)
  15.192 +apply clarify
  15.193 +apply(erule ctran.elims,simp_all)
  15.194 +--{* Seq1 *}
  15.195 +apply(rule_tac xs="[(None,ta)]" in CptnModSeq2)
  15.196 +  apply(erule CptnModNone)
  15.197 +  apply(rule CptnModOne)
  15.198 + apply simp
  15.199 +apply simp
  15.200 +apply(simp add:lift_def)
  15.201 +--{* Seq2 *}
  15.202 +apply(erule_tac x=sa in allE)
  15.203 +apply(erule_tac x="Some P2" in allE)
  15.204 +apply(erule allE,erule impE, assumption)
  15.205 +apply(drule div_seq,simp)
  15.206 +apply force
  15.207 +apply clarify
  15.208 +apply(erule disjE)
  15.209 + apply clarify
  15.210 + apply(erule allE,erule impE, assumption)
  15.211 + apply(erule_tac CptnModSeq1)
  15.212 + apply(simp add:lift_def)
  15.213 +apply clarify 
  15.214 +apply(erule allE,erule impE, assumption)
  15.215 +apply(erule_tac CptnModSeq2)
  15.216 +  apply (simp add:last_length)
  15.217 + apply (simp add:last_length)
  15.218 +apply(simp add:lift_def)
  15.219 +--{* Cond *}
  15.220 +apply clarify
  15.221 +apply(erule ctran.elims,simp_all)
  15.222 +apply(force elim: CptnModCondT)
  15.223 +apply(force elim: CptnModCondF)
  15.224 +--{* While *}
  15.225 +apply  clarify
  15.226 +apply(erule ctran.elims,simp_all)
  15.227 +apply(rule CptnModNone,erule WhileF,simp)
  15.228 +apply(drule div_seq,force)
  15.229 +apply clarify
  15.230 +apply (erule disjE)
  15.231 + apply(force elim:CptnModWhile1)
  15.232 +apply clarify
  15.233 +apply(force simp add:last_length elim:CptnModWhile2)
  15.234 +--{* await *}
  15.235 +apply clarify
  15.236 +apply(erule ctran.elims,simp_all)
  15.237 +apply(rule CptnModNone,erule Await,simp+)
  15.238 +done
  15.239 +
  15.240 +lemma cptn_onlyif_cptn_mod [rule_format]: "c \<in> cptn \<Longrightarrow> c \<in> cptn_mod"
  15.241 +apply(erule cptn.induct)
  15.242 +  apply(rule CptnModOne)
  15.243 + apply(erule CptnModEnv)
  15.244 +apply(case_tac P)
  15.245 + apply simp
  15.246 + apply(erule ctran.elims,simp_all)
  15.247 +apply(force elim:cptn_onlyif_cptn_mod_aux)
  15.248 +done
  15.249 +
  15.250 +lemma lift_is_cptn: "c\<in>cptn \<Longrightarrow> map (lift P) c \<in> cptn"
  15.251 +apply(erule cptn.induct)
  15.252 +  apply(force simp add:lift_def CptnOne)
  15.253 + apply(force intro:CptnEnv simp add:lift_def)
  15.254 +apply(force simp add:lift_def intro:CptnComp Seq2 Seq1 elim:ctran.elims)
  15.255 +done
  15.256 +
  15.257 +lemma cptn_append_is_cptn [rule_format]: 
  15.258 + "\<forall>b a. b#c1\<in>cptn \<longrightarrow>  a#c2\<in>cptn \<longrightarrow> (b#c1)!length c1=a \<longrightarrow> b#c1@c2\<in>cptn"
  15.259 +apply(induct c1)
  15.260 + apply simp
  15.261 +apply clarify
  15.262 +apply(erule cptn.elims,simp_all)
  15.263 + apply(force intro:CptnEnv)
  15.264 +apply(force elim:CptnComp)
  15.265 +done
  15.266 +
  15.267 +lemma last_lift: "\<lbrakk>xs\<noteq>[]; fst(xs!(length xs - (Suc 0)))=None\<rbrakk> 
  15.268 + \<Longrightarrow> fst((map (lift P) xs)!(length (map (lift P) xs)- (Suc 0)))=(Some P)"
  15.269 +apply(case_tac "(xs ! (length xs - (Suc 0)))")
  15.270 +apply (simp add:lift_def)
  15.271 +done
  15.272 +
  15.273 +lemma last_fst [rule_format]: "P((a#x)!length x) \<longrightarrow> \<not>P a \<longrightarrow> P (x!(length x - (Suc 0)))" 
  15.274 +apply(induct x,simp+)
  15.275 +done
  15.276 +
  15.277 +lemma last_fst_esp: 
  15.278 + "fst(((Some a,s)#xs)!(length xs))=None \<Longrightarrow> fst(xs!(length xs - (Suc 0)))=None" 
  15.279 +apply(erule last_fst)
  15.280 +apply simp
  15.281 +done
  15.282 +
  15.283 +lemma last_snd: "xs\<noteq>[] \<Longrightarrow> 
  15.284 +  snd(((map (lift P) xs))!(length (map (lift P) xs) - (Suc 0)))=snd(xs!(length xs - (Suc 0)))"
  15.285 +apply(case_tac "(xs ! (length xs - (Suc 0)))",simp)
  15.286 +apply (simp add:lift_def)
  15.287 +done
  15.288 +
  15.289 +lemma Cons_lift: "(Some (Seq P Q), s) # (map (lift Q) xs) = map (lift Q) ((Some P, s) # xs)"
  15.290 +by(simp add:lift_def)
  15.291 +
  15.292 +lemma Cons_lift_append: 
  15.293 +  "(Some (Seq P Q), s) # (map (lift Q) xs) @ ys = map (lift Q) ((Some P, s) # xs)@ ys "
  15.294 +by(simp add:lift_def)
  15.295 +
  15.296 +lemma lift_nth: "i<length xs \<Longrightarrow> map (lift Q) xs ! i = lift Q  (xs! i)"
  15.297 +by (simp add:lift_def)
  15.298 +
  15.299 +lemma snd_lift: "i< length xs \<Longrightarrow> snd(lift Q (xs ! i))= snd (xs ! i)"
  15.300 +apply(case_tac "xs!i")
  15.301 +apply(simp add:lift_def)
  15.302 +done
  15.303 +
  15.304 +lemma cptn_if_cptn_mod: "c \<in> cptn_mod \<Longrightarrow> c \<in> cptn"
  15.305 +apply(erule cptn_mod.induct)
  15.306 +        apply(rule CptnOne)
  15.307 +       apply(erule CptnEnv)
  15.308 +      apply(erule CptnComp,simp)
  15.309 +     apply(rule CptnComp)
  15.310 +     apply(erule CondT,simp)
  15.311 +    apply(rule CptnComp)
  15.312 +    apply(erule CondF,simp)
  15.313 +--{* Seq1 *}   
  15.314 +apply(erule cptn.elims,simp_all)
  15.315 +  apply(rule CptnOne)
  15.316 + apply clarify
  15.317 + apply(drule_tac P=P1 in lift_is_cptn)
  15.318 + apply(simp add:lift_def)
  15.319 + apply(rule CptnEnv,simp)
  15.320 +apply clarify
  15.321 +apply(simp add:lift_def)
  15.322 +apply(rule conjI)
  15.323 + apply clarify
  15.324 + apply(rule CptnComp)
  15.325 +  apply(rule Seq1,simp)
  15.326 + apply(drule_tac P=P1 in lift_is_cptn)
  15.327 + apply(simp add:lift_def)
  15.328 +apply clarify
  15.329 +apply(rule CptnComp)
  15.330 + apply(rule Seq2,simp)
  15.331 +apply(drule_tac P=P1 in lift_is_cptn)
  15.332 +apply(simp add:lift_def)
  15.333 +--{* Seq2 *}
  15.334 +apply(rule cptn_append_is_cptn)
  15.335 +  apply(drule_tac P=P1 in lift_is_cptn)
  15.336 +  apply(simp add:lift_def)
  15.337 + apply simp
  15.338 +apply(case_tac "xs\<noteq>[]")
  15.339 + apply(drule_tac P=P1 in last_lift)
  15.340 +  apply(rule last_fst_esp)
  15.341 +  apply (simp add:last_length)
  15.342 + apply(simp add:Cons_lift del:map.simps)
  15.343 + apply(rule conjI, clarify, simp)
  15.344 + apply(case_tac "(((Some P0, s) # xs) ! length xs)")
  15.345 + apply clarify
  15.346 + apply (simp add:lift_def last_length)
  15.347 +apply (simp add:last_length)
  15.348 +--{* While1 *}
  15.349 +apply(rule CptnComp)
  15.350 +apply(rule WhileT,simp)
  15.351 +apply(drule_tac P="While b P" in lift_is_cptn)
  15.352 +apply(simp add:lift_def)
  15.353 +--{* While2 *}
  15.354 +apply(rule CptnComp)
  15.355 +apply(rule WhileT,simp)
  15.356 +apply(rule cptn_append_is_cptn)
  15.357 +apply(drule_tac P="While b P" in lift_is_cptn)
  15.358 +  apply(simp add:lift_def)
  15.359 + apply simp
  15.360 +apply(case_tac "xs\<noteq>[]")
  15.361 + apply(drule_tac P="While b P" in last_lift)
  15.362 +  apply(rule last_fst_esp,simp add:last_length)
  15.363 + apply(simp add:Cons_lift del:map.simps)
  15.364 + apply(rule conjI, clarify, simp)
  15.365 + apply(case_tac "(((Some P, s) # xs) ! length xs)")
  15.366 + apply clarify
  15.367 + apply (simp add:last_length lift_def)
  15.368 +apply simp
  15.369 +done
  15.370 +
  15.371 +theorem cptn_iff_cptn_mod: "(c \<in> cptn) = (c \<in> cptn_mod)"
  15.372 +apply(rule iffI)
  15.373 + apply(erule cptn_onlyif_cptn_mod)
  15.374 +apply(erule cptn_if_cptn_mod)
  15.375 +done
  15.376 +
  15.377 +section {* Validity  of Correctness Formulas*}
  15.378 +
  15.379 +subsection {* Validity for Component Programs. *}
  15.380 +
  15.381 +types 'a rgformula = "'a com \<times> 'a set \<times> ('a \<times> 'a) set \<times> ('a \<times> 'a) set \<times> 'a set"
  15.382 +
  15.383 +constdefs
  15.384 +  assum :: "('a set \<times> ('a \<times> 'a) set) \<Rightarrow> ('a confs) set"
  15.385 +  "assum \<equiv> \<lambda>(pre, rely). {c. snd(c!0) \<in> pre \<and> (\<forall>i. Suc i<length c \<longrightarrow> 
  15.386 +               c!i -e\<rightarrow> c!(Suc i) \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> rely)}"
  15.387 +
  15.388 +  comm :: "(('a \<times> 'a) set \<times> 'a set) \<Rightarrow> ('a confs) set"
  15.389 +  "comm \<equiv> \<lambda>(guar, post). {c. (\<forall>i. Suc i<length c \<longrightarrow> 
  15.390 +               c!i -c\<rightarrow> c!(Suc i) \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> guar) \<and> 
  15.391 +               (fst (last c) = None \<longrightarrow> snd (last c) \<in> post)}"
  15.392 +
  15.393 +  com_validity :: "'a com \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set \<Rightarrow> bool" 
  15.394 +                 ("\<Turnstile> _ sat [_, _, _, _]" [60,0,0,0,0] 45)
  15.395 +  "\<Turnstile> P sat [pre, rely, guar, post] \<equiv> 
  15.396 +   \<forall>s. cp (Some P) s \<inter> assum(pre, rely) \<subseteq> comm(guar, post)"
  15.397 +
  15.398 +subsection {* Validity for Parallel Programs. *}
  15.399 +
  15.400 +constdefs
  15.401 +  All_None :: "(('a com) option) list \<Rightarrow> bool"
  15.402 +  "All_None xs \<equiv> \<forall>c\<in>set xs. c=None"
  15.403 +
  15.404 +  par_assum :: "('a set \<times> ('a \<times> 'a) set) \<Rightarrow> ('a par_confs) set"
  15.405 +  "par_assum \<equiv> \<lambda>(pre, rely). {c. snd(c!0) \<in> pre \<and> (\<forall>i. Suc i<length c \<longrightarrow> 
  15.406 +             c!i -pe\<rightarrow> c!Suc i \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> rely)}"
  15.407 +
  15.408 +  par_comm :: "(('a \<times> 'a) set \<times> 'a set) \<Rightarrow> ('a par_confs) set"
  15.409 +  "par_comm \<equiv> \<lambda>(guar, post). {c. (\<forall>i. Suc i<length c \<longrightarrow>   
  15.410 +        c!i -pc\<rightarrow> c!Suc i \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> guar) \<and> 
  15.411 +         (All_None (fst (last c)) \<longrightarrow> snd( last c) \<in> post)}"
  15.412 +
  15.413 +  par_com_validity :: "'a  par_com \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set
  15.414 +                  \<Rightarrow> bool"  ("\<Turnstile> _ SAT [_, _, _, _]" [60,0,0,0,0] 45)
  15.415 +  "\<Turnstile> Ps SAT [pre, rely, guar, post] \<equiv> 
  15.416 +   \<forall>s. par_cp Ps s \<inter> par_assum(pre, rely) \<subseteq> par_comm(guar, post)"
  15.417 +
  15.418 +subsection {* Compositionality of the Semantics *}
  15.419 +
  15.420 +subsubsection {* Definition of the conjoin operator *}
  15.421 +
  15.422 +constdefs
  15.423 +  same_length :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
  15.424 +  "same_length c clist \<equiv> (\<forall>i<length clist. length(clist!i)=length c)"
  15.425 + 
  15.426 +  same_state :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
  15.427 +  "same_state c clist \<equiv> (\<forall>i <length clist. \<forall>j<length c. snd(c!j) = snd((clist!i)!j))"
  15.428 +
  15.429 +  same_program :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
  15.430 +  "same_program c clist \<equiv> (\<forall>j<length c. fst(c!j) = map (\<lambda>x. fst(nth x j)) clist)"
  15.431 +
  15.432 +  compat_label :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
  15.433 +  "compat_label c clist \<equiv> (\<forall>j. Suc j<length c \<longrightarrow> 
  15.434 +         (c!j -pc\<rightarrow> c!Suc j \<and> (\<exists>i<length clist. (clist!i)!j -c\<rightarrow> (clist!i)! Suc j \<and> 
  15.435 +                              (\<forall>l<length clist. l\<noteq>i \<longrightarrow> (clist!l)!j -e\<rightarrow> (clist!l)! Suc j))) \<or> 
  15.436 +         (c!j -pe\<rightarrow> c!Suc j \<and> (\<forall>i<length clist. (clist!i)!j -e\<rightarrow> (clist!i)! Suc j)))"
  15.437 +
  15.438 +  conjoin :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"  ("_ \<propto> _" [65,65] 64)
  15.439 +  "c \<propto> clist \<equiv> (same_length c clist) \<and> (same_state c clist) \<and> (same_program c clist) \<and> (compat_label c clist)"
  15.440 +
  15.441 +subsubsection {* Some previous lemmas *}
  15.442 +
  15.443 +lemma list_eq_if [rule_format]: "\<forall>ys. xs=ys \<longrightarrow> (length xs = length ys) \<longrightarrow> (\<forall>i<length xs. xs!i=ys!i)"
  15.444 +apply (induct xs)
  15.445 + apply simp
  15.446 +apply clarify
  15.447 +done
  15.448 +
  15.449 +lemma list_eq: "(length xs = length ys \<and> (\<forall>i<length xs. xs!i=ys!i)) = (xs=ys)"
  15.450 +apply(rule iffI)
  15.451 + apply clarify
  15.452 + apply(erule nth_equalityI)
  15.453 + apply simp+
  15.454 +done
  15.455 +
  15.456 +lemma nth_tl: "\<lbrakk> ys!0=a; ys\<noteq>[] \<rbrakk> \<Longrightarrow> ys=(a#(tl ys))"
  15.457 +apply(case_tac ys)
  15.458 + apply simp+
  15.459 +done
  15.460 +
  15.461 +lemma nth_tl_if [rule_format]: "ys\<noteq>[] \<longrightarrow> ys!0=a \<longrightarrow> P ys \<longrightarrow> P (a#(tl ys))"
  15.462 +apply(induct ys)
  15.463 + apply simp+
  15.464 +done
  15.465 +
  15.466 +lemma nth_tl_onlyif [rule_format]: "ys\<noteq>[] \<longrightarrow> ys!0=a \<longrightarrow> P (a#(tl ys)) \<longrightarrow> P ys"
  15.467 +apply(induct ys)
  15.468 + apply simp+
  15.469 +done
  15.470 +
  15.471 +lemma seq_not_eq1: "Seq c1 c2\<noteq>c1"
  15.472 +apply(rule com.induct)
  15.473 +apply simp_all
  15.474 +apply clarify
  15.475 +done
  15.476 +
  15.477 +lemma seq_not_eq2: "Seq c1 c2\<noteq>c2"
  15.478 +apply(rule com.induct)
  15.479 +apply simp_all
  15.480 +apply clarify
  15.481 +done
  15.482 +
  15.483 +lemma if_not_eq1: "Cond b c1 c2 \<noteq>c1"
  15.484 +apply(rule com.induct)
  15.485 +apply simp_all
  15.486 +apply clarify
  15.487 +done
  15.488 +
  15.489 +lemma if_not_eq2: "Cond b c1 c2\<noteq>c2"
  15.490 +apply(rule com.induct)
  15.491 +apply simp_all
  15.492 +apply clarify
  15.493 +done
  15.494 +
  15.495 +lemmas seq_and_if_not_eq [simp] = seq_not_eq1 seq_not_eq2 
  15.496 +seq_not_eq1 [THEN not_sym] seq_not_eq2 [THEN not_sym] 
  15.497 +if_not_eq1 if_not_eq2 if_not_eq1 [THEN not_sym] if_not_eq2 [THEN not_sym]
  15.498 +
  15.499 +lemma prog_not_eq_in_ctran_aux [rule_format]: "(P,s) -c\<rightarrow> (Q,t) \<Longrightarrow> (P\<noteq>Q)"
  15.500 +apply(erule ctran.induct)
  15.501 +apply simp_all
  15.502 +done
  15.503 +
  15.504 +lemma prog_not_eq_in_ctran [simp]: "\<not> (P,s) -c\<rightarrow> (P,t)"
  15.505 +apply clarify
  15.506 +apply(drule prog_not_eq_in_ctran_aux)
  15.507 +apply simp
  15.508 +done
  15.509 +
  15.510 +lemma prog_not_eq_in_par_ctran_aux [rule_format]: "(P,s) -pc\<rightarrow> (Q,t) \<Longrightarrow> (P\<noteq>Q)"
  15.511 +apply(erule par_ctran.induct)
  15.512 +apply(drule prog_not_eq_in_ctran_aux)
  15.513 +apply clarify
  15.514 +apply(drule list_eq_if)
  15.515 + apply simp_all
  15.516 +apply force
  15.517 +done
  15.518 +
  15.519 +lemma prog_not_eq_in_par_ctran [simp]: "\<not> (P,s) -pc\<rightarrow> (P,t)"
  15.520 +apply clarify
  15.521 +apply(drule prog_not_eq_in_par_ctran_aux)
  15.522 +apply simp
  15.523 +done
  15.524 +
  15.525 +lemma tl_in_cptn: "\<lbrakk> a#xs \<in>cptn; xs\<noteq>[] \<rbrakk> \<Longrightarrow> xs\<in>cptn"
  15.526 +apply(force elim:cptn.elims)
  15.527 +done
  15.528 +
  15.529 +lemma tl_zero[rule_format]: "P (ys!Suc j) \<longrightarrow> Suc j<length ys \<longrightarrow> ys\<noteq>[] \<longrightarrow> P (tl(ys)!j)"
  15.530 +apply(induct ys)
  15.531 + apply simp_all
  15.532 +done
  15.533 +
  15.534 +subsection {* The Semantics is Compositional *}
  15.535 +
  15.536 +lemma aux_if [rule_format]: 
  15.537 +  "\<forall>xs s clist. (length clist = length xs \<and> (\<forall>i<length xs. (xs!i,s)#clist!i \<in> cptn) 
  15.538 +  \<and> ((xs, s)#ys \<propto> map (\<lambda>i. (fst i,s)#snd i) (zip xs clist)) 
  15.539 +   \<longrightarrow> (xs, s)#ys \<in> par_cptn)"
  15.540 +apply(induct ys)
  15.541 + apply(clarify)
  15.542 + apply(rule ParCptnOne)
  15.543 +apply(clarify)
  15.544 +apply(simp add:conjoin_def compat_label_def)
  15.545 +apply clarify
  15.546 +apply(erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (?P j \<or> ?Q j)" in all_dupE,simp)
  15.547 +apply(erule disjE)
  15.548 +--{* first step is a Component step *}
  15.549 + apply clarify 
  15.550 + apply simp
  15.551 + apply(subgoal_tac "a=(xs[i:=(fst(clist!i!0))])")
  15.552 +  apply(subgoal_tac "b=snd(clist!i!0)",simp)
  15.553 +   prefer 2
  15.554 +   apply(simp add: same_state_def)
  15.555 +   apply(erule_tac x=i in allE,erule impE,assumption, 
  15.556 +         erule_tac x=1 and P="\<lambda>j. (?H j) \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
  15.557 +  prefer 2
  15.558 +  apply(simp add:same_program_def)
  15.559 +  apply(erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (fst (?s j))=(?t j)" in allE,simp)
  15.560 +  apply(rule nth_equalityI,simp)
  15.561 +  apply clarify