# HG changeset patch
# User prensani
# Date 1015344685 -3600
# Node ID 791e3b4c403957598091e827375a567449b1379e
# Parent  98f0a09a33c343206d8710ef246f580a762f98fe
HoareParallel Theories

diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/Gar_Coll.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/Gar_Coll.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,880 @@
+
+header {* \section{The Single Mutator Case} *}
+
+theory Gar_Coll = Graph + OG_Syntax:
+
+text {* Declaration of variables: *}
+
+record gar_coll_state =
+  M :: nodes
+  E :: edges
+  bc :: "nat set"
+  obc :: "nat set"
+  Ma :: nodes
+  ind :: nat 
+  k :: nat
+  z :: bool
+
+subsection {* The Mutator *}
+
+text {* The mutator first redirects an arbitrary edge @{text "R"} from
+an arbitrary accessible node towards an arbitrary accessible node
+@{text "T"}.  It then colors the new target @{text "T"} black. 
+
+We declare the arbitrarily selected node and edge as constants:*}
+
+consts R :: nat  T :: nat
+
+text {* \noindent The following predicate states, given a list of
+nodes @{text "m"} and a list of edges @{text "e"}, the conditions
+under which the selected edge @{text "R"} and node @{text "T"} are
+valid: *}
+
+constdefs
+  Mut_init :: "gar_coll_state \<Rightarrow> bool"
+  "Mut_init \<equiv> \<guillemotleft> T \<in> Reach \<acute>E \<and> R < length \<acute>E \<and> T < length \<acute>M \<guillemotright>"
+
+text {* \noindent For the mutator we
+consider two modules, one for each action.  An auxiliary variable
+@{text "\<acute>z"} is set to false if the mutator has already redirected an
+edge but has not yet colored the new target.   *}
+
+constdefs
+  Redirect_Edge :: "gar_coll_state ann_com"
+  "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>"
+
+  Color_Target :: "gar_coll_state ann_com"
+  "Color_Target \<equiv> .{\<acute>Mut_init \<and> \<not>\<acute>z}. \<langle>\<acute>M:=\<acute>M[T:=Black],, \<acute>z:= (\<not>\<acute>z)\<rangle>"
+
+  Mutator :: "gar_coll_state ann_com"
+  "Mutator \<equiv>
+  .{\<acute>Mut_init \<and> \<acute>z}. 
+  WHILE True INV .{\<acute>Mut_init \<and> \<acute>z}. 
+  DO  Redirect_Edge ;; Color_Target  OD"
+
+subsubsection {* Correctness of the mutator *}
+
+lemmas mutator_defs = Mut_init_def Redirect_Edge_def Color_Target_def
+
+lemma Redirect_Edge: 
+  "\<turnstile> Redirect_Edge pre(Color_Target)"
+apply (unfold mutator_defs)
+apply annhoare
+apply(simp_all)
+apply(force elim:Graph2)
+done
+
+lemma Color_Target:
+  "\<turnstile> Color_Target .{\<acute>Mut_init \<and> \<acute>z}."
+apply (unfold mutator_defs)
+apply annhoare
+apply(simp_all)
+done
+
+lemma Mutator: 
+ "\<turnstile> Mutator .{False}."
+apply(unfold Mutator_def)
+apply annhoare
+apply(simp_all add:Redirect_Edge Color_Target)
+apply(simp add:mutator_defs Redirect_Edge_def)
+done
+
+subsection {* The Collector *}
+
+text {* \noindent A constant @{text "M_init"} is used to give @{text "\<acute>Ma"} a
+suitable first value, defined as a list of nodes where only the @{text
+"Roots"} are black. *}
+
+consts  M_init :: nodes
+
+constdefs
+  Proper_M_init :: "gar_coll_state \<Rightarrow> bool"
+  "Proper_M_init \<equiv>  \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
+ 
+  Proper :: "gar_coll_state \<Rightarrow> bool"
+  "Proper \<equiv> \<guillemotleft> Proper_Roots \<acute>M \<and> Proper_Edges(\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<guillemotright>"
+
+  Safe :: "gar_coll_state \<Rightarrow> bool"
+  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
+
+lemmas collector_defs = Proper_M_init_def Proper_def Safe_def
+
+subsubsection {* Blackening the roots *}
+
+constdefs
+  Blacken_Roots :: " gar_coll_state ann_com"
+  "Blacken_Roots \<equiv> 
+  .{\<acute>Proper}.
+  \<acute>ind:=0;;
+  .{\<acute>Proper \<and> \<acute>ind=0}.
+  WHILE \<acute>ind<length \<acute>M 
+   INV .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M}.
+  DO .{\<acute>Proper \<and> (\<forall>i<\<acute>ind. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
+   IF \<acute>ind\<in>Roots THEN 
+   .{\<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}. 
+    \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
+   .{\<acute>Proper \<and> (\<forall>i<\<acute>ind+1. i \<in> Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
+    \<acute>ind:=\<acute>ind+1 
+  OD"
+
+lemma Blacken_Roots: 
+ "\<turnstile> Blacken_Roots .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}."
+apply (unfold Blacken_Roots_def)
+apply annhoare
+apply(simp_all add:collector_defs Graph_defs)
+apply safe
+apply(simp_all add:nth_list_update)
+   apply (erule less_SucE)
+    apply simp+
+  apply (erule less_SucE)
+   apply simp+
+ apply(drule le_imp_less_or_eq)
+ apply force
+apply force
+done
+
+subsubsection {* Propagating black *}
+
+constdefs
+  PBInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "PBInv \<equiv> \<guillemotleft> \<lambda>ind. \<acute>obc < Blacks \<acute>M \<or> (\<forall>i <ind. \<not>BtoW (\<acute>E!i, \<acute>M) \<or>
+   (\<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>"
+
+constdefs  
+  Propagate_Black_aux :: "gar_coll_state ann_com"
+  "Propagate_Black_aux \<equiv>
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
+  \<acute>ind:=0;;
+  .{\<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}. 
+  WHILE \<acute>ind<length \<acute>E 
+   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
+  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
+   IF \<acute>M!(fst (\<acute>E!\<acute>ind)) = Black THEN 
+    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black}.
+     \<acute>M:=\<acute>M[snd(\<acute>E!\<acute>ind):=Black];;
+    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+       \<and> \<acute>PBInv (\<acute>ind + 1) \<and> \<acute>ind<length \<acute>E}.
+     \<acute>ind:=\<acute>ind+1
+   FI
+  OD"
+
+lemma Propagate_Black_aux: 
+  "\<turnstile>  Propagate_Black_aux
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
+apply (unfold Propagate_Black_aux_def  PBInv_def collector_defs)
+apply annhoare
+apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
+      apply force
+     apply force
+    apply force
+--{* 4 subgoals left *}
+apply clarify
+apply(simp add:Proper_Edges_def Proper_Roots_def Graph6 Graph7 Graph8 Graph12)
+apply (erule disjE)
+ apply(rule disjI1)
+ apply(erule Graph13)
+ apply force
+apply (case_tac "M x ! snd (E x ! ind x)=Black")
+ apply (simp add: Graph10 BtoW_def)
+ apply (rule disjI2)
+ apply clarify
+ apply (erule less_SucE)
+  apply (erule_tac x=i in allE , erule (1) notE impE)
+  apply simp
+  apply clarify
+  apply (drule le_imp_less_or_eq)
+  apply (erule disjE)
+   apply (subgoal_tac "Suc (ind x)\<le>r")
+    apply fast
+   apply arith
+  apply fast
+ apply fast
+apply(rule disjI1)
+apply(erule subset_psubset_trans)
+apply(erule Graph11)
+apply fast
+--{* 3 subgoals left *}
+apply force
+apply force
+--{* last *}
+apply clarify
+apply simp
+apply(subgoal_tac "ind x = length (E x)")
+ apply (rotate_tac -1)
+ apply simp
+ apply(drule Graph1)
+   apply simp
+  apply clarify  
+ apply(erule allE, erule impE, assumption)
+  apply force
+ apply force
+apply arith
+done
+
+subsubsection {* Refining propagating black *}
+
+constdefs
+  Auxk :: "gar_coll_state \<Rightarrow> bool"
+  "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> 
+          \<acute>obc<Blacks \<acute>M \<or> (\<not>\<acute>z \<and> \<acute>ind=R \<and> snd(\<acute>E!R)=T  
+          \<and> (\<exists>r. \<acute>ind<r \<and> r<length \<acute>E \<and> BtoW(\<acute>E!r, \<acute>M))))\<guillemotright>"
+
+constdefs  
+  Propagate_Black :: " gar_coll_state ann_com"
+  "Propagate_Black \<equiv>
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
+  \<acute>ind:=0;;
+  .{\<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}.
+  WHILE \<acute>ind<length \<acute>E 
+   INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+         \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>E}.
+  DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+       \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
+   IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))=Black THEN 
+    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black}.
+     \<acute>k:=(snd(\<acute>E!\<acute>ind));;
+    .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black 
+      \<and> \<acute>Auxk}.
+     \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],, \<acute>ind:=\<acute>ind+1\<rangle>
+   ELSE .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+          \<and> \<acute>PBInv \<acute>ind \<and> \<acute>ind<length \<acute>E}. 
+         \<langle>IF (\<acute>M!(fst (\<acute>E!\<acute>ind)))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> 
+   FI
+  OD"
+
+lemma Propagate_Black: 
+  "\<turnstile>  Propagate_Black
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> ( \<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}."
+apply (unfold Propagate_Black_def  PBInv_def Auxk_def collector_defs)
+apply annhoare
+apply(simp_all add:Graph6 Graph7 Graph8 Graph12)
+       apply force
+      apply force
+     apply force
+--{* 5 subgoals left *}
+apply clarify
+apply(simp add:BtoW_def Proper_Edges_def)
+--{* 4 subgoals left *}
+apply clarify
+apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
+apply (erule disjE)
+ apply (rule disjI1)
+ apply (erule psubset_subset_trans)
+ apply (erule Graph9)
+apply (case_tac "M x!k x=Black")
+ apply (case_tac "M x ! snd (E x ! ind x)=Black")
+  apply (simp add: Graph10 BtoW_def)
+  apply (rule disjI2)
+  apply clarify
+  apply (erule less_SucE)
+   apply (erule_tac x=i in allE , erule (1) notE impE)
+   apply simp
+   apply clarify
+   apply (drule le_imp_less_or_eq)
+   apply (erule disjE)
+    apply (subgoal_tac "Suc (ind x)\<le>r")
+     apply fast
+    apply arith
+   apply fast
+  apply fast
+ apply (simp add: Graph10 BtoW_def)
+ apply (erule disjE)
+  apply (erule disjI1)
+ apply clarify
+ apply (erule less_SucE)
+  apply force
+ apply simp
+ apply (subgoal_tac "Suc R\<le>r")
+  apply fast
+ apply arith
+apply(rule disjI1)
+apply(erule subset_psubset_trans)
+apply(erule Graph11)
+apply fast
+--{* 3 subgoals left *}
+apply force
+--{* 2 subgoals left *}
+apply clarify
+apply(simp add:Proper_Edges_def Graph6 Graph7 Graph8 Graph12)
+apply (erule disjE)
+ apply fast
+apply clarify
+apply (erule less_SucE)
+ apply (erule_tac x=i in allE , erule (1) notE impE)
+ apply simp
+ apply clarify
+ apply (drule le_imp_less_or_eq)
+ apply (erule disjE)
+  apply (subgoal_tac "Suc (ind x)\<le>r")
+   apply fast
+  apply arith
+ apply (simp add: BtoW_def)
+apply (simp add: BtoW_def)
+--{* last *}
+apply clarify
+apply simp
+apply(subgoal_tac "ind x = length (E x)")
+ apply (rotate_tac -1)
+ apply simp
+ apply(drule Graph1)
+   apply simp
+  apply clarify  
+ apply(erule allE, erule impE, assumption)
+  apply force
+ apply force
+apply arith
+done
+
+subsubsection {* Counting black nodes *}
+
+constdefs
+  CountInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
+
+constdefs
+  Count :: " gar_coll_state ann_com"
+  "Count \<equiv>
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={}}.
+  \<acute>ind:=0;;
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+   \<and> length \<acute>Ma=length \<acute>M \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>bc={} 
+   \<and> \<acute>ind=0}.
+   WHILE \<acute>ind<length \<acute>M 
+     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+           \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+           \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
+           \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind\<le>length \<acute>M}.
+   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+         \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+         \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind 
+         \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}. 
+       IF \<acute>M!\<acute>ind=Black 
+          THEN .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+                 \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+                 \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv \<acute>ind
+                 \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
+          \<acute>bc:=insert \<acute>ind \<acute>bc
+       FI;;
+      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+        \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+        \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>CountInv (\<acute>ind+1)
+        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe) \<and> \<acute>ind<length \<acute>M}.
+      \<acute>ind:=\<acute>ind+1
+   OD"
+
+lemma Count: 
+  "\<turnstile> Count 
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+   \<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
+   \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}."
+apply(unfold Count_def)
+apply annhoare
+apply(simp_all add:CountInv_def Graph6 Graph7 Graph8 Graph12 Blacks_def collector_defs)
+      apply force
+     apply force
+    apply force
+   apply clarify
+   apply simp
+   apply(fast elim:less_SucE)
+  apply clarify
+  apply simp
+  apply(fast elim:less_SucE)
+ apply force
+apply force
+done
+
+subsubsection {* Appending garbage nodes to the free list *}
+
+consts Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
+
+axioms
+  Append_to_free0: "length (Append_to_free (i, e)) = length e"
+  Append_to_free1: "Proper_Edges (m, e) 
+                   \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
+  Append_to_free2: "i \<notin> Reach e 
+     \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
+
+constdefs
+  AppendInv :: "gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "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>"
+
+constdefs
+  Append :: " gar_coll_state ann_com"
+   "Append \<equiv>
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
+  \<acute>ind:=0;;
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
+    WHILE \<acute>ind<length \<acute>M 
+      INV .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
+    DO .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
+       IF \<acute>M!\<acute>ind=Black THEN 
+          .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
+          \<acute>M:=\<acute>M[\<acute>ind:=White] 
+       ELSE .{\<acute>Proper \<and> \<acute>AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}.
+              \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
+       FI;;
+     .{\<acute>Proper \<and> \<acute>AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
+       \<acute>ind:=\<acute>ind+1
+    OD"
+
+lemma Append: 
+  "\<turnstile> Append .{\<acute>Proper}."
+apply(unfold Append_def AppendInv_def)
+apply annhoare
+apply(simp_all add:collector_defs Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+       apply(force simp:Blacks_def nth_list_update)
+      apply force
+     apply force
+    apply(force simp add:Graph_defs)
+   apply force
+  apply clarify
+  apply simp
+  apply(rule conjI)
+   apply (erule Append_to_free1)
+  apply clarify
+  apply (drule_tac n = "i" in Append_to_free2)
+  apply force
+ apply force
+apply force
+done
+
+subsubsection {* Correctness of the Collector *}
+
+constdefs 
+  Collector :: " gar_coll_state ann_com"
+  "Collector \<equiv>
+.{\<acute>Proper}.  
+ WHILE True INV .{\<acute>Proper}. 
+ DO  
+  Blacken_Roots;; 
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M}.  
+   \<acute>obc:={};; 
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}. 
+   \<acute>bc:=Roots;; 
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
+   \<acute>Ma:=M_init;;  
+  .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>Ma=M_init}. 
+   WHILE \<acute>obc\<noteq>\<acute>bc  
+     INV .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M 
+           \<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 \<and> (\<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}. 
+   DO .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M}.
+       \<acute>obc:=\<acute>bc;;
+       Propagate_Black;; 
+      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+        \<and> (\<acute>obc < Blacks \<acute>M \<or> \<acute>Safe)}. 
+       \<acute>Ma:=\<acute>M;;
+      .{\<acute>Proper \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma 
+        \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and> length \<acute>Ma=length \<acute>M 
+        \<and> ( \<acute>obc < Blacks \<acute>Ma \<or> \<acute>Safe)}.
+       \<acute>bc:={};;
+       Count 
+   OD;; 
+  Append  
+ OD"
+
+lemma Collector: 
+  "\<turnstile> Collector .{False}."
+apply(unfold Collector_def)
+apply annhoare
+apply(simp_all add: Blacken_Roots Propagate_Black Count Append)
+apply(simp_all add:Blacken_Roots_def Propagate_Black_def Count_def Append_def collector_defs)
+   apply (force simp add: Proper_Roots_def)
+  apply force
+ apply force
+apply clarify
+apply (erule disjE)
+apply(simp add:psubsetI)
+ apply(force dest:subset_antisym)
+apply force
+done
+
+subsection {* Interference Freedom *}
+
+lemmas modules = Redirect_Edge_def Color_Target_def Blacken_Roots_def 
+                 Propagate_Black_def Count_def Append_def
+lemmas Invariants = PBInv_def Auxk_def CountInv_def AppendInv_def
+lemmas abbrev = collector_defs mutator_defs Invariants
+
+lemma interfree_Blacken_Roots_Redirect_Edge: 
+ "interfree_aux (Some Blacken_Roots, {}, Some Redirect_Edge)"
+apply (unfold modules)
+apply interfree_aux
+apply safe
+apply (simp_all add:Graph6 Graph12 abbrev)
+done
+
+lemma interfree_Redirect_Edge_Blacken_Roots: 
+  "interfree_aux (Some Redirect_Edge, {}, Some Blacken_Roots)"
+apply (unfold modules)
+apply interfree_aux
+apply safe
+apply(simp add:abbrev)+
+done
+
+lemma interfree_Blacken_Roots_Color_Target: 
+  "interfree_aux (Some Blacken_Roots, {}, Some Color_Target)"
+apply (unfold modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:Graph7 Graph8 nth_list_update abbrev)
+done
+
+lemma interfree_Color_Target_Blacken_Roots: 
+  "interfree_aux (Some Color_Target, {}, Some Blacken_Roots)"
+apply (unfold modules )
+apply interfree_aux
+apply safe
+apply(simp add:abbrev)+
+done
+
+lemma interfree_Propagate_Black_Redirect_Edge: 
+  "interfree_aux (Some Propagate_Black, {}, Some Redirect_Edge)"
+apply (unfold modules )
+apply interfree_aux
+--{* 11 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(erule conjE)+
+apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
+ apply(erule Graph4) 
+   apply(simp)+
+  apply (simp add:BtoW_def)
+ apply (simp add:BtoW_def)
+apply(rule conjI)
+ apply (force simp add:BtoW_def)
+apply(erule Graph4)
+   apply simp+
+  apply (simp add:BtoW_def)
+  apply force
+ apply (simp add:BtoW_def)
+ apply force
+apply (simp add:BtoW_def)
+apply force
+--{* 7 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(erule conjE)+
+apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
+ apply(erule Graph4) 
+   apply(simp)+
+  apply (simp add:BtoW_def)
+ apply (simp add:BtoW_def)
+apply(rule conjI)
+ apply (force simp add:BtoW_def)
+apply(erule Graph4)
+   apply simp+
+  apply (simp add:BtoW_def)
+  apply force
+ apply (simp add:BtoW_def)
+ apply force
+apply (simp add:BtoW_def)
+apply force
+--{* 6 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(erule conjE)+
+apply(rule conjI)
+ apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
+  apply(erule Graph4) 
+    apply(simp)+
+   apply (simp add:BtoW_def)
+  apply (simp add:BtoW_def)
+ apply(rule conjI)
+  apply (force simp add:BtoW_def)
+ apply(erule Graph4)
+    apply simp+
+   apply (simp add:BtoW_def)
+   apply force
+  apply (simp add:BtoW_def)
+  apply force
+ apply (simp add:BtoW_def)
+ apply force
+apply(simp add:BtoW_def nth_list_update) 
+apply force
+--{* 5 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+--{* 4 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(rule conjI)
+ apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
+  apply(erule Graph4) 
+    apply(simp)+
+   apply (simp add:BtoW_def)
+  apply (simp add:BtoW_def)
+ apply(rule conjI)
+  apply (force simp add:BtoW_def)
+ apply(erule Graph4)
+    apply simp+
+   apply (simp add:BtoW_def)
+   apply force
+  apply (simp add:BtoW_def)
+  apply force
+ apply (simp add:BtoW_def)
+ apply force
+apply(rule conjI)
+ apply(simp add:nth_list_update)
+ apply force
+apply(rule impI, rule impI, erule disjE, erule disjI1, case_tac "R = (ind x)" ,case_tac "M x ! T = Black")
+  apply(force simp add:BtoW_def)
+ apply(case_tac "M x !snd (E x ! ind x)=Black")
+  apply(rule disjI2)
+  apply simp
+  apply (erule Graph5)
+  apply simp+
+ apply(force simp add:BtoW_def)
+apply(force simp add:BtoW_def)
+--{* 3 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+--{* 2 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12)
+apply(erule disjE, erule disjI1, rule disjI2, rule allI, (rule impI)+, case_tac "R=i", rule conjI, erule sym)
+ apply clarify
+ apply(erule Graph4) 
+   apply(simp)+
+  apply (simp add:BtoW_def)
+ apply (simp add:BtoW_def)
+apply(rule conjI)
+ apply (force simp add:BtoW_def)
+apply(erule Graph4)
+   apply simp+
+  apply (simp add:BtoW_def)
+  apply force
+ apply (simp add:BtoW_def)
+ apply force
+apply (simp add:BtoW_def)
+apply force
+--{* 1 subgoals left *}
+apply(simp add:abbrev)
+done
+
+lemma interfree_Redirect_Edge_Propagate_Black: 
+  "interfree_aux (Some Redirect_Edge, {}, Some Propagate_Black)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev)+
+done
+
+lemma interfree_Propagate_Black_Color_Target: 
+  "interfree_aux (Some Propagate_Black, {}, Some Color_Target)"
+apply (unfold modules )
+apply interfree_aux
+--{* 11 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)+
+apply(erule conjE)+
+apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
+      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
+      erule allE, erule impE, assumption, erule impE, assumption, 
+      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
+--{* 7 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+apply(erule conjE)+
+apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
+      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
+      erule allE, erule impE, assumption, erule impE, assumption, 
+      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
+--{* 6 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+apply clarify
+apply (rule conjI)
+ apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
+      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
+      erule allE, erule impE, assumption, erule impE, assumption, 
+      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
+apply(simp add:nth_list_update)
+--{* 5 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+--{* 4 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+apply (rule conjI)
+ apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
+      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
+      erule allE, erule impE, assumption, erule impE, assumption, 
+      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
+apply(rule conjI)
+apply(simp add:nth_list_update)
+apply(rule impI,rule impI, case_tac "M x!T=Black",rotate_tac -1, force simp add: BtoW_def Graph10, 
+      erule subset_psubset_trans, erule Graph11, force)
+--{* 3 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+--{* 2 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+apply(erule disjE,rule disjI1,erule psubset_subset_trans,erule Graph9, 
+      case_tac "M x!T=Black", rule disjI2,rotate_tac -1, simp add: Graph10, clarify,
+      erule allE, erule impE, assumption, erule impE, assumption, 
+      simp add:BtoW_def, rule disjI1, erule subset_psubset_trans, erule Graph11, force) 
+--{* 3 subgoals left *}
+apply(simp add:abbrev)
+done
+
+lemma interfree_Color_Target_Propagate_Black: 
+  "interfree_aux (Some Color_Target, {}, Some Propagate_Black)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev)+
+done
+
+lemma interfree_Count_Redirect_Edge: 
+  "interfree_aux (Some Count, {}, Some Redirect_Edge)"
+apply (unfold modules)
+apply interfree_aux
+--{* 9 subgoals left *}
+apply(simp_all add:abbrev Graph6 Graph12)
+--{* 6 subgoals left *}
+apply(clarify, simp add:abbrev Graph6 Graph12,
+      erule disjE,erule disjI1,rule disjI2,rule subset_trans, erule Graph3,force,force)+
+done
+
+lemma interfree_Redirect_Edge_Count: 
+  "interfree_aux (Some Redirect_Edge, {}, Some Count)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify,simp add:abbrev)+
+apply(simp add:abbrev)
+done
+
+lemma interfree_Count_Color_Target: 
+  "interfree_aux (Some Count, {}, Some Color_Target)"
+apply (unfold modules )
+apply interfree_aux
+--{* 9 subgoals left *}
+apply(simp_all add:abbrev Graph7 Graph8 Graph12)
+--{* 6 subgoals left *}
+apply(clarify,simp add:abbrev Graph7 Graph8 Graph12,
+      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)+
+--{* 2 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12)
+apply(rule conjI)
+ apply(erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9) 
+apply(simp add:nth_list_update)
+--{* 1 subgoals left *}
+apply(clarify, simp add:abbrev Graph7 Graph8 Graph12,
+      erule disjE, erule disjI1, rule disjI2,erule subset_trans, erule Graph9)
+done
+
+lemma interfree_Color_Target_Count: 
+  "interfree_aux (Some Color_Target, {}, Some Count)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev)+
+apply(simp add:abbrev)
+done
+
+lemma interfree_Append_Redirect_Edge: 
+  "interfree_aux (Some Append, {}, Some Redirect_Edge)"
+apply (unfold modules )
+apply interfree_aux
+apply( simp_all add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12)
+apply(clarify, simp add:abbrev Graph6 Append_to_free0 Append_to_free1 Graph12, force dest:Graph3)+
+done
+
+lemma interfree_Redirect_Edge_Append: 
+  "interfree_aux (Some Redirect_Edge, {}, Some Append)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev Append_to_free0)+
+apply (force simp add: Append_to_free2)
+apply(clarify, simp add:abbrev Append_to_free0)+
+done
+
+lemma interfree_Append_Color_Target: 
+  "interfree_aux (Some Append, {}, Some Color_Target)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)+
+apply(simp add:abbrev Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12 nth_list_update)
+done
+
+lemma interfree_Color_Target_Append: 
+  "interfree_aux (Some Color_Target, {}, Some Append)"
+apply (unfold modules )
+apply interfree_aux
+apply(clarify, simp add:abbrev Append_to_free0)+
+apply (force simp add: Append_to_free2)
+apply(clarify,simp add:abbrev Append_to_free0)+
+done
+
+lemmas collector_mutator_interfree = 
+ interfree_Blacken_Roots_Redirect_Edge interfree_Blacken_Roots_Color_Target 
+ interfree_Propagate_Black_Redirect_Edge interfree_Propagate_Black_Color_Target  
+ interfree_Count_Redirect_Edge interfree_Count_Color_Target 
+ interfree_Append_Redirect_Edge interfree_Append_Color_Target 
+ interfree_Redirect_Edge_Blacken_Roots interfree_Color_Target_Blacken_Roots 
+ interfree_Redirect_Edge_Propagate_Black interfree_Color_Target_Propagate_Black  
+ interfree_Redirect_Edge_Count interfree_Color_Target_Count 
+ interfree_Redirect_Edge_Append interfree_Color_Target_Append
+
+subsubsection {* Interference freedom Collector-Mutator *}
+
+lemma interfree_Collector_Mutator:
+ "interfree_aux (Some Collector, {}, Some Mutator)"
+apply(unfold Collector_def Mutator_def)
+apply interfree_aux
+apply(simp_all add:collector_mutator_interfree)
+apply(unfold modules collector_defs mutator_defs)
+apply(tactic  {* TRYALL (interfree_aux_tac) *})
+--{* 32 subgoals left *}
+apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+--{* 20 subgoals left *}
+apply(tactic{* TRYALL Clarify_tac *})
+apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+apply(tactic {* TRYALL (etac disjE) *})
+apply simp_all
+apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac subset_trans,etac (thm "Graph3"),Force_tac, assume_tac]) *})
+apply(tactic {* TRYALL(EVERY'[rtac disjI2,etac subset_trans,rtac (thm "Graph9"),Force_tac]) *})
+apply(tactic {* TRYALL(EVERY'[rtac disjI1,etac psubset_subset_trans,rtac (thm "Graph9"),Force_tac]) *})
+done
+
+subsubsection {* Interference freedom Mutator-Collector *}
+
+lemma interfree_Mutator_Collector:
+ "interfree_aux (Some Mutator, {}, Some Collector)"
+apply(unfold Collector_def Mutator_def)
+apply interfree_aux
+apply(simp_all add:collector_mutator_interfree)
+apply(unfold modules collector_defs mutator_defs)
+apply(tactic  {* TRYALL (interfree_aux_tac) *})
+--{* 64 subgoals left *}
+apply(simp_all add:nth_list_update Invariants Append_to_free0)+
+apply(tactic{* TRYALL Clarify_tac *})
+--{* 4 subgoals left *}
+apply force
+apply(simp add:Append_to_free2)
+apply force
+apply(simp add:Append_to_free2)
+done
+
+subsubsection {* The Garbage Collection algorithm *}
+
+text {* In total there are 289 verification conditions.  *}
+
+lemma Gar_Coll: 
+  "\<parallel>- .{\<acute>Proper \<and> \<acute>Mut_init \<and> \<acute>z}.  
+  COBEGIN  
+   Collector
+  .{False}.
+ \<parallel>  
+   Mutator
+  .{False}. 
+ COEND 
+  .{False}."
+apply oghoare
+apply(force simp add: Mutator_def Collector_def modules)
+apply(rule Collector)
+apply(rule Mutator)
+apply(simp add:interfree_Collector_Mutator)
+apply(simp add:interfree_Mutator_Collector)
+apply force
+done
+
+end
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/Graph.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/Graph.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,426 @@
+
+header {* \chapter{Case Study: Single and Multi-Mutator Garbage Collection Algorithms}
+
+\section {Formalization of the Memory} *}
+
+theory Graph = Main:
+
+datatype node = Black | White
+
+types 
+  nodes = "node list"
+  edge  = "nat \<times> nat"
+  edges = "edge list"
+
+consts Roots :: "nat set"
+
+constdefs
+  Proper_Roots :: "nodes \<Rightarrow> bool"
+  "Proper_Roots M \<equiv> Roots\<noteq>{} \<and> Roots \<subseteq> {i. i<length M}"
+
+  Proper_Edges :: "(nodes \<times> edges) \<Rightarrow> bool"
+  "Proper_Edges \<equiv> (\<lambda>(M,E). \<forall>i<length E. fst(E!i)<length M \<and> snd(E!i)<length M)"
+
+  BtoW :: "(edge \<times> nodes) \<Rightarrow> bool"
+  "BtoW \<equiv> (\<lambda>(e,M). (M!fst e)=Black \<and> (M!snd e)\<noteq>Black)"
+
+  Blacks :: "nodes \<Rightarrow> nat set"
+  "Blacks M \<equiv> {i. i<length M \<and> M!i=Black}"
+
+  Reach :: "edges \<Rightarrow> nat set"
+  "Reach E \<equiv> {x. (\<exists>path. 1<length path \<and> path!(length path - 1)\<in>Roots \<and> x=path!0
+              \<and> (\<forall>i<length path - 1. (\<exists>j<length E. E!j=(path!(i+1), path!i))))
+	      \<or> x\<in>Roots}"
+
+text{* Reach: the set of reachable nodes is the set of Roots together with the
+nodes reachable from some Root by a path represented by a list of
+  nodes (at least two since we traverse at least one edge), where two
+consecutive nodes correspond to an edge in E. *}
+
+subsection {* Proofs about Graphs *}
+
+lemmas Graph_defs= Blacks_def Proper_Roots_def Proper_Edges_def BtoW_def
+declare Graph_defs [simp]
+
+subsubsection{* Graph 1. *}
+
+lemma Graph1_aux [rule_format]: 
+  "\<lbrakk> Roots\<subseteq>Blacks M; \<forall>i<length E. \<not>BtoW(E!i,M)\<rbrakk>
+  \<Longrightarrow> 1< length path \<longrightarrow> (path!(length path - 1))\<in>Roots \<longrightarrow>  
+  (\<forall>i<length path - 1. (\<exists>j. j < length E \<and> E!j=(path!(Suc i), path!i))) 
+  \<longrightarrow> M!(path!0) = Black"
+apply(induct_tac "path")
+ apply force
+apply clarify
+apply simp
+apply(case_tac "list")
+ apply force
+apply simp
+apply(rotate_tac -1)
+apply(erule_tac x = "0" in all_dupE)
+apply simp
+apply clarify
+apply(erule allE , erule (1) notE impE)
+apply simp
+apply(erule mp)
+apply(case_tac "lista")
+ apply force
+apply simp
+apply(erule mp)
+apply clarify
+apply(erule_tac x = "Suc i" in allE)
+apply force
+done
+
+lemma Graph1: 
+  "\<lbrakk>Roots\<subseteq>Blacks M; Proper_Edges(M, E); \<forall>i<length E. \<not>BtoW(E!i,M) \<rbrakk> 
+  \<Longrightarrow> Reach E\<subseteq>Blacks M"
+apply (unfold Reach_def)
+apply simp
+apply clarify
+apply(erule disjE)
+ apply clarify
+ apply(rule conjI)
+  apply(subgoal_tac "0< length path - Suc 0")
+   apply(erule allE , erule (1) notE impE)
+   apply force
+  apply simp
+ apply(rule Graph1_aux)
+apply auto
+done
+
+subsubsection{* Graph 2. *}
+
+lemma Ex_first_occurrence [rule_format]: 
+  "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i. i<m \<longrightarrow> \<not> P i))";
+apply(rule nat_less_induct)
+apply clarify
+apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
+apply auto
+done
+
+lemma Compl_lemma: "(n::nat)\<le>l \<Longrightarrow> (\<exists>m. m\<le>l \<and> n=l - m)"
+apply(rule_tac x = "l - n" in exI)
+apply arith
+done
+
+lemma Ex_last_occurrence: 
+  "\<lbrakk>P (n::nat); n\<le>l\<rbrakk> \<Longrightarrow> (\<exists>m. P (l - m) \<and> (\<forall>i. i<m \<longrightarrow> \<not>P (l - i)))"
+apply(drule Compl_lemma)
+apply clarify
+apply(erule Ex_first_occurrence)
+done
+
+lemma Graph2: 
+  "\<lbrakk>T \<in> Reach E; R<length E\<rbrakk> \<Longrightarrow> T \<in> Reach (E[R:=(fst(E!R), T)])"
+apply (unfold Reach_def)
+apply clarify
+apply simp
+apply(case_tac "\<forall>z<length path. fst(E!R)\<noteq>path!z")
+ apply(rule_tac x = "path" in exI)
+ apply simp
+ apply clarify
+ apply(erule allE , erule (1) notE impE)
+ apply clarify
+ apply(rule_tac x = "j" in exI)
+ apply(case_tac "j=R")
+  apply(erule_tac x = "Suc i" in allE)
+  apply simp
+  apply arith
+ apply (force simp add:nth_list_update)
+apply simp
+apply(erule exE)
+apply(subgoal_tac "z \<le> length path - Suc 0")
+ prefer 2 apply arith
+apply(drule_tac P = "\<lambda>m. m<length path \<and> fst(E!R)=path!m" in Ex_last_occurrence)
+ apply assumption
+apply clarify
+apply simp
+apply(rule_tac x = "(path!0)#(drop (length path - Suc m) path)" in exI)
+apply simp
+apply(case_tac "length path - (length path - Suc m)")
+ apply arith
+apply simp
+apply(subgoal_tac "(length path - Suc m) + nat \<le> length path")
+ prefer 2 apply arith
+apply(drule nth_drop)
+apply simp
+apply(subgoal_tac "length path - Suc m + nat = length path - Suc 0")
+ prefer 2 apply arith 
+apply simp
+apply clarify
+apply(case_tac "i")
+ apply(force simp add: nth_list_update)
+apply simp
+apply(subgoal_tac "(length path - Suc m) + nata \<le> length path")
+ prefer 2 apply arith
+apply simp
+apply(subgoal_tac "(length path - Suc m) + (Suc nata) \<le> length path")
+ prefer 2 apply arith
+apply simp
+apply(erule_tac x = "length path - Suc m + nata" in allE)
+apply simp
+apply clarify
+apply(rule_tac x = "j" in exI)
+apply(case_tac "R=j")
+ prefer 2 apply force
+apply simp
+apply(drule_tac t = "path ! (length path - Suc m)" in sym)
+apply simp
+apply(case_tac " length path - Suc 0 < m")
+ apply(subgoal_tac "(length path - Suc m)=0")
+  prefer 2 apply arith
+ apply(rotate_tac -1)
+ apply(simp del: diff_is_0_eq)
+ apply(subgoal_tac "Suc nata\<le>nat")
+ prefer 2 apply arith
+ apply(drule_tac n = "Suc nata" in Compl_lemma)
+ apply clarify
+ apply force
+apply(drule leI)
+apply(subgoal_tac "Suc (length path - Suc m + nata)=(length path - Suc 0) - (m - Suc nata)")
+ apply(erule_tac x = "m - (Suc nata)" in allE)
+ apply(case_tac "m")
+  apply simp
+ apply simp
+ apply(subgoal_tac "natb - nata < Suc natb")
+  prefer 2 apply(erule thin_rl)+ apply arith
+ apply simp
+ apply(case_tac "length path")
+  apply force
+ apply simp
+apply(frule_tac i1 = "length path" and j1 = "length path - Suc 0" and k1 = "m" in diff_diff_right [THEN mp])
+apply(erule_tac V = "length path - Suc m + nat = length path - Suc 0" in thin_rl)
+apply simp
+apply arith
+done
+
+
+subsubsection{* Graph 3. *}
+
+lemma Graph3: 
+  "\<lbrakk> T\<in>Reach E; R<length E \<rbrakk> \<Longrightarrow> Reach(E[R:=(fst(E!R),T)]) \<subseteq> Reach E"
+apply (unfold Reach_def)
+apply clarify
+apply simp
+apply(case_tac "\<exists>i<length path - 1. (fst(E!R),T)=(path!(Suc i),path!i)")
+--{* the changed edge is part of the path *}
+ apply(erule exE)
+ apply(drule_tac P = "\<lambda>i. i<length path - 1 \<and> (fst(E!R),T)=(path!Suc i,path!i)" in Ex_first_occurrence)
+ apply clarify
+ apply(erule disjE)
+--{* T is NOT a root *}
+  apply clarify
+  apply(rule_tac x = "(take m path)@patha" in exI)
+  apply(subgoal_tac "\<not>(length path\<le>m)")
+   prefer 2 apply arith
+  apply(simp add: min_def)
+  apply(rule conjI)
+   apply(subgoal_tac "\<not>(m + length patha - 1 < m)")
+    prefer 2 apply arith
+   apply(simp add: nth_append min_def)
+  apply(rule conjI)
+   apply(case_tac "m")
+    apply force
+   apply(case_tac "path")
+    apply force
+   apply force
+  apply clarify
+  apply(case_tac "Suc i\<le>m")
+   apply(erule_tac x = "i" in allE)
+   apply simp
+   apply clarify
+   apply(rule_tac x = "j" in exI)
+   apply(case_tac "Suc i<m")
+    apply(simp add: nth_append min_def)
+    apply(case_tac "R=j")
+     apply(simp add: nth_list_update)
+     apply(case_tac "i=m")
+      apply force
+     apply(erule_tac x = "i" in allE)
+     apply force
+    apply(force simp add: nth_list_update)
+   apply(simp add: nth_append min_def)
+   apply(subgoal_tac "i=m - 1")
+    prefer 2 apply arith
+   apply(case_tac "R=j")
+    apply(erule_tac x = "m - 1" in allE)
+    apply(simp add: nth_list_update)
+   apply(force simp add: nth_list_update)
+  apply(simp add: nth_append min_def)
+  apply(rotate_tac -4)
+  apply(erule_tac x = "i - m" in allE)
+  apply(subgoal_tac "Suc (i - m)=(Suc i - m)" )
+    prefer 2 apply arith
+   apply simp
+  apply(erule mp)
+  apply arith
+--{* T is a root *}
+ apply(case_tac "m=0")
+  apply force
+ apply(rule_tac x = "take (Suc m) path" in exI)
+ apply(subgoal_tac "\<not>(length path\<le>Suc m)" )
+  prefer 2 apply arith
+ apply(simp add: min_def)
+ apply clarify
+ apply(erule_tac x = "i" in allE)
+ apply simp
+ apply clarify
+ apply(case_tac "R=j")
+  apply(force simp add: nth_list_update)
+ apply(force simp add: nth_list_update)
+--{* the changed edge is not part of the path *}
+apply(rule_tac x = "path" in exI)
+apply simp
+apply clarify
+apply(erule_tac x = "i" in allE)
+apply clarify
+apply(case_tac "R=j")
+ apply(erule_tac x = "i" in allE)
+ apply simp
+apply(force simp add: nth_list_update)
+done
+
+subsubsection{* Graph 4. *}
+
+lemma Graph4: 
+  "\<lbrakk>T \<in> Reach E; Roots\<subseteq>Blacks M; I\<le>length E; T<length M; R<length E; 
+  \<forall>i<I. \<not>BtoW(E!i,M); R<I; M!fst(E!R)=Black; M!T\<noteq>Black\<rbrakk> \<Longrightarrow> 
+  (\<exists>r. I\<le>r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
+apply (unfold Reach_def)
+apply simp
+apply(erule disjE)
+ prefer 2 apply force
+apply clarify
+--{* there exist a black node in the path to T *}
+apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
+ apply(erule exE)
+ apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
+ apply clarify
+ apply(case_tac "ma")
+  apply force
+ apply simp
+ apply(case_tac "length path")
+  apply force
+ apply simp
+ apply(rotate_tac -5)
+ apply(erule_tac x = "nat" in allE)
+ apply simp
+ apply clarify
+ apply(erule_tac x = "nat" in allE)
+ apply simp
+ apply(case_tac "j<I")
+  apply(erule_tac x = "j" in allE)
+  apply force
+ apply(rule_tac x = "j" in exI)
+ apply(force  simp add: nth_list_update)
+apply simp
+apply(rotate_tac -1)
+apply(erule_tac x = "length path - 1" in allE)
+apply(case_tac "length path")
+ apply force
+apply force
+done
+
+subsubsection {* Graph 5. *}
+
+lemma Graph5: 
+  "\<lbrakk> T \<in> Reach E ; Roots \<subseteq> Blacks M; \<forall>i<R. \<not>BtoW(E!i,M); T<length M; 
+    R<length E; M!fst(E!R)=Black; M!snd(E!R)=Black; M!T \<noteq> Black\<rbrakk> 
+   \<Longrightarrow> (\<exists>r. R<r \<and> r<length E \<and> BtoW(E[R:=(fst(E!R),T)]!r,M))"
+apply (unfold Reach_def)
+apply simp
+apply(erule disjE)
+ prefer 2 apply force
+apply clarify
+--{* there exist a black node in the path to T*}
+apply(case_tac "\<exists>m<length path. M!(path!m)=Black")
+ apply(erule exE)
+ apply(drule_tac P = "\<lambda>m. m<length path \<and> M!(path!m)=Black" in Ex_first_occurrence)
+ apply clarify
+ apply(case_tac "ma")
+  apply force
+ apply simp
+ apply(case_tac "length path")
+  apply force
+ apply simp
+ apply(rotate_tac -5)
+ apply(erule_tac x = "nat" in allE)
+ apply simp
+ apply clarify
+ apply(erule_tac x = "nat" in allE)
+ apply simp
+ apply(case_tac "j\<le>R")
+  apply(drule le_imp_less_or_eq)
+  apply(erule disjE)
+   apply(erule allE , erule (1) notE impE)
+   apply force
+  apply force
+ apply(rule_tac x = "j" in exI)
+ apply(force  simp add: nth_list_update)
+apply simp
+apply(rotate_tac -1)
+apply(erule_tac x = "length path - 1" in allE)
+apply(case_tac "length path")
+ apply force
+apply force
+done
+
+subsubsection {* Graph 6, 7, 8. *}
+
+lemma Graph6: 
+ "\<lbrakk>Proper_Edges(M,E); R<length E ; T<length M\<rbrakk> \<Longrightarrow> Proper_Edges(M,E[R:=(fst(E!R),T)])"
+apply (unfold Proper_Edges_def)
+ apply(force  simp add: nth_list_update)
+done
+
+lemma Graph7: 
+ "\<lbrakk>Proper_Edges(M,E)\<rbrakk> \<Longrightarrow> Proper_Edges(M[T:=a],E)"
+apply (unfold Proper_Edges_def)
+apply force
+done
+
+lemma Graph8: 
+ "\<lbrakk>Proper_Roots(M)\<rbrakk> \<Longrightarrow> Proper_Roots(M[T:=a])"
+apply (unfold Proper_Roots_def)
+apply force
+done
+
+text{* Some specific lemmata for the verification of garbage collection algorithms. *}
+
+lemma Graph9: "j<length M \<Longrightarrow> Blacks M\<subseteq>Blacks (M[j := Black])"
+apply (unfold Blacks_def)
+ apply(force simp add: nth_list_update)
+done
+
+lemma Graph10 [rule_format (no_asm)]: "\<forall>i. M!i=a \<longrightarrow>M[i:=a]=M"
+apply(induct_tac "M")
+apply auto
+apply(case_tac "i")
+apply auto
+done
+
+lemma Graph11 [rule_format (no_asm)]: 
+  "\<lbrakk> M!j\<noteq>Black;j<length M\<rbrakk> \<Longrightarrow> Blacks M \<subset> Blacks (M[j := Black])"
+apply (unfold Blacks_def)
+apply(rule psubsetI)
+ apply(force simp add: nth_list_update)
+apply safe
+apply(erule_tac c = "j" in equalityCE)
+apply auto
+done
+
+lemma Graph12: "\<lbrakk>a\<subseteq>Blacks M;j<length M\<rbrakk> \<Longrightarrow> a\<subseteq>Blacks (M[j := Black])"
+apply (unfold Blacks_def)
+apply(force simp add: nth_list_update)
+done
+
+lemma Graph13: "\<lbrakk>a\<subset> Blacks M;j<length M\<rbrakk> \<Longrightarrow> a \<subset> Blacks (M[j := Black])"
+apply (unfold Blacks_def)
+apply(erule psubset_subset_trans)
+apply(force simp add: nth_list_update)
+done
+
+declare Graph_defs [simp del]
+
+end
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/Mul_Gar_Coll.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/Mul_Gar_Coll.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,1291 @@
+
+header {* \section{The Multi-Mutator Case} *}
+
+theory Mul_Gar_Coll = Graph + OG_Syntax:
+
+text {*  The full theory takes aprox. 18 minutes.  *}
+
+record mut =
+  Z :: bool
+  R :: nat
+  T :: nat
+
+text {* Declaration of variables: *}
+
+record mul_gar_coll_state =
+  M :: nodes
+  E :: edges
+  bc :: "nat set"
+  obc :: "nat set"
+  Ma :: nodes
+  ind :: nat 
+  k :: nat
+  q :: nat
+  l :: nat
+  Muts :: "mut list"
+
+subsection {* The Mutators *}
+
+constdefs 
+  Mul_mut_init :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "Mul_mut_init \<equiv> \<guillemotleft> \<lambda>n. n=length \<acute>Muts \<and> (\<forall>i<n. R (\<acute>Muts!i)<length \<acute>E 
+                          \<and> T (\<acute>Muts!i)<length \<acute>M) \<guillemotright>"
+
+  Mul_Redirect_Edge  :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
+  "Mul_Redirect_Edge j n \<equiv>
+  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.
+  \<langle>IF T(\<acute>Muts!j) \<in> Reach \<acute>E THEN  
+  \<acute>E:= \<acute>E[R (\<acute>Muts!j):= (fst (\<acute>E!R(\<acute>Muts!j)), T (\<acute>Muts!j))] FI,, 
+  \<acute>Muts:= \<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=False\<rparr>]\<rangle>"
+
+  Mul_Color_Target :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com"
+  "Mul_Color_Target j n \<equiv>
+  .{\<acute>Mul_mut_init n \<and> \<not> Z (\<acute>Muts!j)}. 
+  \<langle>\<acute>M:=\<acute>M[T (\<acute>Muts!j):=Black],, \<acute>Muts:=\<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=True\<rparr>]\<rangle>"
+
+  Mul_Mutator :: "nat \<Rightarrow> nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Mutator j n \<equiv>
+  .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
+  WHILE True  
+    INV .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}.  
+  DO Mul_Redirect_Edge j n ;; 
+     Mul_Color_Target j n 
+  OD"
+
+lemmas mul_mutator_defs = Mul_mut_init_def Mul_Redirect_Edge_def Mul_Color_Target_def 
+
+subsubsection {* Correctness of the proof outline of one mutator *}
+
+lemma Mul_Redirect_Edge: "0\<le>j \<and> j<n \<Longrightarrow> 
+  \<turnstile> Mul_Redirect_Edge j n 
+     pre(Mul_Color_Target j n)"
+apply (unfold mul_mutator_defs)
+apply annhoare
+apply(simp_all)
+apply clarify
+apply(simp add:nth_list_update)
+done
+
+lemma Mul_Color_Target: "0\<le>j \<and> j<n \<Longrightarrow> 
+  \<turnstile>  Mul_Color_Target j n  
+    .{\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)}."
+apply (unfold mul_mutator_defs)
+apply annhoare
+apply(simp_all)
+apply clarify
+apply(simp add:nth_list_update)
+done
+
+lemma Mul_Mutator: "0\<le>j \<and> j<n \<Longrightarrow>  
+ \<turnstile> Mul_Mutator j n .{False}."
+apply(unfold Mul_Mutator_def)
+apply annhoare
+apply(simp_all add:Mul_Redirect_Edge Mul_Color_Target)
+apply(simp add:mul_mutator_defs Mul_Redirect_Edge_def)
+done
+
+subsubsection {* Interference freedom between mutators *}
+
+lemma Mul_interfree_Redirect_Edge_Redirect_Edge: 
+  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
+  interfree_aux (Some (Mul_Redirect_Edge i n),{}, Some(Mul_Redirect_Edge j n))"
+apply (unfold mul_mutator_defs)
+apply interfree_aux
+apply safe
+apply(simp_all add: nth_list_update)
+apply force+
+done
+
+lemma Mul_interfree_Redirect_Edge_Color_Target: 
+  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>  
+  interfree_aux (Some(Mul_Redirect_Edge i n),{},Some(Mul_Color_Target j n))"
+apply (unfold mul_mutator_defs)
+apply interfree_aux
+apply safe
+apply(simp_all add: nth_list_update)
+done
+
+lemma Mul_interfree_Color_Target_Redirect_Edge: 
+  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
+  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Redirect_Edge j n))"
+apply (unfold mul_mutator_defs)
+apply interfree_aux
+apply safe
+apply(simp_all add:nth_list_update)
+apply (drule not_sym,force)+
+done
+
+lemma Mul_interfree_Color_Target_Color_Target: 
+  " \<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow> 
+  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Color_Target j n))"
+apply (unfold mul_mutator_defs)
+apply interfree_aux
+apply safe
+apply(simp_all add: nth_list_update)
+apply (drule not_sym,force)
+done
+
+lemmas mul_mutator_interfree = 
+  Mul_interfree_Redirect_Edge_Redirect_Edge Mul_interfree_Redirect_Edge_Color_Target
+  Mul_interfree_Color_Target_Redirect_Edge Mul_interfree_Color_Target_Color_Target
+
+lemma Mul_interfree_Mutator_Mutator: "\<lbrakk>i < n; j < n; i \<noteq> j\<rbrakk> \<Longrightarrow> 
+  interfree_aux (Some (Mul_Mutator i n), {}, Some (Mul_Mutator j n))"
+apply(unfold Mul_Mutator_def)
+apply(interfree_aux)
+apply(simp_all add:mul_mutator_interfree)
+apply(simp_all add: mul_mutator_defs)
+apply(tactic {* TRYALL (interfree_aux_tac) *})
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply (simp_all add:nth_list_update)
+apply force+
+done
+
+subsubsection {* Modular Parameterized Mutators *}
+
+lemma Mul_Parameterized_Mutators: "0<n \<Longrightarrow>
+ \<parallel>- .{\<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.
+ COBEGIN
+ SCHEME  [0\<le> j< n]
+  Mul_Mutator j n
+ .{False}.
+ COEND
+ .{False}."
+apply oghoare
+apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
+apply(erule Mul_Mutator)
+apply(simp add:Mul_interfree_Mutator_Mutator) 
+apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
+done
+
+subsection {* The Collector *}
+
+constdefs
+  Queue :: "mul_gar_coll_state \<Rightarrow> nat"
+ "Queue \<equiv> \<guillemotleft> length (filter (\<lambda>i. \<not> Z i \<and> \<acute>M!(T i) \<noteq> Black) \<acute>Muts) \<guillemotright>"
+
+consts  M_init :: nodes
+
+constdefs
+  Proper_M_init :: "mul_gar_coll_state \<Rightarrow> bool"
+  "Proper_M_init \<equiv> \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"
+
+  Mul_Proper :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "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>"
+
+  Safe :: "mul_gar_coll_state \<Rightarrow> bool"
+  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"
+
+lemmas mul_collector_defs = Proper_M_init_def Mul_Proper_def Safe_def
+
+subsubsection {* Blackening Roots *}
+
+constdefs
+  Mul_Blacken_Roots :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Blacken_Roots n \<equiv>
+  .{\<acute>Mul_Proper n}.
+  \<acute>ind:=0;;
+  .{\<acute>Mul_Proper n \<and> \<acute>ind=0}.
+  WHILE \<acute>ind<length \<acute>M 
+    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}.
+  DO .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
+       IF \<acute>ind\<in>Roots THEN 
+     .{\<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}. 
+       \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
+     .{\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind+1. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M}.
+       \<acute>ind:=\<acute>ind+1 
+  OD"
+
+lemma Mul_Blacken_Roots: 
+  "\<turnstile> Mul_Blacken_Roots n  
+  .{\<acute>Mul_Proper n \<and> Roots \<subseteq> Blacks \<acute>M}."
+apply (unfold Mul_Blacken_Roots_def)
+apply annhoare
+apply(simp_all add:mul_collector_defs Graph_defs)
+apply safe
+apply(simp_all add:nth_list_update)
+   apply (erule less_SucE)
+    apply simp+
+  apply (erule less_SucE)
+   apply simp+
+ apply(drule le_imp_less_or_eq)
+ apply force
+apply force
+done
+
+subsubsection {* Propagating Black *} 
+
+constdefs
+  Mul_PBInv :: "mul_gar_coll_state \<Rightarrow> bool"
+  "Mul_PBInv \<equiv>  \<guillemotleft>\<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)) \<and> \<acute>l\<le>\<acute>Queue\<guillemotright>"
+
+  Mul_Auxk :: "mul_gar_coll_state \<Rightarrow> bool"
+  "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>"
+
+constdefs
+  Mul_Propagate_Black :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Propagate_Black n \<equiv>
+ .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+  \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)}. 
+ \<acute>ind:=0;;
+ .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+   \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> Blacks \<acute>M\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+   \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) \<and> \<acute>ind=0}. 
+ WHILE \<acute>ind<length \<acute>E 
+  INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+        \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+        \<and> \<acute>Mul_PBInv \<and> \<acute>ind\<le>length \<acute>E}.
+ DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+     \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
+   IF \<acute>M!(fst (\<acute>E!\<acute>ind))=Black THEN 
+   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+     \<and> \<acute>Mul_PBInv \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black \<and> \<acute>ind<length \<acute>E}.
+    \<acute>k:=snd(\<acute>E!\<acute>ind);;
+   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+     \<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)) 
+        \<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 
+     \<and> \<acute>ind<length \<acute>E}.
+   \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],,\<acute>ind:=\<acute>ind+1\<rangle>
+   ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+         \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+         \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E}.
+	 \<langle>IF \<acute>M!(fst (\<acute>E!\<acute>ind))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> FI
+ OD"
+
+lemma Mul_Propagate_Black: 
+  "\<turnstile> Mul_Propagate_Black n  
+   .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+     \<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))}."
+apply(unfold Mul_Propagate_Black_def)
+apply annhoare
+apply(simp_all add:Mul_PBInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
+--{* 8 subgoals left *}
+apply force
+apply force
+apply force
+apply(force simp add:BtoW_def Graph_defs)
+--{* 4 subgoals left *}
+apply clarify
+apply(simp add: mul_collector_defs Graph12 Graph6 Graph7 Graph8)
+apply(disjE_tac)
+ apply(simp_all add:Graph12 Graph13)
+ apply(case_tac "M x! k x=Black")
+  apply(simp add: Graph10)
+ apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
+apply(case_tac "M x! k x=Black")
+ apply(simp add: Graph10 BtoW_def)
+ apply(rule disjI2, clarify, erule less_SucE, force)
+ apply(case_tac "M x!snd(E x! ind x)=Black")
+  apply(force)
+ apply(force)
+apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
+--{* 3 subgoals left *}
+apply force
+--{* 2 subgoals left *}
+apply clarify
+apply(conjI_tac)
+apply(disjE_tac)
+ apply (simp_all)
+apply clarify
+apply(erule less_SucE)
+ apply force
+apply (simp add:BtoW_def)
+--{* 1 subgoals left *}
+apply clarify
+apply simp
+apply(disjE_tac)
+apply (simp_all)
+apply(rule disjI1 , rule Graph1)
+ apply simp_all
+done
+
+subsubsection {* Counting Black Nodes *}
+
+constdefs
+  Mul_CountInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+ "Mul_CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"
+
+  Mul_Count :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Count n \<equiv> 
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> length \<acute>Ma=length \<acute>M 
+    \<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) ) 
+    \<and> \<acute>q<n+1 \<and> \<acute>bc={}}.
+  \<acute>ind:=0;;
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> length \<acute>Ma=length \<acute>M 
+    \<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) ) 
+    \<and> \<acute>q<n+1 \<and> \<acute>bc={} \<and> \<acute>ind=0}.
+  WHILE \<acute>ind<length \<acute>M 
+     INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
+          \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
+          \<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))
+	  \<and> \<acute>q<n+1 \<and> \<acute>ind\<le>length \<acute>M}.
+  DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+       \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+       \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
+       \<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))
+       \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}. 
+     IF \<acute>M!\<acute>ind=Black 
+     THEN .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+            \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M  
+            \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind 
+            \<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))
+            \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}.
+          \<acute>bc:=insert \<acute>ind \<acute>bc
+     FI;;
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv (\<acute>ind+1) 
+    \<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))
+    \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M}.
+  \<acute>ind:=\<acute>ind+1
+  OD"
+ 
+lemma Mul_Count: 
+  "\<turnstile> Mul_Count n  
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+    \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
+    \<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)) 
+    \<and> \<acute>q<n+1}."
+apply (unfold Mul_Count_def)
+apply annhoare
+apply(simp_all add:Mul_CountInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
+--{* 7 subgoals left *}
+apply force
+apply force
+apply force
+--{* 4 subgoals left *}
+apply clarify
+apply(conjI_tac)
+apply(disjE_tac)
+ apply simp_all
+apply(simp add:Blacks_def)
+apply clarify
+apply(erule less_SucE)
+ back
+ apply force
+apply force
+--{* 3 subgoals left *}
+apply clarify
+apply(conjI_tac)
+apply(disjE_tac)
+ apply simp_all
+apply clarify
+apply(erule less_SucE)
+ back
+ apply force
+apply simp
+apply(rotate_tac -1)
+apply (force simp add:Blacks_def)
+--{* 2 subgoals left *}
+apply force
+--{* 1 subgoals left *}
+apply clarify
+apply(drule le_imp_less_or_eq)
+apply(disjE_tac)
+apply (simp_all add:Blacks_def)
+done
+
+subsubsection {* Appending garbage nodes to the free list *}
+
+consts  Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
+
+axioms
+  Append_to_free0: "length (Append_to_free (i, e)) = length e"
+  Append_to_free1: "Proper_Edges (m, e) 
+                    \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))"
+  Append_to_free2: "i \<notin> Reach e 
+           \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"
+
+constdefs
+  Mul_AppendInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool"
+  "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>"
+
+  Mul_Append :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Append n \<equiv> 
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe}.
+  \<acute>ind:=0;;
+  .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0}.
+  WHILE \<acute>ind<length \<acute>M 
+    INV .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M}.
+  DO .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M}.
+      IF \<acute>M!\<acute>ind=Black THEN 
+     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black}. 
+      \<acute>M:=\<acute>M[\<acute>ind:=White] 
+      ELSE 
+     .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E}. 
+      \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
+      FI;;
+  .{\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M}. 
+   \<acute>ind:=\<acute>ind+1
+  OD"
+
+lemma Mul_Append: 
+  "\<turnstile> Mul_Append n  
+     .{\<acute>Mul_Proper n}."
+apply(unfold Mul_Append_def)
+apply annhoare
+apply(simp_all add: mul_collector_defs Mul_AppendInv_def 
+      Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+apply(force simp add:Blacks_def)
+apply(force simp add:Blacks_def)
+apply(force simp add:Blacks_def)
+apply(force simp add:Graph_defs)
+apply force
+apply(force simp add:Append_to_free1 Append_to_free2)
+apply force
+apply force
+done
+
+subsubsection {* Collector *}
+
+constdefs 
+  Mul_Collector :: "nat \<Rightarrow>  mul_gar_coll_state ann_com"
+  "Mul_Collector n \<equiv>
+.{\<acute>Mul_Proper n}.  
+WHILE True INV .{\<acute>Mul_Proper n}. 
+DO  
+Mul_Blacken_Roots n ;; 
+.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M}.  
+ \<acute>obc:={};; 
+.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}}.  
+ \<acute>bc:=Roots;; 
+.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots}. 
+ \<acute>l:=0;; 
+.{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>l=0}. 
+ WHILE \<acute>l<n+1  
+   INV .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and>  
+         (\<acute>Safe \<or> (\<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M) \<and> \<acute>l<n+1)}. 
+ DO .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M)}.
+    \<acute>obc:=\<acute>bc;;
+    Mul_Propagate_Black n;; 
+    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<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))}. 
+    \<acute>bc:={};;
+    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<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)) \<and> \<acute>bc={}}. 
+       \<langle> \<acute>Ma:=\<acute>M,, \<acute>q:=\<acute>Queue \<rangle>;;
+    Mul_Count n;; 
+    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
+      \<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)) 
+      \<and> \<acute>q<n+1}. 
+    IF \<acute>obc=\<acute>bc THEN
+    .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
+      \<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)) 
+      \<and> \<acute>q<n+1 \<and> \<acute>obc=\<acute>bc}.  
+    \<acute>l:=\<acute>l+1  
+    ELSE .{\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M 
+          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M 
+          \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc 
+          \<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)) 
+          \<and> \<acute>q<n+1 \<and> \<acute>obc\<noteq>\<acute>bc}.  
+        \<acute>l:=0 FI 
+ OD;; 
+ Mul_Append n  
+OD"
+
+lemmas mul_modules = Mul_Redirect_Edge_def Mul_Color_Target_def 
+ Mul_Blacken_Roots_def Mul_Propagate_Black_def 
+ Mul_Count_def Mul_Append_def
+
+lemma Mul_Collector:
+  "\<turnstile> Mul_Collector n 
+  .{False}."
+apply(unfold Mul_Collector_def)
+apply annhoare
+apply(simp_all only:pre.simps Mul_Blacken_Roots 
+       Mul_Propagate_Black Mul_Count Mul_Append)
+apply(simp_all add:mul_modules)
+apply(simp_all add:mul_collector_defs Queue_def)
+apply force
+apply force
+apply force
+apply (force simp add: less_Suc_eq_le length_filter)
+apply force
+apply (force dest:subset_antisym)
+apply force
+apply force
+apply force
+done
+
+subsection {* Interference Freedom *}
+
+lemma le_length_filter_update[rule_format]: 
+ "\<forall>i. (\<not>P (list!i) \<or> P j) \<and> i<length list 
+ \<longrightarrow> length(filter P list) \<le> length(filter P (list[i:=j]))"
+apply(induct_tac "list")
+ apply(simp)
+apply(clarify)
+apply(case_tac i)
+ apply(simp)
+apply(simp)
+done
+
+lemma less_length_filter_update [rule_format]: 
+ "\<forall>i. P j \<and> \<not>(P (list!i)) \<and> i<length list 
+ \<longrightarrow> length(filter P list) < length(filter P (list[i:=j]))"
+apply(induct_tac "list")
+ apply(simp)
+apply(clarify)
+apply(case_tac i)
+ apply(simp)
+apply(simp)
+done
+
+lemma Mul_interfree_Blacken_Roots_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk> \<Longrightarrow>  
+  interfree_aux (Some(Mul_Blacken_Roots n),{},Some(Mul_Redirect_Edge j n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:Graph6 Graph9 Graph12 nth_list_update mul_mutator_defs mul_collector_defs)
+done
+
+lemma Mul_interfree_Redirect_Edge_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow> 
+  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Blacken_Roots n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Blacken_Roots_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Blacken_Roots n),{},Some (Mul_Color_Target j n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs mul_collector_defs nth_list_update Graph7 Graph8 Graph9 Graph12)
+done
+
+lemma Mul_interfree_Color_Target_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Color_Target j n ),{},Some (Mul_Blacken_Roots n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Propagate_Black_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Redirect_Edge j n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_PBInv_def nth_list_update Graph6)
+--{* 7 subgoals left *}
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+ apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+apply(rule conjI)
+ apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+--{* 6 subgoals left *}
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+ apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+apply(rule conjI)
+ apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+--{* 5 subgoals left *}
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+ apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+apply(rule conjI)
+ 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)
+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)
+apply(erule conjE)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(rule conjI)
+  apply(rule impI,(rule disjI2)+,rule conjI)
+   apply clarify
+   apply(case_tac "R (Muts x! j)=i")
+    apply (force simp add: nth_list_update BtoW_def)
+   apply (force simp add: nth_list_update)
+  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(rule impI,(rule disjI2)+, erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule conjI)
+ apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+--{* 4 subgoals left *}
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+ apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+apply(rule conjI)
+ 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)
+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)
+apply(erule conjE)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(rule conjI)
+  apply(rule impI,(rule disjI2)+,rule conjI)
+   apply clarify
+   apply(case_tac "R (Muts x! j)=i")
+    apply (force simp add: nth_list_update BtoW_def)
+   apply (force simp add: nth_list_update)
+  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(rule impI,(rule disjI2)+, erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule conjI)
+ apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+--{* 3 subgoals left *}
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+  apply (rule impI)
+   apply(rule conjI)
+    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+   apply(case_tac "R (Muts x ! j)= ind x")
+    apply(simp add:nth_list_update)
+   apply(simp add:nth_list_update)
+  apply(case_tac "R (Muts x ! j)= ind x")
+   apply(simp add:nth_list_update)
+  apply(simp add:nth_list_update)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule conjI)
+   apply(rule impI)
+   apply(rule conjI)
+    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+   apply(case_tac "R (Muts x ! j)= ind x")
+    apply(simp add:nth_list_update)
+   apply(simp add:nth_list_update)
+  apply(rule impI)
+  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(rule conjI)
+  apply(rule impI)
+   apply(rule conjI)
+    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+   apply(case_tac "R (Muts x ! j)= ind x")
+    apply(simp add:nth_list_update)
+   apply(simp add:nth_list_update)
+  apply(rule impI)
+  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(erule conjE)
+ apply(rule conjI)
+  apply(case_tac "M x!(T (Muts x!j))=Black")
+   apply(rule impI,rule conjI,(rule disjI2)+,rule conjI)
+    apply clarify
+    apply(case_tac "R (Muts x! j)=i")
+     apply (force simp add: nth_list_update BtoW_def)
+    apply (force simp add: nth_list_update)
+   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+  apply(case_tac "R (Muts x ! j)= ind x")
+   apply(simp add:nth_list_update)
+  apply(simp add:nth_list_update)
+ apply(rule impI,rule conjI)
+  apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+ apply(case_tac "R (Muts x! j)=ind x")
+  apply (force simp add: nth_list_update)
+ apply (force simp add: nth_list_update)
+apply(rule impI, (rule disjI2)+, erule le_trans)
+apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+--{* 2 subgoals left *}
+apply clarify
+apply(rule conjI)
+ apply(disjE_tac)
+  apply(simp_all add:Mul_Auxk_def Graph6)
+  apply (rule impI)
+   apply(rule conjI)
+    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+   apply(case_tac "R (Muts x ! j)= ind x")
+    apply(simp add:nth_list_update)
+   apply(simp add:nth_list_update)
+  apply(case_tac "R (Muts x ! j)= ind x")
+   apply(simp add:nth_list_update)
+  apply(simp add:nth_list_update)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule impI)
+  apply(rule conjI)
+   apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+  apply(case_tac "R (Muts x ! j)= ind x")
+   apply(simp add:nth_list_update)
+  apply(simp add:nth_list_update)
+ apply(rule impI)
+ apply(rule conjI)
+  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(case_tac "R (Muts x ! j)= ind x")
+  apply(simp add:nth_list_update)
+ apply(simp add:nth_list_update)
+apply(rule impI)
+apply(rule conjI)
+ apply(erule conjE)+
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply((rule disjI2)+,rule conjI)
+   apply clarify
+   apply(case_tac "R (Muts x! j)=i")
+    apply (force simp add: nth_list_update BtoW_def)
+   apply (force simp add: nth_list_update)
+  apply(rule conjI)
+   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+  apply(rule impI)
+  apply(case_tac "R (Muts x ! j)= ind x")
+   apply(simp add:nth_list_update BtoW_def)
+  apply (simp  add:nth_list_update)
+  apply(rule impI)
+  apply simp
+  apply(disjE_tac)
+   apply(rule disjI1, erule less_le_trans)
+   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+  apply force
+ apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+ apply(case_tac "R (Muts x ! j)= ind x")
+  apply(simp add:nth_list_update)
+ apply(simp add:nth_list_update)
+apply(disjE_tac) 
+apply simp_all
+apply(conjI_tac)
+ apply(rule impI)
+ apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(erule conjE)+
+apply(rule impI,(rule disjI2)+,rule conjI)
+ apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule impI)+
+apply simp
+apply(disjE_tac)
+ apply(rule disjI1, erule less_le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply force
+--{* 1 subgoals left *} 
+apply clarify
+apply(disjE_tac)
+  apply(simp_all add:Graph6)
+ apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+apply(rule conjI)
+ 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)
+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)
+apply(erule conjE)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(rule conjI)
+  apply(rule impI,(rule disjI2)+,rule conjI)
+   apply clarify
+   apply(case_tac "R (Muts x! j)=i")
+    apply (force simp add: nth_list_update BtoW_def)
+   apply (force simp add: nth_list_update)
+  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+ apply(rule impI,(rule disjI2)+, erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule conjI)
+ apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
+apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
+done
+
+lemma Mul_interfree_Redirect_Edge_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Propagate_Black n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Propagate_Black_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Color_Target j n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(simp_all add: mul_collector_defs mul_mutator_defs)
+--{* 7 subgoals left *}
+apply clarify
+apply (simp add:Graph7 Graph8 Graph12)
+apply(disjE_tac)
+  apply(simp add:Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 6 subgoals left *}
+apply clarify
+apply (simp add:Graph7 Graph8 Graph12)
+apply(disjE_tac)
+  apply(simp add:Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp) 
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 5 subgoals left *}
+apply clarify
+apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
+apply(disjE_tac)
+   apply(simp add:Graph7 Graph8 Graph12) 
+  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
+apply(erule conjE)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply((rule disjI2)+)
+ apply (rule conjI)
+  apply(simp add:Graph10)
+ apply(erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
+--{* 4 subgoals left *}
+apply clarify
+apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
+apply(disjE_tac)
+   apply(simp add:Graph7 Graph8 Graph12)
+  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
+apply(erule conjE)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply((rule disjI2)+)
+ apply (rule conjI)
+  apply(simp add:Graph10)
+ apply(erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp) 
+--{* 3 subgoals left *}
+apply clarify
+apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(simp add:Graph10)
+ apply(disjE_tac)
+  apply simp_all
+  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply(erule conjE)
+ apply((rule disjI2)+,erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+apply(rule conjI)
+ apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
+apply (force simp add:nth_list_update)
+--{* 2 subgoals left *}
+apply clarify 
+apply(simp add:Mul_Auxk_def Graph7 Graph8 Graph12)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(simp add:Graph10)
+ apply(disjE_tac)
+  apply simp_all
+  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply(erule conjE)+
+ apply((rule disjI2)+,rule conjI, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule impI)+)
+ apply simp
+ apply(erule disjE)
+  apply(rule disjI1, erule less_le_trans) 
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply force
+apply(rule conjI)
+ apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
+apply (force simp add:nth_list_update)
+--{* 1 subgoals left *}
+apply clarify
+apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
+apply(case_tac "M x!(T (Muts x!j))=Black")
+ apply(simp add:Graph10)
+ apply(disjE_tac)
+  apply simp_all
+  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply(erule conjE)
+ apply((rule disjI2)+,erule le_trans)
+ apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11) 
+done
+
+lemma Mul_interfree_Color_Target_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Color_Target j n),{},Some(Mul_Propagate_Black n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Count_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Redirect_Edge j n))"
+apply (unfold mul_modules)
+apply interfree_aux
+--{* 9 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def Graph6)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 8 subgoals left *}
+apply(simp add:mul_mutator_defs nth_list_update)
+--{* 7 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 6 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6 Queue_def)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 5 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 4 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 3 subgoals left *}
+apply(simp add:mul_mutator_defs nth_list_update)
+--{* 2 subgoals left *}
+apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
+apply clarify
+apply disjE_tac
+   apply(simp add:Graph6)
+  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
+ apply(simp add:Graph6)
+apply clarify
+apply disjE_tac
+ apply(simp add:Graph6)
+ apply(rule conjI)
+  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)
+ 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)
+apply(simp add:Graph6)
+--{* 1 subgoals left *}
+apply(simp add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Redirect_Edge_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Count n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Count_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Color_Target j n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(simp_all add:mul_collector_defs mul_mutator_defs Mul_CountInv_def)
+--{* 6 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12)
+ apply (simp add: Graph7 Graph8 Graph12)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+apply (simp add: Graph7 Graph8 Graph12)
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 5 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12)
+ apply (simp add: Graph7 Graph8 Graph12)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+apply (simp add: Graph7 Graph8 Graph12)
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 4 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12)
+ apply (simp add: Graph7 Graph8 Graph12)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+apply (simp add: Graph7 Graph8 Graph12)
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 3 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12)
+ apply (simp add: Graph7 Graph8 Graph12)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+apply (simp add: Graph7 Graph8 Graph12)
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+--{* 2 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
+ apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(rule conjI)
+  apply(case_tac "M x!(T (Muts x!j))=Black")
+   apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+  apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+ apply (simp add: nth_list_update)
+apply (simp add: Graph7 Graph8 Graph12)
+apply(rule conjI)
+ apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+apply (simp add: nth_list_update)
+--{* 1 subgoals left *}
+apply clarify
+apply disjE_tac
+  apply (simp add: Graph7 Graph8 Graph12)
+ apply (simp add: Graph7 Graph8 Graph12)
+apply clarify
+apply disjE_tac
+ apply (simp add: Graph7 Graph8 Graph12)
+ apply(case_tac "M x!(T (Muts x!j))=Black")
+  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
+  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
+ apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
+apply (simp add: Graph7 Graph8 Graph12)
+apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
+done
+
+lemma Mul_interfree_Color_Target_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Count n ))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply safe
+apply(simp_all add:mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Append_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Redirect_Edge j n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(simp_all add:Graph6 Append_to_free0 Append_to_free1 mul_collector_defs mul_mutator_defs Mul_AppendInv_def)
+apply(erule_tac x=j in allE, force dest:Graph3)+
+done
+
+lemma Mul_interfree_Redirect_Edge_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Append n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(simp_all add:mul_collector_defs Append_to_free0 Mul_AppendInv_def  mul_mutator_defs nth_list_update)
+done
+
+lemma Mul_interfree_Append_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Color_Target j n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_AppendInv_def Graph7 Graph8 Append_to_free0 Append_to_free1 
+              Graph12 nth_list_update)
+done
+
+lemma Mul_interfree_Color_Target_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>  
+  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Append n))"
+apply (unfold mul_modules)
+apply interfree_aux
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(simp_all add: mul_mutator_defs nth_list_update)
+apply(simp add:Mul_AppendInv_def Append_to_free0)
+done
+
+subsubsection {* Interference freedom Collector-Mutator *}
+
+lemmas mul_collector_mutator_interfree =  
+ Mul_interfree_Blacken_Roots_Redirect_Edge Mul_interfree_Blacken_Roots_Color_Target 
+ Mul_interfree_Propagate_Black_Redirect_Edge Mul_interfree_Propagate_Black_Color_Target  
+ Mul_interfree_Count_Redirect_Edge Mul_interfree_Count_Color_Target 
+ Mul_interfree_Append_Redirect_Edge Mul_interfree_Append_Color_Target 
+ Mul_interfree_Redirect_Edge_Blacken_Roots Mul_interfree_Color_Target_Blacken_Roots 
+ Mul_interfree_Redirect_Edge_Propagate_Black Mul_interfree_Color_Target_Propagate_Black  
+ Mul_interfree_Redirect_Edge_Count Mul_interfree_Color_Target_Count 
+ Mul_interfree_Redirect_Edge_Append Mul_interfree_Color_Target_Append
+
+lemma Mul_interfree_Collector_Mutator: "j<n  \<Longrightarrow> 
+  interfree_aux (Some (Mul_Collector n), {}, Some (Mul_Mutator j n))"
+apply(unfold Mul_Collector_def Mul_Mutator_def)
+apply interfree_aux
+apply(simp_all add:mul_collector_mutator_interfree)
+apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
+apply(tactic  {* TRYALL (interfree_aux_tac) *})
+--{* 42 subgoals left *}
+apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
+--{* 24 subgoals left *}
+apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+--{* 14 subgoals left *}
+apply(tactic {* TRYALL Clarify_tac *})
+apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+apply(tactic {* TRYALL (rtac conjI) *})
+apply(tactic {* TRYALL (rtac impI) *})
+apply(tactic {* TRYALL (etac disjE) *})
+apply(tactic {* TRYALL (etac conjE) *})
+apply(tactic {* TRYALL (etac disjE) *})
+apply(tactic {* TRYALL (etac disjE) *})
+--{* 72 subgoals left *}
+apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
+--{* 35 subgoals left *}
+apply(tactic {* TRYALL(EVERY'[rtac disjI1,rtac subset_trans,etac (thm "Graph3"),Force_tac, assume_tac]) *})
+--{* 28 subgoals left *}
+apply(tactic {* TRYALL (etac conjE) *})
+apply(tactic {* TRYALL (etac disjE) *})
+--{* 34 subgoals left *}
+apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
+apply(tactic {* ALLGOALS(case_tac "M x!(T (Muts x ! j))=Black") *})
+apply(simp_all add:Graph10)
+--{* 47 subgoals left *}
+apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
+--{* 41 subgoals left *}
+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"])]) *})
+--{* 35 subgoals left *}
+apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac psubset_subset_trans,rtac (thm "Graph9"),Force_tac]) *})
+--{* 31 subgoals left *}
+apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
+--{* 29 subgoals left *}
+apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac subset_psubset_trans,etac subset_psubset_trans,etac (thm "Graph11"),Force_tac]) *})
+--{* 25 subgoals left *}
+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"])]) *})
+--{* 10 subgoals left *}
+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)+
+done
+
+subsubsection {* Interference freedom Mutator-Collector *}
+
+lemma Mul_interfree_Mutator_Collector: " j < n \<Longrightarrow> 
+  interfree_aux (Some (Mul_Mutator j n), {}, Some (Mul_Collector n))"
+apply(unfold Mul_Collector_def Mul_Mutator_def)
+apply interfree_aux
+apply(simp_all add:mul_collector_mutator_interfree)
+apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
+apply(tactic  {* TRYALL (interfree_aux_tac) *})
+--{* 76 subgoals left *}
+apply (clarify,simp add: nth_list_update)+
+--{* 56 subgoals left *}
+apply(clarify,simp add:Mul_AppendInv_def Append_to_free0 nth_list_update)+
+done
+
+subsubsection {* The Multi-Mutator Garbage Collection Algorithm *}
+
+text {* The total number of verification conditions is 328 *}
+
+lemma Mul_Gar_Coll: 
+ "\<parallel>- .{\<acute>Mul_Proper n \<and> \<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))}.  
+ COBEGIN  
+  Mul_Collector n
+ .{False}.
+ \<parallel>  
+ SCHEME  [0\<le> j< n]
+  Mul_Mutator j n
+ .{False}.  
+ COEND  
+ .{False}."
+apply oghoare
+--{* Strengthening the precondition *}
+apply(rule Int_greatest)
+ apply (case_tac n)
+  apply(force simp add: Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
+ apply(simp add: Mul_Mutator_def mul_collector_defs mul_mutator_defs nth_append)
+ apply force
+apply clarify
+apply(case_tac xa)
+ apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
+apply(simp add: Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append nth_map_upt)
+--{* Collector *}
+apply(rule Mul_Collector)
+--{* Mutator *}
+apply(erule Mul_Mutator)
+--{* Interference freedom *}
+apply(simp add:Mul_interfree_Collector_Mutator)
+apply(simp add:Mul_interfree_Mutator_Collector)
+apply(simp add:Mul_interfree_Mutator_Mutator)
+--{* Weakening of the postcondition *}
+apply(case_tac n)
+ apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
+apply(simp add:Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append)
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Com.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Com.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,55 @@
+
+header {* \chapter{The Owicki-Gries Method} 
+
+\section{Abstract Syntax} *} 
+
+theory OG_Com = Main:
+
+text {* Type abbreviations for boolean expressions and assertions: *}
+
+types
+    'a bexp = "'a set"
+    'a assn = "'a set"
+
+text {* The syntax of commands is defined by two mutually recursive
+datatypes: @{text "'a ann_com"} for annotated commands and @{text "'a
+com"} for non-annotated commands. *}
+
+datatype 'a ann_com = 
+     AnnBasic "('a assn)"  "('a \<Rightarrow> 'a)"         
+   | AnnSeq "('a ann_com)"  "('a ann_com)"   
+   | AnnCond1 "('a assn)"  "('a bexp)"  "('a ann_com)"  "('a ann_com)" 
+   | AnnCond2 "('a assn)"  "('a bexp)"  "('a ann_com)" 
+   | AnnWhile "('a assn)"  "('a bexp)"  "('a assn)"  "('a ann_com)" 
+   | AnnAwait "('a assn)"  "('a bexp)"  "('a com)" 
+and 'a com = 
+     Parallel "('a ann_com option \<times> 'a assn) list"
+   | Basic "('a \<Rightarrow> 'a)" 
+   | Seq "('a com)"  "('a com)" 
+   | Cond "('a bexp)"  "('a com)"  "('a com)" 
+   | While "('a bexp)"  "('a assn)"  "('a com)"
+
+text {* The function @{text pre} extracts the precondition of an
+annotated command: *}
+
+consts
+  pre ::"'a ann_com \<Rightarrow> 'a assn" 
+primrec 
+  "pre (AnnBasic r f) = r"
+  "pre (AnnSeq c1 c2) = pre c1"
+  "pre (AnnCond1 r b c1 c2) = r"
+  "pre (AnnCond2 r b c) = r"
+  "pre (AnnWhile r b i c) = r"
+  "pre (AnnAwait r b c) = r"
+
+text {* Well-formedness predicate for atomic programs: *}
+
+consts atom_com :: "'a com \<Rightarrow> bool"
+primrec  
+  "atom_com (Parallel Ts) = False"
+  "atom_com (Basic f) = True"
+  "atom_com (Seq c1 c2) = (atom_com c1 \<and> atom_com c2)"
+  "atom_com (Cond b c1 c2) = (atom_com c1 \<and> atom_com c2)"
+  "atom_com (While b i c) = atom_com c"
+  
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Examples.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Examples.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,564 @@
+
+header {* \section{Examples} *}
+
+theory OG_Examples = OG_Syntax:
+
+subsection {* Mutual Exclusion *}
+
+subsubsection {* Peterson's Algorithm I*}
+
+text {* Eike Best. "Semantics of Sequential and Parallel Programs", page 217. *}
+
+record Petersons_mutex_1 =
+ pr1 :: nat
+ pr2 :: nat
+ in1 :: bool
+ in2 :: bool 
+ hold :: nat
+
+lemma Petersons_mutex_1: 
+  "\<parallel>- .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2 }.  
+  COBEGIN .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
+  WHILE True INV .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
+  DO  
+  .{\<acute>pr1=0 \<and> \<not>\<acute>in1}. \<langle> \<acute>in1:=True,,\<acute>pr1:=1 \<rangle>;;  
+  .{\<acute>pr1=1 \<and> \<acute>in1}.  \<langle> \<acute>hold:=1,,\<acute>pr1:=2 \<rangle>;;  
+  .{\<acute>pr1=2 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}.  
+  AWAIT (\<not>\<acute>in2 \<or> \<not>(\<acute>hold=1)) THEN \<acute>pr1:=3 END;;    
+  .{\<acute>pr1=3 \<and> \<acute>in1 \<and> (\<acute>hold=1 \<or> \<acute>hold=2 \<and> \<acute>pr2=2)}. 
+   \<langle>\<acute>in1:=False,,\<acute>pr1:=0\<rangle> 
+  OD .{\<acute>pr1=0 \<and> \<not>\<acute>in1}.  
+  \<parallel>  
+  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
+  WHILE True INV .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
+  DO  
+  .{\<acute>pr2=0 \<and> \<not>\<acute>in2}. \<langle> \<acute>in2:=True,,\<acute>pr2:=1 \<rangle>;;  
+  .{\<acute>pr2=1 \<and> \<acute>in2}. \<langle>  \<acute>hold:=2,,\<acute>pr2:=2 \<rangle>;;  
+  .{\<acute>pr2=2 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}.  
+  AWAIT (\<not>\<acute>in1 \<or> \<not>(\<acute>hold=2)) THEN \<acute>pr2:=3  END;;    
+  .{\<acute>pr2=3 \<and> \<acute>in2 \<and> (\<acute>hold=2 \<or> (\<acute>hold=1 \<and> \<acute>pr1=2))}. 
+    \<langle>\<acute>in2:=False,,\<acute>pr2:=0\<rangle> 
+  OD .{\<acute>pr2=0 \<and> \<not>\<acute>in2}.  
+  COEND  
+  .{\<acute>pr1=0 \<and> \<not>\<acute>in1 \<and> \<acute>pr2=0 \<and> \<not>\<acute>in2}."
+apply oghoare
+--{* 104 verification conditions. *}
+apply auto
+done
+
+subsubsection {*Peterson's Algorithm II: A Busy Wait Solution *}
+ 
+text {* Apt and Olderog. "Verification of sequential and concurrent Programs", page 282. *}
+
+record Busy_wait_mutex =
+ flag1 :: bool
+ flag2 :: bool
+ turn  :: nat
+ after1 :: bool 
+ after2 :: bool
+
+lemma Busy_wait_mutex: 
+ "\<parallel>-  .{True}.  
+  \<acute>flag1:=False,, \<acute>flag2:=False,,  
+  COBEGIN .{\<not>\<acute>flag1}.  
+        WHILE True  
+        INV .{\<not>\<acute>flag1}.  
+        DO .{\<not>\<acute>flag1}. \<langle> \<acute>flag1:=True,,\<acute>after1:=False \<rangle>;;  
+           .{\<acute>flag1 \<and> \<not>\<acute>after1}. \<langle> \<acute>turn:=1,,\<acute>after1:=True \<rangle>;;  
+           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
+            WHILE \<not>(\<acute>flag2 \<longrightarrow> \<acute>turn=2)  
+            INV .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
+            DO .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;; 
+           .{\<acute>flag1 \<and> \<acute>after1 \<and> (\<acute>flag2 \<and> \<acute>after2 \<longrightarrow> \<acute>turn=2)}.
+            \<acute>flag1:=False  
+        OD  
+       .{False}.  
+  \<parallel>  
+     .{\<not>\<acute>flag2}.  
+        WHILE True  
+        INV .{\<not>\<acute>flag2}.  
+        DO .{\<not>\<acute>flag2}. \<langle> \<acute>flag2:=True,,\<acute>after2:=False \<rangle>;;  
+           .{\<acute>flag2 \<and> \<not>\<acute>after2}. \<langle> \<acute>turn:=2,,\<acute>after2:=True \<rangle>;;  
+           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
+            WHILE \<not>(\<acute>flag1 \<longrightarrow> \<acute>turn=1)  
+            INV .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}.  
+            DO .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>turn=1 \<or> \<acute>turn=2)}. SKIP OD;;  
+           .{\<acute>flag2 \<and> \<acute>after2 \<and> (\<acute>flag1 \<and> \<acute>after1 \<longrightarrow> \<acute>turn=1)}. 
+            \<acute>flag2:=False  
+        OD  
+       .{False}.  
+  COEND  
+  .{False}."
+apply oghoare
+--{* 122 vc *}
+apply auto
+done
+
+subsubsection {* Peterson's Algorithm III: A Solution using Semaphores  *}
+
+record  Semaphores_mutex =
+ out :: bool
+ who :: nat
+
+lemma Semaphores_mutex: 
+ "\<parallel>- .{i\<noteq>j}.  
+  \<acute>out:=True ,,  
+  COBEGIN .{i\<noteq>j}.  
+       WHILE True INV .{i\<noteq>j}.  
+       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
+          .{\<not>\<acute>out \<and> \<acute>who=i \<and> i\<noteq>j}. \<acute>out:=True OD  
+       .{False}.  
+  \<parallel>  
+       .{i\<noteq>j}.  
+       WHILE True INV .{i\<noteq>j}.  
+       DO .{i\<noteq>j}. AWAIT \<acute>out THEN  \<acute>out:=False,,\<acute>who:=j END;;  
+          .{\<not>\<acute>out \<and> \<acute>who=j \<and> i\<noteq>j}. \<acute>out:=True OD  
+       .{False}.  
+  COEND  
+  .{False}."
+apply oghoare
+--{* 38 vc *}
+apply auto
+done
+
+subsubsection {* Peterson's Algorithm III: Parameterized version: *}
+
+lemma Semaphores_parameterized_mutex: 
+ "0<n \<Longrightarrow> \<parallel>- .{True}.  
+  \<acute>out:=True ,,  
+ COBEGIN
+  SCHEME [0\<le> i< n]
+    .{True}.  
+     WHILE True INV .{True}.  
+      DO .{True}. AWAIT \<acute>out THEN  \<acute>out:=False,, \<acute>who:=i END;;  
+         .{\<not>\<acute>out \<and> \<acute>who=i}. \<acute>out:=True OD
+    .{False}. 
+ COEND
+  .{False}." 
+apply oghoare
+apply auto
+done
+
+subsubsection{* The Ticket Algorithm *}
+
+record Ticket_mutex =
+ num :: nat
+ nextv :: nat
+ turn :: "nat list"
+ index :: nat 
+
+lemma Ticket_mutex: 
+ "\<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 
+    \<longrightarrow> \<acute>turn!k < \<acute>num \<and> (\<acute>turn!k =0 \<or> \<acute>turn!k\<noteq>\<acute>turn!l))\<guillemotright> \<rbrakk>
+   \<Longrightarrow> \<parallel>- .{n=length \<acute>turn}.  
+   \<acute>index:= 0,,
+   WHILE \<acute>index < n INV .{n=length \<acute>turn \<and> (\<forall>i<\<acute>index. \<acute>turn!i=0)}. 
+    DO \<acute>turn:= \<acute>turn[\<acute>index:=0],, \<acute>index:=\<acute>index +1 OD,,
+  \<acute>num:=1 ,, \<acute>nextv:=1 ,, 
+ COBEGIN
+  SCHEME [0\<le> i< n]
+    .{\<acute>I}.  
+     WHILE True INV .{\<acute>I}.  
+      DO .{\<acute>I}. \<langle> \<acute>turn :=\<acute>turn[i:=\<acute>num],, \<acute>num:=\<acute>num+1 \<rangle>;;  
+         .{\<acute>I}. WAIT \<acute>turn!i=\<acute>nextv END;;
+         .{\<acute>I \<and> \<acute>turn!i=\<acute>nextv}. \<acute>nextv:=\<acute>nextv+1
+      OD
+    .{False}. 
+ COEND
+  .{False}." 
+apply oghoare
+--{* 35 vc *}
+apply simp_all
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply simp_all
+apply(tactic {* ALLGOALS Clarify_tac *})
+--{* 11 subgoals left *}
+apply(erule less_SucE)
+ apply simp
+apply simp
+--{* 10 subgoals left *}
+apply force
+apply(case_tac "i=k")
+ apply force
+apply simp
+apply(case_tac "i=l")
+ apply force
+apply force
+--{* 8 subgoals left *}
+prefer 8
+apply force
+apply force
+--{* 6 subgoals left *}
+prefer 6
+apply(erule_tac x=i in allE)
+apply force
+--{* 5 subgoals left *}
+prefer 5
+apply(rule conjI)
+ apply clarify
+prefer 2
+apply(case_tac "j=i")
+ apply simp
+apply simp
+--{* 4 subgoals left *}
+apply(tactic {* ALLGOALS (case_tac "j=k") *})
+apply simp_all
+apply(erule_tac x=i in allE)
+apply force
+apply(case_tac "j=l")
+ apply simp
+ apply(erule_tac x=k in allE)
+ apply(erule_tac x=k in allE)
+ apply(erule_tac x=l in allE)
+ apply force
+apply(erule_tac x=k in allE)
+apply(erule_tac x=k in allE)
+apply(erule_tac x=l in allE)
+apply force
+--{* 8 subgoals left *}
+apply force
+apply(case_tac "j=l")
+ apply simp
+apply(erule_tac x=k in allE)
+apply(erule_tac x=l in allE)
+apply force
+apply force
+apply force
+apply(erule_tac x=k in allE)
+apply(erule_tac x=l in allE)
+apply(case_tac "j=l")
+ apply force
+apply force
+apply force
+apply(erule_tac x=k in allE)
+apply(erule_tac x=l in allE)
+apply(case_tac "j=l")
+ apply force
+apply force
+apply force
+apply(erule_tac x=k in allE)
+apply(erule_tac x=l in allE)
+apply(case_tac "j=l")
+ apply force
+apply force
+done
+
+subsection{* Parallel Zero Search *}
+
+text {* Synchronized Zero Search. Zero-6 *}
+
+text {*Apt and Olderog. "Verification of sequential and concurrent Programs" page 294: *}
+
+record Zero_search =
+   turn :: nat
+   found :: bool
+   x :: nat
+   y :: nat
+
+lemma Zero_search: 
+  "\<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)) 
+      \<and> (\<not>\<acute>found \<and> a<\<acute> x \<longrightarrow> f(\<acute>x)\<noteq>0) \<guillemotright> ;  
+    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)) 
+      \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0) \<guillemotright> \<rbrakk> \<Longrightarrow>  
+  \<parallel>- .{\<exists> u. f(u)=0}.  
+  \<acute>turn:=1,, \<acute>found:= False,,  
+  \<acute>x:=a,, \<acute>y:=a+1 ,,  
+  COBEGIN .{\<acute>I1}.  
+       WHILE \<not>\<acute>found  
+       INV .{\<acute>I1}.  
+       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)}.  
+          WAIT \<acute>turn=1 END;;  
+          .{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)}.  
+          \<acute>turn:=2;;  
+          .{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)}.    
+          \<langle> \<acute>x:=\<acute>x+1,,  
+            IF f(\<acute>x)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
+       OD;;  
+       .{\<acute>I1  \<and> \<acute>found}.  
+       \<acute>turn:=2  
+       .{\<acute>I1 \<and> \<acute>found}.  
+  \<parallel>  
+      .{\<acute>I2}.  
+       WHILE \<not>\<acute>found  
+       INV .{\<acute>I2}.  
+       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)}.  
+          WAIT \<acute>turn=2 END;;  
+          .{\<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)}.  
+          \<acute>turn:=1;;  
+          .{\<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)}.  
+          \<langle> \<acute>y:=(\<acute>y - 1),,  
+            IF f(\<acute>y)=0 THEN \<acute>found:=True ELSE SKIP FI\<rangle>  
+       OD;;  
+       .{\<acute>I2 \<and> \<acute>found}.  
+       \<acute>turn:=1  
+       .{\<acute>I2 \<and> \<acute>found}.  
+  COEND  
+  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
+apply oghoare
+--{* 98 verification conditions *}
+apply auto 
+--{* auto takes about 3 minutes !! *}
+apply arith+
+done
+
+text {* Easier Version: without AWAIT.  Apt and Olderog. page 256: *}
+
+lemma Zero_Search_2: 
+"\<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)) 
+    \<and> (\<not>\<acute>found \<and> a<\<acute>x \<longrightarrow> f(\<acute>x)\<noteq>0)\<guillemotright>;  
+ 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)) 
+    \<and> (\<not>\<acute>found \<and> \<acute>y\<le>a \<longrightarrow> f(\<acute>y)\<noteq>0)\<guillemotright>\<rbrakk> \<Longrightarrow>  
+  \<parallel>- .{\<exists>u. f(u)=0}.  
+  \<acute>found:= False,,  
+  \<acute>x:=a,, \<acute>y:=a+1,,  
+  COBEGIN .{\<acute>I1}.  
+       WHILE \<not>\<acute>found  
+       INV .{\<acute>I1}.  
+       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)}.  
+          \<langle> \<acute>x:=\<acute>x+1,,IF f(\<acute>x)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
+       OD  
+       .{\<acute>I1 \<and> \<acute>found}.  
+  \<parallel>  
+      .{\<acute>I2}.  
+       WHILE \<not>\<acute>found  
+       INV .{\<acute>I2}.  
+       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)}.  
+          \<langle> \<acute>y:=(\<acute>y - 1),,IF f(\<acute>y)=0 THEN  \<acute>found:=True ELSE  SKIP FI\<rangle>  
+       OD  
+       .{\<acute>I2 \<and> \<acute>found}.  
+  COEND  
+  .{f(\<acute>x)=0 \<or> f(\<acute>y)=0}."
+apply oghoare
+--{* 20 vc *}
+apply auto
+--{* auto takes aprox. 2 minutes. *}
+apply arith+
+done
+
+subsection {* Producer/Consumer *}
+
+subsubsection {* Previous lemmas *}
+
+lemma nat_lemma1: "\<lbrakk>(c::nat) \<le> a ;a < b\<rbrakk> \<Longrightarrow> b - a \<le> b - c"
+by (simp split: nat_diff_split)
+
+lemma nat_lemma2: "\<lbrakk> b = m*(n::nat) + t; a = s*n + t ; b - a < n \<rbrakk> \<Longrightarrow> m - s = 0"
+proof -
+  assume "b = m*(n::nat) + t" and "a = s*n + t"
+  hence "(m - s) * n = b - a" by (simp add: diff_mult_distrib)
+  also assume "\<dots> < n"
+  finally have "m - s < 1" by simp
+  thus ?thesis by arith
+qed
+
+lemma less_imp_diff_is_0: "m < Suc(n) \<Longrightarrow> m-n = 0"
+by arith
+lemma mod_lemma: "\<lbrakk> (c::nat) \<le> a; a < b; b - c < n \<rbrakk> \<Longrightarrow> b mod n \<noteq> a mod n"
+apply(subgoal_tac "b=b div n*n + b mod n" )
+ prefer 2  apply (simp add: mod_div_equality [symmetric])
+apply(subgoal_tac "a=a div n*n + a mod n")
+ prefer 2
+ apply(simp add: mod_div_equality [symmetric])
+apply(frule nat_lemma1 , assumption)
+apply(drule le_less_trans)
+back
+ apply assumption
+apply(frule less_not_refl2)
+apply(drule less_imp_le)
+apply (drule_tac m = "a" in div_le_mono)
+apply(drule_tac m = "a div n" in le_imp_less_Suc)
+apply(drule less_imp_diff_is_0)
+apply(safe)
+apply(simp)
+apply(frule_tac b = "b" and a = "a" and n = "n" in nat_lemma2 , assumption)
+apply assumption
+apply(drule  diffs0_imp_equal)
+apply(simp)
+apply(simp)
+done
+
+subsubsection {* Producer/Consumer Algorithm *}
+
+record Producer_consumer =
+  ins :: nat
+  outs :: nat
+  li :: nat
+  lj :: nat
+  vx :: nat
+  vy :: nat
+  buffer :: "nat list"
+  b :: "nat list"
+
+text {* The whole proof takes aprox. 4 minutes. *}
+
+lemma Producer_consumer: 
+  "\<lbrakk>INIT= \<guillemotleft>0<length a \<and> 0<length \<acute>buffer \<and> length \<acute>b=length a\<guillemotright> ;  
+    I= \<guillemotleft>(\<forall>k<\<acute>ins. \<acute>outs\<le>k \<longrightarrow> (a ! k) = \<acute>buffer ! (k mod (length \<acute>buffer))) \<and>  
+            \<acute>outs\<le>\<acute>ins \<and> \<acute>ins-\<acute>outs\<le>length \<acute>buffer\<guillemotright> ;  
+    I1= \<guillemotleft>\<acute>I \<and> \<acute>li\<le>length a\<guillemotright> ;  
+    p1= \<guillemotleft>\<acute>I1 \<and> \<acute>li=\<acute>ins\<guillemotright> ;  
+    I2 = \<guillemotleft>\<acute>I \<and> (\<forall>k<\<acute>lj. (a ! k)=(\<acute>b ! k)) \<and> \<acute>lj\<le>length a\<guillemotright> ;
+    p2 = \<guillemotleft>\<acute>I2 \<and> \<acute>lj=\<acute>outs\<guillemotright> \<rbrakk> \<Longrightarrow>   
+  \<parallel>- .{\<acute>INIT}.  
+ \<acute>ins:=0,, \<acute>outs:=0,, \<acute>li:=0,, \<acute>lj:=0,,
+ COBEGIN .{\<acute>p1 \<and> \<acute>INIT}. 
+   WHILE \<acute>li <length a 
+     INV .{\<acute>p1 \<and> \<acute>INIT}.   
+   DO .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a}.  
+       \<acute>vx:= (a ! \<acute>li);;  
+      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li)}. 
+        WAIT \<acute>ins-\<acute>outs < length \<acute>buffer END;; 
+      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a \<and> \<acute>vx=(a ! \<acute>li) 
+         \<and> \<acute>ins-\<acute>outs < length \<acute>buffer}. 
+       \<acute>buffer:=(list_update \<acute>buffer (\<acute>ins mod (length \<acute>buffer)) \<acute>vx);; 
+      .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li<length a 
+         \<and> (a ! \<acute>li)=(\<acute>buffer ! (\<acute>ins mod (length \<acute>buffer))) 
+         \<and> \<acute>ins-\<acute>outs <length \<acute>buffer}.  
+       \<acute>ins:=\<acute>ins+1;; 
+      .{\<acute>I1 \<and> \<acute>INIT \<and> (\<acute>li+1)=\<acute>ins \<and> \<acute>li<length a}.  
+       \<acute>li:=\<acute>li+1  
+   OD  
+  .{\<acute>p1 \<and> \<acute>INIT \<and> \<acute>li=length a}.  
+  \<parallel>  
+  .{\<acute>p2 \<and> \<acute>INIT}.  
+   WHILE \<acute>lj < length a  
+     INV .{\<acute>p2 \<and> \<acute>INIT}.  
+   DO .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>INIT}.  
+        WAIT \<acute>outs<\<acute>ins END;; 
+      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>INIT}.  
+       \<acute>vy:=(\<acute>buffer ! (\<acute>outs mod (length \<acute>buffer)));; 
+      .{\<acute>p2 \<and> \<acute>lj<length a \<and> \<acute>outs<\<acute>ins \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
+       \<acute>outs:=\<acute>outs+1;;  
+      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> \<acute>vy=(a ! \<acute>lj) \<and> \<acute>INIT}.  
+       \<acute>b:=(list_update \<acute>b \<acute>lj \<acute>vy);; 
+      .{\<acute>I2 \<and> (\<acute>lj+1)=\<acute>outs \<and> \<acute>lj<length a \<and> (a ! \<acute>lj)=(\<acute>b ! \<acute>lj) \<and> \<acute>INIT}.  
+       \<acute>lj:=\<acute>lj+1  
+   OD  
+  .{\<acute>p2 \<and> \<acute>lj=length a \<and> \<acute>INIT}.  
+ COEND  
+ .{ \<forall>k<length a. (a ! k)=(\<acute>b ! k)}."
+apply oghoare
+--{* 138 vc  *}
+apply(tactic {* ALLGOALS Clarify_tac *})
+--{* 112 subgoals left *}
+apply(simp_all (no_asm))
+apply(tactic {*ALLGOALS (conjI_Tac (K all_tac)) *})
+--{* 860 subgoals left *}
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(simp_all only:length_0_conv [THEN sym])
+--{* 36 subgoals left *}
+apply (simp_all del:length_0_conv add: nth_list_update mod_less_divisor mod_lemma)
+--{* 32 subgoals left *}
+apply(tactic {* ALLGOALS Clarify_tac *})
+apply(tactic {* TRYALL arith_tac *})
+--{* 9 subgoals left *}
+apply (force simp add:less_Suc_eq)
+apply(drule sym)
+apply (force simp add:less_Suc_eq)+
+done
+
+subsection {* Parameterized Examples *}
+
+subsubsection {* Set Elements of an Array to Zero *}
+
+record scheme1_vars =
+  a :: "nat \<Rightarrow> nat"
+lemma scheme1: 
+ "\<parallel>- .{True}.
+   COBEGIN SCHEME [0\<le>i<n] .{True}. \<acute>a:=\<acute>a (i:=0) .{\<acute>a i=0}. COEND 
+  .{\<forall>i < n. \<acute>a i = 0}."
+apply oghoare
+apply simp_all
+done
+
+text {* Same example with lists as auxiliary variables. *}
+record scheme1_list_vars =
+  a :: "nat list"
+lemma scheme1_list: 
+ "\<parallel>- .{n < length \<acute>a}. 
+   COBEGIN 
+     SCHEME [0\<le>i<n] .{n < length \<acute>a}. \<acute>a:=\<acute>a[i:=0] .{\<acute>a!i=0}. 
+   COEND 
+    .{\<forall>i < n. \<acute>a!i = 0}."
+apply oghoare
+apply simp_all
+  apply force+
+apply clarify
+apply (simp add:nth_list_update)
+done
+
+subsubsection {* Increment a Variable in Parallel *}
+
+text {* First some lemmas about summation properties. Summation is
+defined in PreList. *}
+
+lemma scheme2_lemma1: "!!b. j<n \<Longrightarrow> (\<Sum>i<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
+apply(induct n)
+ apply simp_all
+apply(force simp add: less_Suc_eq)
+done
+
+lemma scheme2_lemma2_aux: "!!b. 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))"
+apply(induct n)
+ apply simp_all
+apply(simp add:less_Suc_eq)
+ apply(auto)
+apply(subgoal_tac "n - j = Suc(n- Suc j)")
+  apply simp
+apply arith
+done 
+
+lemma scheme2_lemma2_aux2: "!!b. j\<le> s \<Longrightarrow> (\<Sum>i<j. (b (s:=t)) i) = (\<Sum>i<j. b i)"
+apply(induct j)
+ apply simp_all
+done
+
+lemma scheme2_lemma2 [rule_format]: 
+ "!!b. \<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i< n. b i)=(\<Sum>i< n. (b (j := Suc 0)) i)"
+apply(frule_tac b="(b (j:=(Suc 0)))" in scheme2_lemma2_aux)
+apply(erule_tac  t="Summation (b(j := (Suc 0))) n" in ssubst)
+apply(frule_tac b=b in scheme2_lemma2_aux)
+apply(erule_tac  t="Summation b n" in ssubst)
+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)))")
+apply(rotate_tac -1)
+apply(erule ssubst)
+apply(subgoal_tac "j\<le>j")
+ apply(drule_tac b="b" and t="(Suc 0)" in scheme2_lemma2_aux2)
+apply(rotate_tac -1)
+apply(erule ssubst)
+apply simp_all
+done
+
+lemma scheme2_lemma3: "!!b. \<forall>i< n. b i = (Suc 0) \<Longrightarrow> (\<Sum>i<n. b i)= n"
+apply (induct n)
+apply auto
+done
+
+record scheme2_vars = 
+ c :: "nat \<Rightarrow> nat" 
+ x :: nat
+lemma scheme_2: "0<n \<Longrightarrow> 
+ \<parallel>- .{\<acute>x=0 \<and> (\<Sum>i< n. \<acute>c i)=0}.  
+ COBEGIN 
+   SCHEME [0\<le>i<n] 
+  .{\<acute>x=(\<Sum>i< n. \<acute>c i) \<and> \<acute>c i=0}. 
+   \<langle> \<acute>x:=\<acute>x+(Suc 0),, \<acute>c:=\<acute>c (i:=(Suc 0)) \<rangle>
+  .{\<acute>x=(\<Sum>i< n. \<acute>c i) \<and> \<acute>c i=(Suc 0)}.
+ COEND 
+ .{\<acute>x=n}."
+apply oghoare
+apply simp_all
+apply (tactic {* ALLGOALS Clarify_tac *})
+apply simp_all
+    apply(force elim:scheme2_lemma1)
+   apply(erule scheme2_lemma2)
+   apply simp
+  apply(erule scheme2_lemma2)
+  apply simp
+ apply(erule scheme2_lemma2)
+ apply simp
+apply(force intro: scheme2_lemma3)
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Hoare.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Hoare.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,495 @@
+
+header {* \section{The Proof System} *}
+
+theory OG_Hoare = OG_Tran:
+
+consts assertions :: "'a ann_com \<Rightarrow> ('a assn) set"
+primrec
+  "assertions (AnnBasic r f) = {r}"
+  "assertions (AnnSeq c1 c2) = assertions c1 \<union> assertions c2"
+  "assertions (AnnCond1 r b c1 c2) = {r} \<union> assertions c1 \<union> assertions c2"
+  "assertions (AnnCond2 r b c) = {r} \<union> assertions c"
+  "assertions (AnnWhile r b i c) = {r, i} \<union> assertions c"
+  "assertions (AnnAwait r b c) = {r}" 
+
+consts atomics :: "'a ann_com \<Rightarrow> ('a assn \<times> 'a com) set"       
+primrec
+  "atomics (AnnBasic r f) = {(r, Basic f)}"
+  "atomics (AnnSeq c1 c2) = atomics c1 \<union> atomics c2"
+  "atomics (AnnCond1 r b c1 c2) = atomics c1 \<union> atomics c2"
+  "atomics (AnnCond2 r b c) = atomics c"
+  "atomics (AnnWhile r b i c) = atomics c" 
+  "atomics (AnnAwait r b c) = {(r \<inter> b, c)}"
+
+consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
+primrec "com (c, q) = c"
+
+consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
+primrec "post (c, q) = q"
+
+constdefs  interfree_aux :: "('a ann_com_op \<times> 'a assn \<times> 'a ann_com_op) \<Rightarrow> bool"
+  "interfree_aux \<equiv> \<lambda>(co, q, co'). co'= None \<or>  
+                    (\<forall>(r,a) \<in> atomics (the co'). \<parallel>= (q \<inter> r) a q \<and>
+                    (co = None \<or> (\<forall>p \<in> assertions (the co). \<parallel>= (p \<inter> r) a p)))"
+
+constdefs interfree :: "(('a ann_triple_op) list) \<Rightarrow> bool" 
+  "interfree Ts \<equiv> \<forall>i j. i < length Ts \<and> j < length Ts \<and> i \<noteq> j \<longrightarrow> 
+                         interfree_aux (com (Ts!i), post (Ts!i), com (Ts!j)) "
+
+consts ann_hoare :: "('a ann_com \<times> 'a assn) set" 
+syntax "_ann_hoare" :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(2\<turnstile> _// _)" [60,90] 45)
+translations "\<turnstile> c q" \<rightleftharpoons> "(c, q) \<in> ann_hoare"
+
+consts oghoare :: "('a assn \<times> 'a com \<times> 'a assn) set"
+syntax "_oghoare" :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>- _//_//_)" [90,55,90] 50)
+translations "\<parallel>- p c q" \<rightleftharpoons> "(p, c, q) \<in> oghoare"
+
+inductive oghoare ann_hoare
+intros
+  AnnBasic: "r \<subseteq> {s. f s \<in> q} \<Longrightarrow> \<turnstile> (AnnBasic r f) q"
+
+  AnnSeq:   "\<lbrakk> \<turnstile> c0 pre c1; \<turnstile> c1 q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnSeq c0 c1) q"
+  
+  AnnCond1: "\<lbrakk> r \<inter> b \<subseteq> pre c1; \<turnstile> c1 q; r \<inter> -b \<subseteq> pre c2; \<turnstile> c2 q\<rbrakk> 
+              \<Longrightarrow> \<turnstile> (AnnCond1 r b c1 c2) q"
+  AnnCond2: "\<lbrakk> r \<inter> b \<subseteq> pre c; \<turnstile> c q; r \<inter> -b \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnCond2 r b c) q"
+  
+  AnnWhile: "\<lbrakk> r \<subseteq> i; i \<inter> b \<subseteq> pre c; \<turnstile> c i; i \<inter> -b \<subseteq> q \<rbrakk> 
+              \<Longrightarrow> \<turnstile> (AnnWhile r b i c) q"
+  
+  AnnAwait:  "\<lbrakk> atom_com c; \<parallel>- (r \<inter> b) c q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b c) q"
+  
+  AnnConseq: "\<lbrakk>\<turnstile> c q; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<turnstile> c q'"
+
+
+  Parallel: "\<lbrakk> \<forall>i<length Ts. \<exists>c q. Ts!i = (Some c, q) \<and> \<turnstile> c q; interfree Ts \<rbrakk>
+	   \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
+                     Parallel Ts 
+                  (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
+
+  Basic:   "\<parallel>- {s. f s \<in>q} (Basic f) q"
+  
+  Seq:    "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q "
+
+  Cond:   "\<lbrakk> \<parallel>- (p \<inter> b) c1 q; \<parallel>- (p \<inter> -b) c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
+
+  While:  "\<lbrakk> \<parallel>- (p \<inter> b) c p \<rbrakk> \<Longrightarrow> \<parallel>- p (While b i c) (p \<inter> -b)"
+
+  Conseq: "\<lbrakk> p' \<subseteq> p; \<parallel>- p c q ; q \<subseteq> q' \<rbrakk> \<Longrightarrow> \<parallel>- p' c q'"
+					    
+section {* Soundness *}
+(* In the version Isabelle-10-Sep-1999: HOL: The THEN and ELSE
+parts of conditional expressions (if P then x else y) are no longer
+simplified.  (This allows the simplifier to unfold recursive
+functional programs.)  To restore the old behaviour, we declare
+@{text "lemmas [cong del] = if_weak_cong"}. *)
+
+lemmas [cong del] = if_weak_cong
+
+lemmas ann_hoare_induct = oghoare_ann_hoare.induct [THEN conjunct2]
+lemmas oghoare_induct = oghoare_ann_hoare.induct [THEN conjunct1]
+
+lemmas AnnBasic = oghoare_ann_hoare.AnnBasic
+lemmas AnnSeq = oghoare_ann_hoare.AnnSeq
+lemmas AnnCond1 = oghoare_ann_hoare.AnnCond1
+lemmas AnnCond2 = oghoare_ann_hoare.AnnCond2
+lemmas AnnWhile = oghoare_ann_hoare.AnnWhile
+lemmas AnnAwait = oghoare_ann_hoare.AnnAwait
+lemmas AnnConseq = oghoare_ann_hoare.AnnConseq
+
+lemmas Parallel = oghoare_ann_hoare.Parallel
+lemmas Basic = oghoare_ann_hoare.Basic
+lemmas Seq = oghoare_ann_hoare.Seq
+lemmas Cond = oghoare_ann_hoare.Cond
+lemmas While = oghoare_ann_hoare.While
+lemmas Conseq = oghoare_ann_hoare.Conseq
+
+subsection {* Soundness of the System for Atomic Programs *}
+
+lemma Basic_ntran [rule_format]: 
+ "(Basic f, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow> t = f s"
+apply(induct "n")
+ apply(simp (no_asm))
+apply(fast dest: rel_pow_Suc_D2 Parallel_empty_lemma elim: transition_cases)
+done
+
+lemma SEM_fwhile: "SEM S (p \<inter> b) \<subseteq> p \<Longrightarrow> SEM (fwhile b S k) p \<subseteq> (p \<inter> -b)"
+apply (induct "k")
+ apply(simp (no_asm) add: L3_5v_lemma3)
+apply(simp (no_asm) add: L3_5iv L3_5ii Parallel_empty)
+apply(rule Un_least)
+ apply(rule subset_trans)
+  prefer 2 apply simp
+ apply(erule L3_5i)
+apply(simp add: SEM_def sem_def id_def)
+apply clarify
+apply(drule rtrancl_imp_UN_rel_pow)
+apply clarify
+apply(drule Basic_ntran)
+ apply fast+
+done
+
+lemma atom_hoare_sound [rule_format (no_asm)]: 
+ " \<parallel>- p c q \<longrightarrow> atom_com(c) \<longrightarrow> \<parallel>= p c q"
+apply (unfold com_validity_def)
+apply(rule oghoare_induct)
+apply simp_all
+--{*Basic*}
+    apply(simp add: SEM_def sem_def)
+    apply(fast dest: rtrancl_imp_UN_rel_pow Basic_ntran)
+--{* Seq *}
+   apply(rule impI)
+   apply(rule subset_trans)
+    prefer 2 apply simp
+   apply(simp add: L3_5ii L3_5i)
+--{* Cond *}
+  apply(rule impI)
+  apply(simp add: L3_5iv)
+  apply(erule Un_least)
+  apply assumption
+--{* While *}
+ apply(rule impI)
+ apply(simp add: L3_5v)
+ apply(rule UN_least)
+ apply(drule SEM_fwhile)
+ apply assumption
+--{* Conseq *}
+apply(simp add: SEM_def sem_def)
+apply force
+done
+    
+subsection {* Soundness of the System for Component Programs *}
+
+inductive_cases ann_transition_cases:
+    "(None,s) -1\<rightarrow> t"
+    "(Some (AnnBasic r f),s) -1\<rightarrow> t"
+    "(Some (AnnSeq c1 c2), s) -1\<rightarrow> t" 
+    "(Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> t"
+    "(Some (AnnCond2 r b c), s) -1\<rightarrow> t"
+    "(Some (AnnWhile r b I c), s) -1\<rightarrow> t"
+    "(Some (AnnAwait r b c),s) -1\<rightarrow> t"
+
+text {* Strong Soundness for Component Programs:*}
+
+lemma ann_hoare_case_analysis [rule_format]: "\<turnstile> C q' \<longrightarrow>  
+  ((\<forall>r f. C = AnnBasic r f \<longrightarrow> (\<exists>q. r \<subseteq> {s. f s \<in> q} \<and> q \<subseteq> q')) \<and>  
+  (\<forall>c0 c1. C = AnnSeq c0 c1 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<turnstile> c0 pre c1 \<and> \<turnstile> c1 q)) \<and>  
+  (\<forall>r b c1 c2. C = AnnCond1 r b c1 c2 \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and>  
+  r \<inter> b \<subseteq> pre c1 \<and> \<turnstile> c1 q \<and> r \<inter> -b \<subseteq> pre c2 \<and> \<turnstile> c2 q)) \<and>  
+  (\<forall>r b c. C = AnnCond2 r b c \<longrightarrow> 
+  (\<exists>q. q \<subseteq> q' \<and> r \<inter> b \<subseteq> pre c  \<and> \<turnstile> c q \<and> r \<inter> -b \<subseteq> q)) \<and>  
+  (\<forall>r i b c. C = AnnWhile r b i c \<longrightarrow>  
+  (\<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>  
+  (\<forall>r b c. C = AnnAwait r b c \<longrightarrow> (\<exists>q. q \<subseteq> q' \<and> \<parallel>- (r \<inter> b) c q)))"
+apply(rule ann_hoare_induct)
+apply simp_all
+ apply(rule_tac x=q in exI,simp)+
+apply(rule conjI,clarify,simp,clarify,rule_tac x=qa in exI,fast)+
+apply(clarify,simp,clarify,rule_tac x=qa in exI,fast)
+done
+
+lemma Help: "(transition \<inter> {(v,v,u). True}) = (transition)"
+apply force
+done
+
+lemma Strong_Soundness_aux_aux [rule_format]: 
+ "(co, s) -1\<rightarrow> (co', t) \<longrightarrow> (\<forall>c. co = Some c \<longrightarrow> s\<in> pre c \<longrightarrow> 
+ (\<forall>q. \<turnstile> c q \<longrightarrow> (if co' = None then t\<in>q else t \<in> pre(the co') \<and> \<turnstile> (the co') q )))"
+apply(rule ann_transition_transition.induct [THEN conjunct1])
+apply simp_all 
+--{* Basic *}
+         apply clarify
+         apply(frule ann_hoare_case_analysis)
+         apply force
+--{* Seq *}
+        apply clarify
+        apply(frule ann_hoare_case_analysis,simp)
+        apply(fast intro: AnnConseq)
+       apply clarify
+       apply(frule ann_hoare_case_analysis,simp)
+       apply clarify
+       apply(rule conjI)
+        apply force
+       apply(rule AnnSeq,simp)
+       apply(fast intro: AnnConseq)
+--{* Cond1 *}
+      apply clarify
+      apply(frule ann_hoare_case_analysis,simp)
+      apply(fast intro: AnnConseq)
+     apply clarify
+     apply(frule ann_hoare_case_analysis,simp)
+     apply(fast intro: AnnConseq)
+--{* Cond2 *}
+    apply clarify
+    apply(frule ann_hoare_case_analysis,simp)
+    apply(fast intro: AnnConseq)
+   apply clarify
+   apply(frule ann_hoare_case_analysis,simp)
+   apply(fast intro: AnnConseq)
+--{* While *}
+  apply clarify
+  apply(frule ann_hoare_case_analysis,simp)
+  apply force
+ apply clarify
+ apply(frule ann_hoare_case_analysis,simp)
+ apply auto
+ apply(rule AnnSeq)
+  apply simp
+ apply(rule AnnWhile)
+  apply simp_all
+ apply(fast)
+--{* Await *}
+apply(frule ann_hoare_case_analysis,simp)
+apply clarify
+apply(drule atom_hoare_sound)
+ apply simp 
+apply(simp add: com_validity_def SEM_def sem_def)
+apply(simp add: Help All_None_def)
+apply force
+done
+
+lemma Strong_Soundness_aux: "\<lbrakk> (Some c, s) -*\<rightarrow> (co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
+  \<Longrightarrow> if co = None then t \<in> q else t \<in> pre (the co) \<and> \<turnstile> (the co) q"
+apply(erule rtrancl_induct2)
+ apply simp
+apply(case_tac "a")
+ apply(fast elim: ann_transition_cases)
+apply(erule Strong_Soundness_aux_aux)
+ apply simp
+apply simp_all
+done
+
+lemma Strong_Soundness: "\<lbrakk> (Some c, s)-*\<rightarrow>(co, t); s \<in> pre c; \<turnstile> c q \<rbrakk>  
+  \<Longrightarrow> if co = None then t\<in>q else t \<in> pre (the co)"
+apply(force dest:Strong_Soundness_aux)
+done
+
+lemma ann_hoare_sound: "\<turnstile> c q  \<Longrightarrow> \<Turnstile> c q"
+apply (unfold ann_com_validity_def ann_SEM_def ann_sem_def)
+apply clarify
+apply(drule Strong_Soundness)
+apply simp_all
+done
+
+subsection {* Soundness of the System for Parallel Programs *}
+
+lemma Parallel_length_post_P1: "(Parallel Ts,s) -P1\<rightarrow> (R', t) \<Longrightarrow>  
+  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>
+  (\<forall>i. i<length Ts \<longrightarrow> post(Rs ! i) = post(Ts ! i)))"
+apply(erule transition_cases)
+apply simp
+apply clarify
+apply(case_tac "i=ia")
+apply simp+
+done
+
+lemma Parallel_length_post_PStar: "(Parallel Ts,s) -P*\<rightarrow> (R',t) \<Longrightarrow>   
+  (\<exists>Rs. R' = (Parallel Rs) \<and> (length Rs) = (length Ts) \<and>  
+  (\<forall>i. i<length Ts \<longrightarrow> post(Ts ! i) = post(Rs ! i)))"
+apply(erule rtrancl_induct2)
+ apply(simp_all)
+apply clarify
+apply simp
+apply(drule Parallel_length_post_P1)
+apply auto
+done
+
+lemma assertions_lemma: "pre c \<in> assertions c"
+apply(rule ann_com_com.induct [THEN conjunct1])
+apply auto
+done
+
+lemma interfree_aux1 [rule_format]: 
+  "(c,s) -1\<rightarrow> (r,t)  \<longrightarrow> (interfree_aux(c1, q1, c) \<longrightarrow> interfree_aux(c1, q1, r))"
+apply (rule ann_transition_transition.induct [THEN conjunct1])
+apply(safe)
+prefer 13
+apply (rule TrueI)
+apply (simp_all add:interfree_aux_def)
+apply force+
+done
+
+lemma interfree_aux2 [rule_format]: 
+  "(c,s) -1\<rightarrow> (r,t) \<longrightarrow> (interfree_aux(c, q, a)  \<longrightarrow> interfree_aux(r, q, a) )"
+apply (rule ann_transition_transition.induct [THEN conjunct1])
+apply(force simp add:interfree_aux_def)+
+done
+
+lemma interfree_lemma: "\<lbrakk> (Some c, s) -1\<rightarrow> (r, t);interfree Ts ; i<length Ts;  
+           Ts!i = (Some c, q) \<rbrakk> \<Longrightarrow> interfree (Ts[i:= (r, q)])"
+apply(simp add: interfree_def)
+apply clarify
+apply(case_tac "i=j")
+ apply(drule_tac t = "ia" in not_sym)
+ apply simp_all
+apply(force elim: interfree_aux1)
+apply(force elim: interfree_aux2 simp add:nth_list_update)
+done
+
+text {* Strong Soundness Theorem for Parallel Programs:*}
+
+lemma Parallel_Strong_Soundness_Seq_aux: 
+  "\<lbrakk>interfree Ts; i<length Ts; com(Ts ! i) = Some(AnnSeq c0 c1) \<rbrakk> 
+  \<Longrightarrow>  interfree (Ts[i:=(Some c0, pre c1)])"
+apply(simp add: interfree_def)
+apply clarify
+apply(case_tac "i=j")
+ apply(force simp add: nth_list_update interfree_aux_def)
+apply(case_tac "i=ia")
+ apply(erule_tac x=ia in allE)
+ apply(force simp add:interfree_aux_def assertions_lemma)
+apply simp
+done
+
+lemma Parallel_Strong_Soundness_Seq [rule_format (no_asm)]: 
+ "\<lbrakk> \<forall>i<length Ts. (if com(Ts!i) = None then b \<in> post(Ts!i) 
+  else b \<in> pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i));  
+  com(Ts ! i) = Some(AnnSeq c0 c1); i<length Ts; interfree Ts \<rbrakk> \<Longrightarrow> 
+ (\<forall>ia<length Ts. (if com(Ts[i:=(Some c0, pre c1)]! ia) = None  
+  then b \<in> post(Ts[i:=(Some c0, pre c1)]! ia) 
+ else b \<in> pre(the(com(Ts[i:=(Some c0, pre c1)]! ia))) \<and>  
+ \<turnstile> the(com(Ts[i:=(Some c0, pre c1)]! ia)) post(Ts[i:=(Some c0, pre c1)]! ia))) 
+  \<and> interfree (Ts[i:= (Some c0, pre c1)])"
+apply(rule conjI)
+ apply safe
+ apply(case_tac "i=ia")
+  apply simp
+  apply(force dest: ann_hoare_case_analysis)
+ apply simp
+apply(fast elim: Parallel_Strong_Soundness_Seq_aux)
+done
+
+lemma Parallel_Strong_Soundness_aux_aux [rule_format]: 
+ "(Some c, b) -1\<rightarrow> (co, t) \<longrightarrow>  
+  (\<forall>Ts. i<length Ts \<longrightarrow> com(Ts ! i) = Some c \<longrightarrow>  
+  (\<forall>i<length Ts. (if com(Ts ! i) = None then b\<in>post(Ts!i)  
+  else b\<in>pre(the(com(Ts!i))) \<and> \<turnstile> the(com(Ts!i)) post(Ts!i))) \<longrightarrow>  
+ interfree Ts \<longrightarrow>  
+  (\<forall>j. j<length Ts \<and> i\<noteq>j \<longrightarrow> (if com(Ts!j) = None then t\<in>post(Ts!j)  
+  else t\<in>pre(the(com(Ts!j))) \<and> \<turnstile> the(com(Ts!j)) post(Ts!j))) )"
+apply(rule ann_transition_transition.induct [THEN conjunct1])
+apply safe
+prefer 11
+apply(rule TrueI)
+apply simp_all
+--{* Basic *}
+   apply(erule_tac x = "i" in all_dupE, erule (1) notE impE)
+   apply(erule_tac x = "j" in allE , erule (1) notE impE)
+   apply(simp add: interfree_def)
+   apply(erule_tac x = "j" in allE,simp)
+   apply(erule_tac x = "i" in allE,simp)
+   apply(drule_tac t = "i" in not_sym)
+   apply(case_tac "com(Ts ! j)=None")
+    apply(force intro: converse_rtrancl_into_rtrancl
+          simp add: interfree_aux_def com_validity_def SEM_def sem_def All_None_def)
+   apply(simp add:interfree_aux_def)
+   apply clarify
+   apply simp
+   apply clarify
+   apply(erule_tac x="pre y" in ballE)
+    apply(force intro: converse_rtrancl_into_rtrancl 
+          simp add: com_validity_def SEM_def sem_def All_None_def)
+   apply(simp add:assertions_lemma)
+--{* Seqs *}
+  apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
+  apply(drule  Parallel_Strong_Soundness_Seq,simp+)
+ apply(erule_tac x = "Ts[i:=(Some c0, pre c1)]" in allE)
+ apply(drule  Parallel_Strong_Soundness_Seq,simp+)
+--{* Await *}
+apply(rule_tac x = "i" in allE , assumption , erule (1) notE impE)
+apply(erule_tac x = "j" in allE , erule (1) notE impE)
+apply(simp add: interfree_def)
+apply(erule_tac x = "j" in allE,simp)
+apply(erule_tac x = "i" in allE,simp)
+apply(drule_tac t = "i" in not_sym)
+apply(case_tac "com(Ts ! j)=None")
+ apply(force intro: converse_rtrancl_into_rtrancl simp add: interfree_aux_def 
+        com_validity_def SEM_def sem_def All_None_def Help)
+apply(simp add:interfree_aux_def)
+apply clarify
+apply simp
+apply clarify
+apply(erule_tac x="pre y" in ballE)
+ apply(force intro: converse_rtrancl_into_rtrancl 
+       simp add: com_validity_def SEM_def sem_def All_None_def Help)
+apply(simp add:assertions_lemma)
+done
+
+lemma Parallel_Strong_Soundness_aux [rule_format]: 
+ "\<lbrakk>(Ts',s) -P*\<rightarrow> (Rs',t);  Ts' = (Parallel Ts); interfree Ts;
+ \<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>  
+  \<forall>Rs. Rs' = (Parallel Rs) \<longrightarrow> (\<forall>j. j<length Rs \<longrightarrow> 
+  (if com(Rs ! j) = None then t\<in>post(Ts ! j) 
+  else t\<in>pre(the(com(Rs ! j))) \<and> \<turnstile> the(com(Rs ! j)) post(Ts ! j))) \<and> interfree Rs"
+apply(erule rtrancl_induct2)
+ apply clarify
+--{* Base *}
+ apply force
+--{* Induction step *}
+apply clarify
+apply(drule Parallel_length_post_PStar)
+apply clarify
+apply (ind_cases "(Parallel Ts, s) -P1\<rightarrow> (Parallel Rs, t)")
+apply(rule conjI)
+ apply clarify
+ apply(case_tac "i=j")
+  apply(simp split del:split_if)
+  apply(erule Strong_Soundness_aux_aux,simp+)
+   apply force
+  apply force
+ apply(simp split del: split_if)
+ apply(erule Parallel_Strong_Soundness_aux_aux)
+ apply(simp_all add: split del:split_if)
+ apply force
+apply(rule interfree_lemma)
+apply simp_all
+done
+
+lemma Parallel_Strong_Soundness: 
+ "\<lbrakk>(Parallel Ts, s) -P*\<rightarrow> (Parallel Rs, t); interfree Ts; j<length Rs; 
+  \<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>  
+  if com(Rs ! j) = None then t\<in>post(Ts ! j) else t\<in>pre (the(com(Rs ! j)))"
+apply(drule  Parallel_Strong_Soundness_aux)
+apply simp+
+done
+
+lemma oghoare_sound [rule_format (no_asm)]: "\<parallel>- p c q \<longrightarrow> \<parallel>= p c q"
+apply (unfold com_validity_def)
+apply(rule oghoare_induct)
+apply(rule TrueI)+
+--{* Parallel *}     
+      apply(simp add: SEM_def sem_def)
+      apply clarify
+      apply(frule Parallel_length_post_PStar)
+      apply clarify
+      apply(drule_tac j=i in Parallel_Strong_Soundness)
+         apply clarify
+        apply simp
+       apply force
+      apply simp
+      apply(erule_tac V = "\<forall>i. ?P i" in thin_rl)
+      apply(drule_tac s = "length Rs" in sym)
+      apply(erule allE, erule impE, assumption)
+      apply(force dest: nth_mem simp add: All_None_def)
+--{* Basic *}
+    apply(simp add: SEM_def sem_def)
+    apply(force dest: rtrancl_imp_UN_rel_pow Basic_ntran)
+--{* Seq *}
+   apply(rule subset_trans)
+    prefer 2 apply assumption
+   apply(simp add: L3_5ii L3_5i)
+--{* Cond *}
+  apply(simp add: L3_5iv)
+  apply(erule Un_least)
+  apply assumption
+--{* While *}
+ apply(simp add: L3_5v)
+ apply(rule UN_least)
+ apply(drule SEM_fwhile)
+ apply assumption
+--{* Conseq *}
+apply(simp add: SEM_def sem_def)
+apply auto
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Syntax.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Syntax.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,137 @@
+
+header {* \section{Concrete Syntax} *}
+
+theory OG_Syntax = Quote_Antiquote + OG_Tactics:
+
+text{* Syntax for commands and for assertions and boolean expressions in 
+ commands @{text com} and annotated commands @{text ann_com}. *}
+
+syntax
+  "_Assign"      :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(\<acute>_ :=/ _)" [70, 65] 61)
+  "_AnnAssign"   :: "'a assn \<Rightarrow> idt \<Rightarrow> 'b \<Rightarrow> 'a com"    ("(_ \<acute>_ :=/ _)" [90,70,65] 61)
+
+translations
+  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
+  "r \<acute>\<spacespace>x := a" \<rightharpoonup> "AnnBasic r \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
+
+syntax
+  "_AnnSkip"     :: "'a assn \<Rightarrow> 'a ann_com"              ("_//SKIP" [90] 63)
+  "_AnnSeq"      :: "'a ann_com \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"  ("_;;/ _" [60,61] 60)
+  
+  "_AnnCond1"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
+                    ("_ //IF _ /THEN _ /ELSE _ /FI"  [90,0,0,0] 61)
+  "_AnnCond2"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com"
+                    ("_ //IF _ /THEN _ /FI"  [90,0,0] 61)
+  "_AnnWhile"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a assn \<Rightarrow> 'a ann_com \<Rightarrow> 'a ann_com" 
+                    ("_ //WHILE _ /INV _ //DO _//OD"  [90,0,0,0] 61)
+  "_AnnAwait"    :: "'a assn \<Rightarrow> 'a bexp  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"
+                    ("_ //AWAIT _ /THEN /_ /END"  [90,0,0] 61)
+  "_AnnAtom"     :: "'a assn  \<Rightarrow> 'a com \<Rightarrow> 'a ann_com"   ("_//\<langle>_\<rangle>" [90,0] 61)
+  "_AnnWait"     :: "'a assn \<Rightarrow> 'a bexp \<Rightarrow> 'a ann_com"   ("_//WAIT _ END" [90,0] 61)
+
+  "_Skip"        :: "'a com"                 ("SKIP" 63)
+  "_Seq"         :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" ("_,,/ _" [55, 56] 55)
+  "_Cond"        :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com" 
+                                  ("(0IF _/ THEN _/ ELSE _/ FI)" [0, 0, 0] 61)
+  "_Cond2"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("IF _ THEN _ FI" [0,0] 56)
+  "_While_inv"   :: "'a bexp \<Rightarrow> 'a assn \<Rightarrow> 'a com \<Rightarrow> 'a com"
+                    ("(0WHILE _/ INV _ //DO _ /OD)"  [0, 0, 0] 61)
+  "_While"       :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"
+                    ("(0WHILE _ //DO _ /OD)"  [0, 0] 61)
+
+translations
+  "SKIP" \<rightleftharpoons> "Basic id"
+  "c_1,, c_2" \<rightleftharpoons> "Seq c_1 c_2"
+
+  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
+  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
+  "WHILE b INV i DO c OD" \<rightharpoonup> "While .{b}. i c"
+  "WHILE b DO c OD" \<rightleftharpoons> "WHILE b INV arbitrary DO c OD"
+
+  "r SKIP" \<rightleftharpoons> "AnnBasic r id"
+  "c_1;; c_2" \<rightleftharpoons> "AnnSeq c_1 c_2" 
+  "r IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "AnnCond1 r .{b}. c1 c2"
+  "r IF b THEN c FI" \<rightharpoonup> "AnnCond2 r .{b}. c"
+  "r WHILE b INV i DO c OD" \<rightharpoonup> "AnnWhile r .{b}. i c"
+  "r AWAIT b THEN c END" \<rightharpoonup> "AnnAwait r .{b}. c"
+  "r \<langle>c\<rangle>" \<rightleftharpoons> "r AWAIT True THEN c END"
+  "r WAIT b END" \<rightleftharpoons> "r AWAIT b THEN SKIP END"
+ 
+nonterminals
+  prgs
+
+syntax
+  "_PAR" :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" [57] 56)
+  "_prg" :: "['a, 'a] \<Rightarrow> prgs"        ("_//_" [60, 90] 57)
+  "_prgs" :: "['a, 'a, prgs] \<Rightarrow> prgs"  ("_//_//\<parallel>//_" [60,90,57] 57)
+
+  "_prg_scheme" :: "['a, 'a, 'a, 'a, 'a] \<Rightarrow> prgs"  
+                  ("SCHEME [_ \<le> _ < _] _// _" [0,0,0,60, 90] 57)
+
+translations
+  "_prg c q" \<rightleftharpoons> "[(Some c, q)]"
+  "_prgs c q ps" \<rightleftharpoons> "(Some c, q) # ps"
+  "_PAR ps" \<rightleftharpoons> "Parallel ps"
+
+  "_prg_scheme j i k c q" \<rightleftharpoons> "(map (\<lambda>i. (Some c, q)) [j..k(])"
+
+print_translation {*
+  let
+    fun quote_tr' f (t :: ts) =
+          Term.list_comb (f $ Syntax.quote_tr' "_antiquote" t, ts)
+      | quote_tr' _ _ = raise Match;
+
+    fun annquote_tr' f (r :: t :: ts) =
+          Term.list_comb (f $ r $ Syntax.quote_tr' "_antiquote" t, ts)
+      | annquote_tr' _ _ = raise Match;
+
+    val assert_tr' = quote_tr' (Syntax.const "_Assert");
+
+    fun bexp_tr' name ((Const ("Collect", _) $ t) :: ts) =
+          quote_tr' (Syntax.const name) (t :: ts)
+      | bexp_tr' _ _ = raise Match;
+
+    fun annbexp_tr' name (r :: (Const ("Collect", _) $ t) :: ts) =
+          annquote_tr' (Syntax.const name) (r :: t :: ts)
+      | annbexp_tr' _ _ = raise Match;
+
+    fun upd_tr' (x_upd, T) =
+      (case try (unsuffix RecordPackage.updateN) x_upd of
+        Some x => (x, if T = dummyT then T else Term.domain_type T)
+      | None => raise Match);
+
+    fun update_name_tr' (Free x) = Free (upd_tr' x)
+      | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
+          c $ Free (upd_tr' x)
+      | update_name_tr' (Const x) = Const (upd_tr' x)
+      | update_name_tr' _ = raise Match;
+
+    fun assign_tr' (Abs (x, _, f $ t $ Bound 0) :: ts) =
+          quote_tr' (Syntax.const "_Assign" $ update_name_tr' f)
+            (Abs (x, dummyT, t) :: ts)
+      | assign_tr' _ = raise Match;
+
+    fun annassign_tr' (r :: Abs (x, _, f $ t $ Bound 0) :: ts) =
+          quote_tr' (Syntax.const "_AnnAssign" $ r $ update_name_tr' f)
+            (Abs (x, dummyT, t) :: ts)
+      | annassign_tr' _ = raise Match;
+
+    fun Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1 ) $ t2) $ Const ("Nil",_))] = 
+                   (Syntax.const "_prg" $ t1 $ t2)
+      | Parallel_PAR [(Const ("Cons",_) $ (Const ("Pair",_) $ (Const ("Some",_) $ t1) $ t2) $ ts)] =
+                     (Syntax.const "_prgs" $ t1 $ t2 $ Parallel_PAR [ts])
+      | Parallel_PAR _ = raise Match;
+
+fun Parallel_tr' ts = Syntax.const "_PAR" $ Parallel_PAR ts;
+  in
+    [("Collect", assert_tr'), ("Basic", assign_tr'), 
+      ("Cond", bexp_tr' "_Cond"), ("While", bexp_tr' "_While_inv"),
+      ("AnnBasic", annassign_tr'), 
+      ("AnnWhile", annbexp_tr' "_AnnWhile"), ("AnnAwait", annbexp_tr' "_AnnAwait"),
+      ("AnnCond1", annbexp_tr' "_AnnCond1"), ("AnnCond2", annbexp_tr' "_AnnCond2")]
+
+  end
+
+*}
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Tactics.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Tactics.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,501 @@
+
+header {* \section{Generation of Verification Conditions} *}
+
+theory OG_Tactics = OG_Hoare:
+
+lemmas ann_hoare_intros=AnnBasic AnnSeq AnnCond1 AnnCond2 AnnWhile AnnAwait AnnConseq
+lemmas oghoare_intros=Parallel Basic Seq Cond While Conseq
+
+lemma ParallelConseqRule: 
+ "\<lbrakk> p \<subseteq> (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i))));  
+  \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts ! i)))) 
+      (Parallel Ts) 
+     (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i));  
+  (\<Inter>i\<in>{i. i<length Ts}. post(Ts ! i)) \<subseteq> q \<rbrakk>  
+  \<Longrightarrow> \<parallel>- p (Parallel Ts) q"
+apply (rule Conseq)
+prefer 2 
+ apply fast
+apply assumption+
+done
+
+lemma SkipRule: "p \<subseteq> q \<Longrightarrow> \<parallel>- p (Basic id) q"
+apply(rule oghoare_intros)
+  prefer 2 apply(rule Basic)
+ prefer 2 apply(rule subset_refl)
+apply(simp add:Id_def)
+done
+
+lemma BasicRule: "p \<subseteq> {s. (f s)\<in>q} \<Longrightarrow> \<parallel>- p (Basic f) q"
+apply(rule oghoare_intros)
+  prefer 2 apply(rule oghoare_intros)
+ prefer 2 apply(rule subset_refl)
+apply assumption
+done
+
+lemma SeqRule: "\<lbrakk> \<parallel>- p c1 r; \<parallel>- r c2 q \<rbrakk> \<Longrightarrow> \<parallel>- p (Seq c1 c2) q"
+apply(rule Seq)
+apply fast+
+done
+
+lemma CondRule: 
+ "\<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> 
+  \<Longrightarrow> \<parallel>- p (Cond b c1 c2) q"
+apply(rule Cond)
+ apply(rule Conseq)
+ prefer 4 apply(rule Conseq)
+apply simp_all
+apply force+
+done
+
+lemma WhileRule: "\<lbrakk> p \<subseteq> i; \<parallel>- (i \<inter> b) c i ; (i \<inter> (-b)) \<subseteq> q \<rbrakk>  
+        \<Longrightarrow> \<parallel>- p (While b i c) q"
+apply(rule Conseq)
+ prefer 2 apply(rule While)
+apply assumption+
+done
+
+text {* Three new proof rules for special instances of the @{text
+AnnBasic} and the @{text AnnAwait} commands when the transformation
+performed on the state is the identity, and for an @{text AnnAwait}
+command where the boolean condition is @{text "{s. True}"}: *}
+
+lemma AnnatomRule:
+  "\<lbrakk> atom_com(c); \<parallel>- r c q \<rbrakk>  \<Longrightarrow> \<turnstile> (AnnAwait r {s. True} c) q"
+apply(rule AnnAwait)
+apply simp_all
+done
+
+lemma AnnskipRule:
+  "r \<subseteq> q \<Longrightarrow> \<turnstile> (AnnBasic r id) q"
+apply(rule AnnBasic)
+apply simp
+done
+
+lemma AnnwaitRule:
+  "\<lbrakk> (r \<inter> b) \<subseteq> q \<rbrakk> \<Longrightarrow> \<turnstile> (AnnAwait r b (Basic id)) q"
+apply(rule AnnAwait)
+ apply simp
+apply(rule BasicRule)
+apply simp
+done
+
+text {* Lemmata to avoid using the definition of @{text
+map_ann_hoare}, @{text interfree_aux}, @{text interfree_swap} and
+@{text interfree} by splitting it into different cases: *}
+
+lemma interfree_aux_rule1: "interfree_aux(co, q, None)"
+by(simp add:interfree_aux_def)
+
+lemma interfree_aux_rule2: 
+  "\<forall>(R,r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<Longrightarrow> interfree_aux(None, q, Some a)"
+apply(simp add:interfree_aux_def)
+apply(force elim:oghoare_sound)
+done
+
+lemma interfree_aux_rule3: 
+  "(\<forall>(R, r)\<in>(atomics a). \<parallel>- (q \<inter> R) r q \<and> (\<forall>p\<in>(assertions c). \<parallel>- (p \<inter> R) r p))
+  \<Longrightarrow> interfree_aux(Some c, q, Some a)"
+apply(simp add:interfree_aux_def)
+apply(force elim:oghoare_sound)
+done
+
+lemma AnnBasic_assertions: 
+  "\<lbrakk>interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk> \<Longrightarrow> 
+    interfree_aux(Some (AnnBasic r f), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnSeq_assertions: 
+  "\<lbrakk> interfree_aux(Some c1, q, Some a); interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
+   interfree_aux(Some (AnnSeq c1 c2), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnCond1_assertions: 
+  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c1, q, Some a); 
+  interfree_aux(Some c2, q, Some a)\<rbrakk>\<Longrightarrow> 
+  interfree_aux(Some(AnnCond1 r b c1 c2), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnCond2_assertions: 
+  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
+  interfree_aux(Some (AnnCond2 r b c), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnWhile_assertions: 
+  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, i, Some a); 
+  interfree_aux(Some c, q, Some a)\<rbrakk>\<Longrightarrow> 
+  interfree_aux(Some (AnnWhile r b i c), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+ 
+lemma AnnAwait_assertions: 
+  "\<lbrakk> interfree_aux(None, r, Some a); interfree_aux(None, q, Some a)\<rbrakk>\<Longrightarrow> 
+  interfree_aux(Some (AnnAwait r b c), q, Some a)"
+apply(simp add: interfree_aux_def)
+by force
+ 
+lemma AnnBasic_atomics: 
+  "\<parallel>- (q \<inter> r) (Basic f) q \<Longrightarrow> interfree_aux(None, q, Some (AnnBasic r f))"
+by(simp add: interfree_aux_def oghoare_sound)
+
+lemma AnnSeq_atomics: 
+  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
+  interfree_aux(Any, q, Some (AnnSeq a1 a2))"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnCond1_atomics:
+  "\<lbrakk> interfree_aux(Any, q, Some a1); interfree_aux(Any, q, Some a2)\<rbrakk>\<Longrightarrow> 
+   interfree_aux(Any, q, Some (AnnCond1 r b a1 a2))"
+apply(simp add: interfree_aux_def)
+by force
+
+lemma AnnCond2_atomics: 
+  "interfree_aux (Any, q, Some a)\<Longrightarrow> interfree_aux(Any, q, Some (AnnCond2 r b a))"
+by(simp add: interfree_aux_def)
+
+lemma AnnWhile_atomics: "interfree_aux (Any, q, Some a) 
+     \<Longrightarrow> interfree_aux(Any, q, Some (AnnWhile r b i a))"
+by(simp add: interfree_aux_def)
+
+lemma Annatom_atomics: 
+  "\<parallel>- (q \<inter> r) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r {x. True} a))"
+by(simp add: interfree_aux_def oghoare_sound) 
+
+lemma AnnAwait_atomics: 
+  "\<parallel>- (q \<inter> (r \<inter> b)) a q \<Longrightarrow> interfree_aux (None, q, Some (AnnAwait r b a))"
+by(simp add: interfree_aux_def oghoare_sound)
+
+constdefs 
+  interfree_swap :: "('a ann_triple_op * ('a ann_triple_op) list) \<Rightarrow> bool"
+  "interfree_swap == \<lambda>(x, xs). \<forall>y\<in>set xs. interfree_aux (com x, post x, com y)
+  \<and> interfree_aux(com y, post y, com x)"
+
+lemma interfree_swap_Empty: "interfree_swap (x, [])"
+by(simp add:interfree_swap_def)
+
+lemma interfree_swap_List:  
+  "\<lbrakk> interfree_aux (com x, post x, com y); 
+  interfree_aux (com y, post y ,com x); interfree_swap (x, xs) \<rbrakk> 
+  \<Longrightarrow> interfree_swap (x, y#xs)"
+by(simp add:interfree_swap_def)
+
+lemma interfree_swap_Map: "\<forall>k. i\<le>k \<and> k<j \<longrightarrow> interfree_aux (com x, post x, c k) 
+ \<and> interfree_aux (c k, Q k, com x)   
+ \<Longrightarrow> interfree_swap (x, map (\<lambda>k. (c k, Q k)) [i..j(])"
+by(force simp add: interfree_swap_def less_diff_conv)
+
+lemma interfree_Empty: "interfree []"
+by(simp add:interfree_def)
+
+lemma interfree_List: 
+  "\<lbrakk> interfree_swap(x, xs); interfree xs \<rbrakk> \<Longrightarrow> interfree (x#xs)"
+apply(simp add:interfree_def interfree_swap_def)
+apply clarify
+apply(case_tac i)
+ apply(case_tac j)
+  apply simp_all
+apply(case_tac j,simp+)
+done
+
+lemma interfree_Map: 
+  "(\<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))  
+  \<Longrightarrow> interfree (map (\<lambda>k. (c k, Q k)) [a..b(])"
+by(force simp add: interfree_def less_diff_conv)
+
+constdefs map_ann_hoare :: "(('a ann_com_op * 'a assn) list) \<Rightarrow> bool " ("[\<turnstile>] _" [0] 45)
+  "[\<turnstile>] Ts == (\<forall>i<length Ts. \<exists>c q. Ts!i=(Some c, q) \<and> \<turnstile> c q)"
+
+lemma MapAnnEmpty: "[\<turnstile>] []"
+by(simp add:map_ann_hoare_def)
+
+lemma MapAnnList: "\<lbrakk> \<turnstile> c q ; [\<turnstile>] xs \<rbrakk> \<Longrightarrow> [\<turnstile>] (Some c,q)#xs"
+apply(simp add:map_ann_hoare_def)
+apply clarify
+apply(case_tac i,simp+)
+done
+
+lemma MapAnnMap: 
+  "\<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(]"
+apply(simp add: map_ann_hoare_def less_diff_conv)
+done
+
+lemma ParallelRule:"\<lbrakk> [\<turnstile>] Ts ; interfree Ts \<rbrakk>
+  \<Longrightarrow> \<parallel>- (\<Inter>i\<in>{i. i<length Ts}. pre(the(com(Ts!i)))) 
+          Parallel Ts 
+        (\<Inter>i\<in>{i. i<length Ts}. post(Ts!i))"
+apply(rule Parallel)
+ apply(simp add:map_ann_hoare_def)
+apply simp
+done
+(*
+lemma ParamParallelRule:
+ "\<lbrakk> \<forall>k<n. \<turnstile> (c k) (Q k); 
+   \<forall>k l. k<n \<and> l<n  \<and> k\<noteq>l \<longrightarrow> interfree_aux (Some(c k), Q k, Some(c l)) \<rbrakk>
+  \<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 )"
+apply(rule ParallelConseqRule)
+  apply simp
+  apply clarify
+  apply force
+ apply(rule ParallelRule)
+  apply(rule MapAnnMap)
+  apply simp
+ apply(rule interfree_Map)
+ apply simp
+apply simp
+apply clarify
+apply force
+done
+*)
+
+text {* The following are some useful lemmas and simplification
+tactics to control which theorems are used to simplify at each moment,
+so that the original input does not suffer any unexpected
+transformation. *}
+
+lemma Compl_Collect: "-(Collect b) = {x. \<not>(b x)}"
+by fast
+lemma list_length: "length []=0 \<and> length (x#xs) = Suc(length xs)"
+by simp
+lemma list_lemmas: "length []=0 \<and> length (x#xs) = Suc(length xs) 
+\<and> (x#xs) ! 0=x \<and> (x#xs) ! Suc n = xs ! n"
+by simp
+lemma le_Suc_eq_insert: "{i. i <Suc n} = insert n {i. i< n}"
+apply auto
+by arith
+lemmas primrecdef_list = "pre.simps" "assertions.simps" "atomics.simps" "atom_com.simps"
+lemmas my_simp_list = list_lemmas fst_conv snd_conv
+not_less0 refl le_Suc_eq_insert Suc_not_Zero Zero_not_Suc Suc_Suc_eq
+Collect_mem_eq ball_simps option.simps primrecdef_list
+lemmas ParallelConseq_list = INTER_def Collect_conj_eq length_map length_upt length_append list_length
+
+ML {*
+val before_interfree_simp_tac = (simp_tac (HOL_basic_ss addsimps [thm "com.simps", thm "post.simps"]))
+
+val  interfree_simp_tac = (asm_simp_tac (HOL_ss addsimps [thm "split", thm "ball_Un", thm "ball_empty"]@(thms "my_simp_list")))
+
+val ParallelConseq = (simp_tac (HOL_basic_ss addsimps (thms "ParallelConseq_list")@(thms "my_simp_list")))
+*}
+
+text {* The following tactic applies @{text tac} to each conjunct in a
+subgoal of the form @{text "A \<Longrightarrow> a1 \<and> a2 \<and> .. \<and> an"}  returning
+@{text n} subgoals, one for each conjunct: *}
+
+ML {*
+fun conjI_Tac tac i st = st |>
+       ( (EVERY [rtac conjI i,
+          conjI_Tac tac (i+1),
+          tac i]) ORELSE (tac i) )
+*}
+
+
+subsubsection {* Tactic for the generation of the verification conditions *} 
+
+text {* The tactic basically uses two subtactics:
+
+\begin{description}
+
+\item[HoareRuleTac] is called at the level of parallel programs, it        
+ uses the ParallelTac to solve parallel composition of programs.         
+ This verification has two parts, namely, (1) all component programs are 
+ correct and (2) they are interference free.  @{text HoareRuleTac} is
+ also called at the level of atomic regions, i.e.  @{text "\<langle> \<rangle>"} and
+ @{text "AWAIT b THEN _ END"}, and at each interference freedom test.
+
+\item[AnnHoareRuleTac] is for component programs which  
+ are annotated programs and so, there are not unknown assertions         
+ (no need to use the parameter precond, see NOTE).
+
+ NOTE: precond(::bool) informs if the subgoal has the form @{text "\<parallel>- ?p c q"},
+ in this case we have precond=False and the generated  verification     
+ condition would have the form @{text "?p \<subseteq> \<dots>"} which can be solved by        
+ @{text "rtac subset_refl"}, if True we proceed to simplify it using
+ the simplification tactics above.
+
+\end{description}
+*}
+
+ML {*
+
+ fun WlpTac i = (rtac (thm "SeqRule") i) THEN (HoareRuleTac false (i+1))
+and HoareRuleTac precond i st = st |>  
+    ( (WlpTac i THEN HoareRuleTac precond i)
+      ORELSE
+      (FIRST[rtac (thm "SkipRule") i,
+             rtac (thm "BasicRule") i,
+             EVERY[rtac (thm "ParallelConseqRule") i,
+                   ParallelConseq (i+2),
+                   ParallelTac (i+1),
+                   ParallelConseq i], 
+             EVERY[rtac (thm "CondRule") i,
+                   HoareRuleTac false (i+2),
+                   HoareRuleTac false (i+1)],
+             EVERY[rtac (thm "WhileRule") i,
+                   HoareRuleTac true (i+1)],
+             K all_tac i ]
+       THEN (if precond then (K all_tac i) else (rtac (thm "subset_refl") i))))
+
+and  AnnWlpTac i = (rtac (thm "AnnSeq") i) THEN (AnnHoareRuleTac (i+1))
+and AnnHoareRuleTac i st = st |>  
+    ( (AnnWlpTac i THEN AnnHoareRuleTac i )
+     ORELSE
+      (FIRST[(rtac (thm "AnnskipRule") i),
+             EVERY[rtac (thm "AnnatomRule") i,
+                   HoareRuleTac true (i+1)],
+             (rtac (thm "AnnwaitRule") i),
+             rtac (thm "AnnBasic") i,
+             EVERY[rtac (thm "AnnCond1") i,
+                   AnnHoareRuleTac (i+3),
+                   AnnHoareRuleTac (i+1)],
+             EVERY[rtac (thm "AnnCond2") i,
+                   AnnHoareRuleTac (i+1)],
+             EVERY[rtac (thm "AnnWhile") i,
+                   AnnHoareRuleTac (i+2)],
+             EVERY[rtac (thm "AnnAwait") i,
+                   HoareRuleTac true (i+1)],
+             K all_tac i]))
+
+and ParallelTac i = EVERY[rtac (thm "ParallelRule") i,
+                          interfree_Tac (i+1),
+                           MapAnn_Tac i]
+
+and MapAnn_Tac i st = st |>
+    (FIRST[rtac (thm "MapAnnEmpty") i,
+           EVERY[rtac (thm "MapAnnList") i,
+                 MapAnn_Tac (i+1),
+                 AnnHoareRuleTac i],
+           EVERY[rtac (thm "MapAnnMap") i,
+                 rtac (thm "allI") i,rtac (thm "impI") i,
+                 AnnHoareRuleTac i]])
+
+and interfree_swap_Tac i st = st |>
+    (FIRST[rtac (thm "interfree_swap_Empty") i,
+           EVERY[rtac (thm "interfree_swap_List") i,
+                 interfree_swap_Tac (i+2),
+                 interfree_aux_Tac (i+1),
+                 interfree_aux_Tac i ],
+           EVERY[rtac (thm "interfree_swap_Map") i,
+                 rtac (thm "allI") i,rtac (thm "impI") i,
+                 conjI_Tac (interfree_aux_Tac) i]])
+
+and interfree_Tac i st = st |> 
+   (FIRST[rtac (thm "interfree_Empty") i,
+          EVERY[rtac (thm "interfree_List") i,
+                interfree_Tac (i+1),
+                interfree_swap_Tac i],
+          EVERY[rtac (thm "interfree_Map") i,
+                rtac (thm "allI") i,rtac (thm "allI") i,rtac (thm "impI") i,
+                interfree_aux_Tac i ]])
+
+and interfree_aux_Tac i = (before_interfree_simp_tac i ) THEN 
+        (FIRST[rtac (thm "interfree_aux_rule1") i,
+               dest_assertions_Tac i])
+
+and dest_assertions_Tac i st = st |>
+    (FIRST[EVERY[rtac (thm "AnnBasic_assertions") i,
+                 dest_atomics_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnSeq_assertions") i,
+                 dest_assertions_Tac (i+1),
+                 dest_assertions_Tac i],
+           EVERY[rtac (thm "AnnCond1_assertions") i,
+                 dest_assertions_Tac (i+2),
+                 dest_assertions_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnCond2_assertions") i,
+                 dest_assertions_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnWhile_assertions") i,
+                 dest_assertions_Tac (i+2),
+                 dest_atomics_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnAwait_assertions") i,
+                 dest_atomics_Tac (i+1),
+                 dest_atomics_Tac i],
+           dest_atomics_Tac i])
+
+and dest_atomics_Tac i st = st |>
+    (FIRST[EVERY[rtac (thm "AnnBasic_atomics") i,
+                 HoareRuleTac true i],
+           EVERY[rtac (thm "AnnSeq_atomics") i,
+                 dest_atomics_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnCond1_atomics") i,
+                 dest_atomics_Tac (i+1),
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnCond2_atomics") i,
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "AnnWhile_atomics") i,
+                 dest_atomics_Tac i],
+           EVERY[rtac (thm "Annatom_atomics") i,
+                 HoareRuleTac true i],
+           EVERY[rtac (thm "AnnAwait_atomics") i,
+                 HoareRuleTac true i],
+                 K all_tac i])
+*}
+
+
+text {* The final tactic is given the name @{text oghoare}: *}
+
+ML {* 
+fun oghoare_tac i thm = SUBGOAL (fn (term, _) =>
+   (HoareRuleTac true i)) i thm
+*}
+
+text {* Notice that the tactic for parallel programs @{text
+"oghoare_tac"} is initially invoked with the value @{text true} for
+the parameter @{text precond}.
+
+Parts of the tactic can be also individually used to generate the
+verification conditions for annotated sequential programs and to
+generate verification conditions out of interference freedom tests: *}
+
+ML {* fun annhoare_tac i thm = SUBGOAL (fn (term, _) =>
+  (AnnHoareRuleTac i)) i thm
+
+fun interfree_aux_tac i thm = SUBGOAL (fn (term, _) =>
+   (interfree_aux_Tac i)) i thm
+*}
+
+text {* The so defined ML tactics are then ``exported'' to be used in
+Isabelle proofs. *}
+
+method_setup oghoare = {*
+  Method.no_args
+    (Method.SIMPLE_METHOD' HEADGOAL (oghoare_tac)) *}
+  "verification condition generator for the oghoare logic"
+
+method_setup annhoare = {*
+  Method.no_args
+    (Method.SIMPLE_METHOD' HEADGOAL (annhoare_tac)) *}
+  "verification condition generator for the ann_hoare logic"
+
+method_setup interfree_aux = {*
+  Method.no_args
+    (Method.SIMPLE_METHOD' HEADGOAL (interfree_aux_tac)) *}
+  "verification condition generator for interference freedom tests"
+
+text {* Tactics useful for dealing with the generated verification conditions: *}
+
+method_setup conjI_tac = {*
+  Method.no_args
+    (Method.SIMPLE_METHOD' HEADGOAL (conjI_Tac (K all_tac))) *}
+  "verification condition generator for interference freedom tests"
+
+ML {*
+fun disjE_Tac tac i st = st |>
+       ( (EVERY [etac disjE i,
+          disjE_Tac tac (i+1),
+          tac i]) ORELSE (tac i) )
+*}
+
+method_setup disjE_tac = {*
+  Method.no_args
+    (Method.SIMPLE_METHOD' HEADGOAL (disjE_Tac (K all_tac))) *}
+  "verification condition generator for interference freedom tests"
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/OG_Tran.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/OG_Tran.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,308 @@
+
+header {* \section{Operational Semantics} *}
+
+theory OG_Tran = OG_Com:
+
+types
+  'a ann_com_op = "('a ann_com) option"
+  'a ann_triple_op = "('a ann_com_op \<times> 'a assn)"
+  
+consts com :: "'a ann_triple_op \<Rightarrow> 'a ann_com_op"
+primrec "com (c, q) = c"
+
+consts post :: "'a ann_triple_op \<Rightarrow> 'a assn"
+primrec "post (c, q) = q"
+
+constdefs
+  All_None :: "'a ann_triple_op list \<Rightarrow> bool"
+  "All_None Ts \<equiv> \<forall>(c, q) \<in> set Ts. c = None"
+
+subsection {* The Transition Relation *}
+
+consts
+  ann_transition :: "(('a ann_com_op \<times> 'a) \<times> ('a ann_com_op \<times> 'a)) set"        
+  transition :: "(('a com \<times> 'a) \<times> ('a com \<times> 'a)) set"
+    
+syntax
+  "_ann_transition" :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
+                           ("_ -1\<rightarrow> _"[81,81] 100)
+  "_ann_transition_n" :: "('a ann_com_op \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a ann_com_op \<times> 'a) 
+                           \<Rightarrow> bool"  ("_ -_\<rightarrow> _"[81,81] 100)
+  "_ann_transition_*" :: "('a ann_com_op \<times> 'a) \<Rightarrow> ('a ann_com_op \<times> 'a) \<Rightarrow> bool"
+                           ("_ -*\<rightarrow> _"[81,81] 100)
+
+  "_transition" :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  ("_ -P1\<rightarrow> _"[81,81] 100)
+  "_transition_n" :: "('a com \<times> 'a) \<Rightarrow> nat \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  
+                          ("_ -P_\<rightarrow> _"[81,81,81] 100)  
+  "_transition_*" :: "('a com \<times> 'a) \<Rightarrow> ('a com \<times> 'a) \<Rightarrow> bool"  ("_ -P*\<rightarrow> _"[81,81] 100)
+
+text {* The corresponding syntax translations are: *}
+
+translations
+  "con_0 -1\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition"
+  "con_0 -n\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition^n"
+  "con_0 -*\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> ann_transition\<^sup>*"
+   
+  "con_0 -P1\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition"
+  "con_0 -Pn\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition^n"
+  "con_0 -P*\<rightarrow> con_1" \<rightleftharpoons> "(con_0, con_1) \<in> transition\<^sup>*"
+
+inductive ann_transition  transition
+intros
+  AnnBasic:  "(Some (AnnBasic r f), s) -1\<rightarrow> (None, f s)"
+
+  AnnSeq1: "(Some c0, s) -1\<rightarrow> (None, t) \<Longrightarrow> 
+               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some c1, t)"
+  AnnSeq2: "(Some c0, s) -1\<rightarrow> (Some c2, t) \<Longrightarrow> 
+               (Some (AnnSeq c0 c1), s) -1\<rightarrow> (Some (AnnSeq c2 c1), t)"
+
+  AnnCond1T: "s \<in> b  \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c1, s)"
+  AnnCond1F: "s \<notin> b \<Longrightarrow> (Some (AnnCond1 r b c1 c2), s) -1\<rightarrow> (Some c2, s)"
+
+  AnnCond2T: "s \<in> b  \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (Some c, s)"
+  AnnCond2F: "s \<notin> b \<Longrightarrow> (Some (AnnCond2 r b c), s) -1\<rightarrow> (None, s)"
+
+  AnnWhileF: "s \<notin> b \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> (None, s)"
+  AnnWhileT: "s \<in> b  \<Longrightarrow> (Some (AnnWhile r b i c), s) -1\<rightarrow> 
+                         (Some (AnnSeq c (AnnWhile i b i c)), s)"
+
+  AnnAwait: "\<lbrakk> s \<in> b; atom_com c; (c, s) -P*\<rightarrow> (Parallel [], t) \<rbrakk> \<Longrightarrow>
+	           (Some (AnnAwait r b c), s) -1\<rightarrow> (None, t)" 
+
+  Parallel: "\<lbrakk> i<length Ts; Ts!i = (Some c, q); (Some c, s) -1\<rightarrow> (r, t) \<rbrakk>
+              \<Longrightarrow> (Parallel Ts, s) -P1\<rightarrow> (Parallel (Ts [i:=(r, q)]), t)"
+
+  Basic:  "(Basic f, s) -P1\<rightarrow> (Parallel [], f s)"
+
+  Seq1:   "All_None Ts \<Longrightarrow> (Seq (Parallel Ts) c, s) -P1\<rightarrow> (c, s)"
+  Seq2:   "(c0, s) -P1\<rightarrow> (c2, t) \<Longrightarrow> (Seq c0 c1, s) -P1\<rightarrow> (Seq c2 c1, t)"
+
+  CondT: "s \<in> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c1, s)"
+  CondF: "s \<notin> b \<Longrightarrow> (Cond b c1 c2, s) -P1\<rightarrow> (c2, s)"
+
+  WhileF: "s \<notin> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Parallel [], s)"
+  WhileT: "s \<in> b \<Longrightarrow> (While b i c, s) -P1\<rightarrow> (Seq c (While b i c), s)"
+
+monos "rtrancl_mono"
+
+subsection {* Definition of Semantics *}
+
+constdefs
+  ann_sem :: "'a ann_com \<Rightarrow> 'a \<Rightarrow> 'a set"
+  "ann_sem c \<equiv> \<lambda>s. {t. (Some c, s) -*\<rightarrow> (None, t)}"
+
+  ann_SEM :: "'a ann_com \<Rightarrow> 'a set \<Rightarrow> 'a set"
+  "ann_SEM c S \<equiv> \<Union>ann_sem c ` S"  
+
+  sem :: "'a com \<Rightarrow> 'a \<Rightarrow> 'a set"
+  "sem c \<equiv> \<lambda>s. {t. \<exists>Ts. (c, s) -P*\<rightarrow> (Parallel Ts, t) \<and> All_None Ts}"
+
+  SEM :: "'a com \<Rightarrow> 'a set \<Rightarrow> 'a set"
+  "SEM c S \<equiv> \<Union>sem c ` S "
+
+syntax "_Omega" :: "'a com"    ("\<Omega>" 63)
+translations  "\<Omega>" \<rightleftharpoons> "While UNIV UNIV (Basic id)"
+
+consts fwhile :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> nat \<Rightarrow> 'a com"
+primrec 
+   "fwhile b c 0 = \<Omega>"
+   "fwhile b c (Suc n) = Cond b (Seq c (fwhile b c n)) (Basic id)"
+
+subsubsection {* Proofs *}
+
+declare ann_transition_transition.intros [intro]
+inductive_cases transition_cases: 
+    "(Parallel T,s) -P1\<rightarrow> t"  
+    "(Basic f, s) -P1\<rightarrow> t"
+    "(Seq c1 c2, s) -P1\<rightarrow> t" 
+    "(Cond b c1 c2, s) -P1\<rightarrow> t"
+    "(While b i c, s) -P1\<rightarrow> t"
+
+lemma Parallel_empty_lemma [rule_format (no_asm)]: 
+  "(Parallel [],s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=[] \<and> n=0 \<and> s=t"
+apply(induct n)
+ apply(simp (no_asm))
+apply clarify
+apply(drule rel_pow_Suc_D2)
+apply(force elim:transition_cases)
+done
+
+lemma Parallel_AllNone_lemma [rule_format (no_asm)]: 
+ "All_None Ss \<longrightarrow> (Parallel Ss,s) -Pn\<rightarrow> (Parallel Ts,t) \<longrightarrow> Ts=Ss \<and> n=0 \<and> s=t"
+apply(induct "n")
+ apply(simp (no_asm))
+apply clarify
+apply(drule rel_pow_Suc_D2)
+apply clarify
+apply(erule transition_cases,simp_all)
+apply(force dest:nth_mem simp add:All_None_def)
+done
+
+lemma Parallel_AllNone: "All_None Ts \<Longrightarrow> (SEM (Parallel Ts) X) = X"
+apply (unfold SEM_def sem_def)
+apply auto
+apply(drule rtrancl_imp_UN_rel_pow)
+apply clarify
+apply(drule Parallel_AllNone_lemma)
+apply auto
+done
+
+lemma Parallel_empty: "Ts=[] \<Longrightarrow> (SEM (Parallel Ts) X) = X"
+apply(rule Parallel_AllNone)
+apply(simp add:All_None_def)
+done
+
+text {* Set of lemmas from Apt and Olderog "Verification of sequential
+and concurrent programs", page 63. *}
+
+lemma L3_5i: "X\<subseteq>Y \<Longrightarrow> SEM c X \<subseteq> SEM c Y" 
+apply (unfold SEM_def)
+apply force
+done
+
+lemma L3_5ii_lemma1: 
+ "\<lbrakk> (c1, s1) -P*\<rightarrow> (Parallel Ts, s2); All_None Ts;  
+  (c2, s2) -P*\<rightarrow> (Parallel Ss, s3); All_None Ss \<rbrakk> 
+ \<Longrightarrow> (Seq c1 c2, s1) -P*\<rightarrow> (Parallel Ss, s3)"
+apply(erule converse_rtrancl_induct2)
+apply(force intro:converse_rtrancl_into_rtrancl)+
+done
+
+lemma L3_5ii_lemma2 [rule_format (no_asm)]: 
+ "\<forall>c1 c2 s t. (Seq c1 c2, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow>  
+  (All_None Ts) \<longrightarrow> (\<exists>y m Rs. (c1,s) -P*\<rightarrow> (Parallel Rs, y) \<and> 
+  (All_None Rs) \<and> (c2, y) -Pm\<rightarrow> (Parallel Ts, t) \<and>  m \<le> n)"
+apply(induct "n")
+ apply(force)
+apply(safe dest!: rel_pow_Suc_D2)
+apply(erule transition_cases,simp_all)
+ apply (fast intro!: le_SucI)
+apply (fast intro!: le_SucI elim!: rel_pow_imp_rtrancl converse_rtrancl_into_rtrancl)
+done
+
+lemma L3_5ii_lemma3: 
+ "\<lbrakk>(Seq c1 c2,s) -P*\<rightarrow> (Parallel Ts,t); All_None Ts\<rbrakk> \<Longrightarrow> 
+    (\<exists>y Rs. (c1,s) -P*\<rightarrow> (Parallel Rs,y) \<and> All_None Rs 
+   \<and> (c2,y) -P*\<rightarrow> (Parallel Ts,t))"
+apply(drule rtrancl_imp_UN_rel_pow)
+apply(fast dest: L3_5ii_lemma2 rel_pow_imp_rtrancl)
+done
+
+lemma L3_5ii: "SEM (Seq c1 c2) X = SEM c2 (SEM c1 X)"
+apply (unfold SEM_def sem_def)
+apply auto
+ apply(fast dest: L3_5ii_lemma3)
+apply(fast elim: L3_5ii_lemma1)
+done
+
+lemma L3_5iii: "SEM (Seq (Seq c1 c2) c3) X = SEM (Seq c1 (Seq c2 c3)) X"
+apply (simp (no_asm) add: L3_5ii)
+done
+
+lemma L3_5iv:
+ "SEM (Cond b c1 c2) X = (SEM c1 (X \<inter> b)) Un (SEM c2 (X \<inter> (-b)))"
+apply (unfold SEM_def sem_def)
+apply auto
+apply(erule converse_rtranclE)
+ prefer 2
+ apply (erule transition_cases,simp_all)
+  apply(fast intro: converse_rtrancl_into_rtrancl elim: transition_cases)+
+done
+
+
+lemma  L3_5v_lemma1[rule_format]: 
+ "(S,s) -Pn\<rightarrow> (T,t) \<longrightarrow> S=\<Omega> \<longrightarrow> (\<not>(\<exists>Rs. T=(Parallel Rs) \<and> All_None Rs))"
+apply (unfold UNIV_def)
+apply(rule nat_less_induct)
+apply safe
+apply(erule rel_pow_E2)
+ apply simp_all
+apply(erule transition_cases)
+ apply simp_all
+apply(erule rel_pow_E2)
+ apply(simp add: Id_def)
+apply(erule transition_cases,simp_all)
+apply clarify
+apply(erule transition_cases,simp_all)
+apply(erule rel_pow_E2,simp)
+apply clarify
+apply(erule transition_cases)
+ apply simp+
+    apply clarify
+    apply(erule transition_cases)
+apply simp_all
+done
+
+lemma L3_5v_lemma2: "\<lbrakk>(\<Omega>, s) -P*\<rightarrow> (Parallel Ts, t); All_None Ts \<rbrakk> \<Longrightarrow> False"
+apply(fast dest: rtrancl_imp_UN_rel_pow L3_5v_lemma1)
+done
+
+lemma L3_5v_lemma3: "SEM (\<Omega>) S = {}"
+apply (unfold SEM_def sem_def)
+apply(fast dest: L3_5v_lemma2)
+done
+
+lemma L3_5v_lemma4 [rule_format]: 
+ "\<forall>s. (While b i c, s) -Pn\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
+  (\<exists>k. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t))"
+apply(rule nat_less_induct)
+apply safe
+apply(erule rel_pow_E2)
+ apply safe
+apply(erule transition_cases,simp_all)
+ apply (rule_tac x = "1" in exI)
+ apply(force dest: Parallel_empty_lemma intro: converse_rtrancl_into_rtrancl simp add: Id_def)
+apply safe
+apply(drule L3_5ii_lemma2)
+ apply safe
+apply(drule le_imp_less_Suc)
+apply (erule allE , erule impE,assumption)
+apply (erule allE , erule impE, assumption)
+apply safe
+apply (rule_tac x = "k+1" in exI)
+apply(simp (no_asm))
+apply(rule converse_rtrancl_into_rtrancl)
+ apply fast
+apply(fast elim: L3_5ii_lemma1)
+done
+
+lemma L3_5v_lemma5 [rule_format]: 
+ "\<forall>s. (fwhile b c k, s) -P*\<rightarrow> (Parallel Ts, t) \<longrightarrow> All_None Ts \<longrightarrow>  
+  (While b i c, s) -P*\<rightarrow> (Parallel Ts,t)"
+apply(induct "k")
+ apply(force dest: L3_5v_lemma2)
+apply safe
+apply(erule converse_rtranclE)
+ apply simp_all
+apply(erule transition_cases,simp_all)
+ apply(rule converse_rtrancl_into_rtrancl)
+  apply(fast)
+ apply(fast elim!: L3_5ii_lemma1 dest: L3_5ii_lemma3)
+apply(drule rtrancl_imp_UN_rel_pow)
+apply clarify
+apply(erule rel_pow_E2)
+ apply simp_all
+apply(erule transition_cases,simp_all)
+apply(fast dest: Parallel_empty_lemma)
+done
+
+lemma L3_5v: "SEM (While b i c) = (\<lambda>x. (\<Union>k. SEM (fwhile b c k) x))"
+apply(rule ext)
+apply (simp add: SEM_def sem_def)
+apply safe
+ apply(drule rtrancl_imp_UN_rel_pow,simp)
+ apply clarify
+ apply(fast dest:L3_5v_lemma4)
+apply(fast intro: L3_5v_lemma5)
+done
+
+section {* Validity of Correctness Formulas *}
+
+constdefs 
+  com_validity :: "'a assn \<Rightarrow> 'a com \<Rightarrow> 'a assn \<Rightarrow> bool"  ("(3\<parallel>= _// _//_)" [90,55,90] 50)
+  "\<parallel>= p c q \<equiv> SEM c p \<subseteq> q"
+
+  ann_com_validity :: "'a ann_com \<Rightarrow> 'a assn \<Rightarrow> bool"   ("\<Turnstile> _ _" [60,90] 45)
+  "\<Turnstile> c q \<equiv> ann_SEM c (pre c) \<subseteq> q"
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/Quote_Antiquote.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/Quote_Antiquote.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,24 @@
+
+header {* \section{Concrete Syntax} *}
+
+theory Quote_Antiquote = Main:
+
+syntax
+  "_quote"     :: "'b \<Rightarrow> ('a \<Rightarrow> 'b)"                ("(\<guillemotleft>_\<guillemotright>)" [0] 1000)
+  "_antiquote" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'b"                ("\<acute>_" [1000] 1000)
+  "_Assert"    :: "'a \<Rightarrow> 'a set"                    ("(.{_}.)" [0] 1000)
+
+syntax (xsymbols)
+  "_Assert"    :: "'a \<Rightarrow> 'a set"            ("(\<lbrace>_\<rbrace>)" [0] 1000)
+
+translations
+  ".{b}." \<rightharpoonup> "Collect \<guillemotleft>b\<guillemotright>"
+
+parse_translation {*
+  let
+    fun quote_tr [t] = Syntax.quote_tr "_antiquote" t
+      | quote_tr ts = raise TERM ("quote_tr", ts);
+  in [("_quote", quote_tr)] end
+*}
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/RG_Com.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/RG_Com.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,25 @@
+
+header {* \chapter{The Rely-Guarantee Method} 
+
+\section {Abstract Syntax}
+*}
+
+theory RG_Com = Main:
+
+text {* Semantics of assertions and boolean expressions (bexp) as sets
+of states.  Syntax of commands @{text com} and parallel commands
+@{text par_com}. *}
+
+types
+  'a bexp = "'a set"
+
+datatype 'a com = 
+    Basic "'a \<Rightarrow>'a"
+  | Seq "'a com" "'a com"
+  | Cond "'a bexp" "'a com" "'a com"         
+  | While "'a bexp" "'a com"       
+  | Await "'a bexp" "'a com"                 
+
+types 'a par_com = "(('a com) option) list"
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/RG_Examples.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/RG_Examples.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,408 @@
+
+header {* \section{Examples} *}
+
+theory RG_Examples = RG_Syntax:
+
+lemmas definitions [simp]= stable_def Pre_def Rely_def Guar_def Post_def Com_def 
+
+subsection {* Set Elements of an Array to Zero *}
+
+lemma le_less_trans2: "\<lbrakk>(j::nat)<k; i\<le> j\<rbrakk> \<Longrightarrow> i<k"
+by simp
+
+lemma add_le_less_mono: "\<lbrakk> (a::nat) < c; b\<le>d \<rbrakk> \<Longrightarrow> a + b < c + d"
+by simp
+
+record Example1 =
+  A :: "nat list"
+
+lemma Example1: 
+ "\<turnstile> COBEGIN
+      SCHEME [0 \<le> i < n]
+     (\<acute>A := \<acute>A [i := 0], 
+     \<lbrace> n < length \<acute>A \<rbrace>, 
+     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> \<ordmasculine>A ! i = \<ordfeminine>A ! i \<rbrace>, 
+     \<lbrace> length \<ordmasculine>A = length \<ordfeminine>A \<and> (\<forall>j<n. i \<noteq> j \<longrightarrow> \<ordmasculine>A ! j = \<ordfeminine>A ! j) \<rbrace>, 
+     \<lbrace> \<acute>A ! i = 0 \<rbrace>) 
+    COEND
+ 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>]"
+apply(rule Parallel)
+    apply simp
+    apply clarify
+    apply simp
+    apply(erule disjE)
+     apply simp
+    apply clarify
+    apply simp
+   apply auto
+apply(rule Basic)
+apply auto
+done
+
+lemma Example1_parameterized: 
+"k < t \<Longrightarrow>
+  \<turnstile> COBEGIN 
+    SCHEME [k*n\<le>i<(Suc k)*n] (\<acute>A:=\<acute>A[i:=0], 
+   \<lbrace>t*n < length \<acute>A\<rbrace>, 
+   \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> \<ordmasculine>A!i = \<ordfeminine>A!i\<rbrace>, 
+   \<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>, 
+   \<lbrace>\<acute>A!i=0\<rbrace>) 
+   COEND  
+ SAT [\<lbrace>t*n < length \<acute>A\<rbrace>, 
+      \<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>, 
+      \<lbrace>t*n < length \<ordmasculine>A \<and> length \<ordmasculine>A=length \<ordfeminine>A \<and> 
+      (\<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>, 
+      \<lbrace>\<forall>i<n. \<acute>A!(k*n+i) = 0\<rbrace>]"
+apply(rule Parallel)
+    apply simp
+    apply clarify
+    apply simp
+    apply(erule disjE)
+     apply clarify
+     apply simp
+    apply clarify
+    apply simp
+    apply clarify
+    apply simp
+    apply(erule_tac x="k*n +i" in allE)
+    apply(subgoal_tac "k*n+i <length (A b)")
+     apply force
+    apply(erule le_less_trans2) 
+    apply(case_tac t,simp+)
+    apply (simp add:add_commute)
+    apply(rule add_le_mono)
+     apply simp
+    apply simp
+   apply simp
+   apply clarify
+   apply(rotate_tac -1)
+   apply force
+  apply force
+ apply force
+apply simp
+apply clarify
+apply(rule Basic)
+   apply simp
+   apply clarify
+   apply (subgoal_tac "k*n+i< length (A x)")
+    apply simp
+   apply(erule le_less_trans2)
+   apply(case_tac t,simp+)
+   apply (simp add:add_commute)
+   apply(rule add_le_mono)
+    apply simp
+   apply simp
+  apply force+
+done
+
+subsection {* Increment a Variable in Parallel *}
+
+subsubsection {* Two components *}
+
+record Example2 =
+  x  :: nat
+  c_0 :: nat
+  c_1 :: nat
+
+lemma Example2: 
+ "\<turnstile>  COBEGIN
+    (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_0:=\<acute>c_0 + 1 \<rangle>, 
+     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1  \<and> \<acute>c_0=0\<rbrace>, 
+     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
+        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
+        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
+     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
+         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
+         \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
+     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_0=1 \<rbrace>)
+  \<parallel>
+      (\<langle> \<acute>x:=\<acute>x+1;; \<acute>c_1:=\<acute>c_1+1 \<rangle>, 
+     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=0 \<rbrace>, 
+     \<lbrace>\<ordmasculine>c_1 = \<ordfeminine>c_1 \<and> 
+        (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
+        \<longrightarrow> \<ordfeminine>x = \<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,  
+     \<lbrace>\<ordmasculine>c_0 = \<ordfeminine>c_0 \<and> 
+         (\<ordmasculine>x=\<ordmasculine>c_0 + \<ordmasculine>c_1 
+        \<longrightarrow> \<ordfeminine>x =\<ordfeminine>c_0 + \<ordfeminine>c_1)\<rbrace>,
+     \<lbrace>\<acute>x=\<acute>c_0 + \<acute>c_1 \<and> \<acute>c_1=1\<rbrace>)
+ COEND
+ SAT [\<lbrace>\<acute>x=0 \<and> \<acute>c_0=0 \<and> \<acute>c_1=0\<rbrace>, 
+      \<lbrace>\<ordmasculine>x=\<ordfeminine>x \<and>  \<ordmasculine>c_0= \<ordfeminine>c_0 \<and> \<ordmasculine>c_1=\<ordfeminine>c_1\<rbrace>,
+      \<lbrace>True\<rbrace>,
+      \<lbrace>\<acute>x=2\<rbrace>]"
+apply(rule Parallel)
+   apply simp_all
+   apply clarify
+   apply(case_tac i)
+    apply simp
+    apply(erule disjE)
+     apply clarify
+     apply simp
+    apply clarify
+    apply simp
+    apply(case_tac j,simp)
+    apply simp
+   apply simp
+   apply(erule disjE)
+    apply clarify
+    apply simp
+   apply clarify
+   apply simp
+   apply(case_tac j,simp,simp)
+  apply clarify
+  apply(case_tac i,simp,simp)
+ apply clarify   
+ apply simp
+ apply(erule_tac x=0 in all_dupE)
+ apply(erule_tac x=1 in allE,simp)
+apply clarify
+apply(case_tac i,simp)
+ apply(rule Await)
+  apply simp_all
+ apply(clarify)
+ apply(rule Seq)
+  prefer 2
+  apply(rule Basic)
+   apply simp_all
+  apply(rule subset_refl)
+ apply(rule Basic)
+ apply simp_all
+ apply clarify
+ apply simp
+apply(rule Await)
+ apply simp_all
+apply(clarify)
+apply(rule Seq)
+ prefer 2
+ apply(rule Basic)
+  apply simp_all
+ apply(rule subset_refl)
+apply(rule Basic)
+apply simp_all
+apply clarify
+apply simp
+done
+
+subsubsection {* Parameterized *}
+
+lemma Example2_lemma1: "j<n \<Longrightarrow> (\<Sum>i<n. b i) = (0::nat) \<Longrightarrow> b j = 0 "
+apply(induct n)
+ apply simp_all
+apply(force simp add: less_Suc_eq)
+done
+
+lemma Example2_lemma2_aux: 
+ "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))"
+apply(induct n)
+ apply simp_all
+apply(simp add:less_Suc_eq)
+ apply(auto)
+apply(subgoal_tac "n - j = Suc(n- Suc j)")
+  apply simp
+apply arith
+done 
+
+lemma Example2_lemma2_aux2: "j\<le> s \<Longrightarrow> (\<Sum>i<j. (b (s:=t)) i) = (\<Sum>i<j. b i)"
+apply(induct j)
+ apply simp_all
+done
+
+lemma Example2_lemma2: "\<lbrakk>j<n; b j=0\<rbrakk> \<Longrightarrow> Suc (\<Sum>i< n. b i)=(\<Sum>i< n. (b (j:=1)) i)"
+apply(frule_tac b="(b (j:=1))" in Example2_lemma2_aux)
+apply(erule_tac  t="Summation (b(j := 1)) n" in ssubst)
+apply(frule_tac b=b in Example2_lemma2_aux)
+apply(erule_tac  t="Summation b n" in ssubst)
+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)))")
+ apply(rotate_tac -1)
+ apply(erule ssubst)
+ apply(subgoal_tac "j\<le>j")
+  apply(drule_tac b="b" and t=1 in Example2_lemma2_aux2)
+  apply(rotate_tac -1)
+  apply(erule ssubst)
+apply simp_all
+done
+
+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)"
+by(simp add:Example2_lemma2)
+
+lemma Example2_lemma3: "\<forall>i< n. b i = 1 \<Longrightarrow> (\<Sum>i<n. b i)= n"
+apply (induct n)
+apply auto
+done
+
+record Example2_parameterized =   
+  C :: "nat \<Rightarrow> nat"
+  y  :: nat
+
+lemma Example2_parameterized: "0<n \<Longrightarrow> 
+  \<turnstile> COBEGIN SCHEME  [0\<le>i<n]
+     (\<langle> \<acute>y:=\<acute>y+1;; \<acute>C:=\<acute>C (i:=1) \<rangle>, 
+     \<lbrace>\<acute>y=(\<Sum>i<n. \<acute>C i) \<and> \<acute>C i=0\<rbrace>, 
+     \<lbrace>\<ordmasculine>C i = \<ordfeminine>C i \<and> 
+      (\<ordmasculine>y=(\<Sum>i<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i<n. \<ordfeminine>C i))\<rbrace>,  
+     \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>C j = \<ordfeminine>C j) \<and> 
+       (\<ordmasculine>y=(\<Sum>i<n. \<ordmasculine>C i) \<longrightarrow> \<ordfeminine>y =(\<Sum>i<n. \<ordfeminine>C i))\<rbrace>,
+     \<lbrace>\<acute>y=(\<Sum>i<n. \<acute>C i) \<and> \<acute>C i=1\<rbrace>) 
+    COEND
+ 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>]"
+apply(rule Parallel)
+apply force
+apply force
+apply(force elim:Example2_lemma1)
+apply clarify
+apply simp
+apply(force intro:Example2_lemma3)
+apply clarify
+apply simp
+apply(rule Await)
+apply simp_all
+apply clarify
+apply(rule Seq)
+prefer 2
+apply(rule Basic)
+apply(rule subset_refl)
+apply simp+
+apply(rule Basic)
+apply simp
+apply clarify
+apply simp
+apply(force elim:Example2_lemma2_Suc0)
+apply simp+
+done
+
+subsection {* Find Least Element *}
+
+text {* A previous lemma: *}
+
+lemma mod_aux :"\<lbrakk>i < (n::nat); a mod n = i;  j < a + n; j mod n = i; a < j\<rbrakk> \<Longrightarrow> False"
+apply(subgoal_tac "a=a div n*n + a mod n" )
+ prefer 2 apply (simp (no_asm_use) only: mod_div_equality [symmetric])
+apply(subgoal_tac "j=j div n*n + j mod n")
+ prefer 2 apply (simp (no_asm_use) only: mod_div_equality [symmetric])
+apply simp
+apply(subgoal_tac "a div n*n < j div n*n")
+prefer 2 apply arith
+apply(subgoal_tac "j div n*n < (a div n + 1)*n")
+prefer 2 apply simp 
+apply (simp only:mult_less_cancel2)
+apply arith
+done
+
+record Example3 =
+  X :: "nat \<Rightarrow> nat"
+  Y :: "nat \<Rightarrow> nat"
+
+lemma Example3: "m mod n=0 \<Longrightarrow> 
+ \<turnstile> COBEGIN 
+ SCHEME [0\<le>i<n]
+ (WHILE (\<forall>j<n. \<acute>X i < \<acute>Y j)  DO 
+   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 
+  OD,
+ \<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>,
+ \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y j \<le> \<ordmasculine>Y j) \<and> \<ordmasculine>X i = \<ordfeminine>X i \<and> 
+   \<ordmasculine>Y i = \<ordfeminine>Y i\<rbrace>,
+ \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X j = \<ordfeminine>X j \<and> \<ordmasculine>Y j = \<ordfeminine>Y j) \<and>   
+   \<ordfeminine>Y i \<le> \<ordmasculine>Y i\<rbrace>,
+ \<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
+ 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>,
+  \<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> 
+    (\<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>]"
+apply(rule Parallel)
+(*5*)
+apply force+
+apply clarify
+apply simp
+apply(rule While)
+    apply force
+   apply force
+  apply force
+ 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)
+     apply force
+    apply(rule subset_refl)+
+ apply(rule Cond)
+    apply force
+   apply(rule Basic)
+      apply force
+     apply force
+    apply force
+   apply force
+  apply(rule Basic)
+     apply simp
+     apply clarify
+     apply simp
+     apply(case_tac "X x (j mod n)\<le> j")
+      apply(drule le_imp_less_or_eq)
+      apply(erule disjE)
+       apply(drule_tac j=j and n=n and i="j mod n" and a="X x (j mod n)" in mod_aux)
+        apply assumption+
+       apply simp+
+     apply(erule_tac x=j in allE)
+     apply force
+    apply simp
+    apply clarify
+    apply(rule conjI)
+     apply clarify  
+     apply simp
+     apply(erule not_sym)
+    apply force
+apply force+
+done
+
+text {* Same but with a list as auxiliary variable: *}
+
+record Example3_list =
+  X :: "nat list"
+  Y :: "nat list"
+
+lemma Example3_list: "m mod n=0 \<Longrightarrow> \<turnstile> (COBEGIN SCHEME [0\<le>i<n]
+ (WHILE (\<forall>j<n. \<acute>X!i < \<acute>Y!j)  DO 
+     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 
+  OD,
+ \<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>,
+ \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordfeminine>Y!j \<le> \<ordmasculine>Y!j) \<and> \<ordmasculine>X!i = \<ordfeminine>X!i \<and> 
+   \<ordmasculine>Y!i = \<ordfeminine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
+ \<lbrace>(\<forall>j<n. i\<noteq>j \<longrightarrow> \<ordmasculine>X!j = \<ordfeminine>X!j \<and> \<ordmasculine>Y!j = \<ordfeminine>Y!j) \<and>   
+   \<ordfeminine>Y!i \<le> \<ordmasculine>Y!i \<and> length \<ordmasculine>X = length \<ordfeminine>X \<and> length \<ordmasculine>Y = length \<ordfeminine>Y\<rbrace>,
+ \<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)
+ 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>,
+      \<lbrace>\<ordmasculine>X=\<ordfeminine>X \<and> \<ordmasculine>Y=\<ordfeminine>Y\<rbrace>,
+      \<lbrace>True\<rbrace>,
+      \<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> 
+        (\<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>]"
+apply(rule Parallel)
+(*5*)
+apply force+
+apply clarify
+apply simp
+apply(rule While)
+    apply force
+   apply force
+  apply force
+ 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)
+     apply force
+    apply(rule subset_refl)+
+ apply(rule Cond)
+    apply force
+   apply(rule Basic)
+      apply force
+     apply force
+    apply force
+   apply force
+  apply(rule Basic)
+     apply simp
+     apply clarify
+     apply simp
+     apply(rule allI)
+     apply(rule impI)+
+     apply(case_tac "X x ! i\<le> j")
+      apply(drule le_imp_less_or_eq)
+      apply(erule disjE)
+       apply(drule_tac j=j and n=n and i=i and a="X x ! i" in mod_aux)
+        apply assumption+
+       apply simp
+apply force+
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/RG_Hoare.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/RG_Hoare.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,1495 @@
+
+header {* \section{The Proof System} *}
+
+theory RG_Hoare = RG_Tran:
+
+subsection {* Proof System for Component Programs *}
+
+constdefs
+  stable :: "'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> bool"  
+  "stable \<equiv> \<lambda>f g. (\<forall>x y. x \<in> f \<longrightarrow> (x, y) \<in> g \<longrightarrow> y \<in> f)" 
+
+consts rghoare :: "('a rgformula) set" 
+syntax 
+  "_rghoare" :: "['a com, 'a set, ('a \<times> 'a) set, ('a \<times> 'a) set, 'a set] \<Rightarrow> bool"  
+                ("\<turnstile> _ sat [_, _, _, _]" [60,0,0,0,0] 45)
+translations 
+  "\<turnstile> P sat [pre, rely, guar, post]" \<rightleftharpoons> "(P, pre, rely, guar, post) \<in> rghoare"
+
+inductive rghoare
+intros
+  Basic: "\<lbrakk> pre \<subseteq> {s. f s \<in> post}; {(s,t). s \<in> pre \<and> t=f s} \<subseteq> guar; 
+            stable pre rely; stable post rely \<rbrakk> 
+           \<Longrightarrow> \<turnstile> Basic f sat [pre, rely, guar, post]"
+
+  Seq: "\<lbrakk> \<turnstile> P sat [pre, rely, guar, mid]; \<turnstile> Q sat [mid, rely, guar, post] \<rbrakk> 
+           \<Longrightarrow> \<turnstile> Seq P Q sat [pre, rely, guar, post]"
+
+  Cond: "\<lbrakk> stable pre rely; \<turnstile> P1 sat [pre \<inter> b, rely, guar, post];
+           \<turnstile> P2 sat [pre \<inter> -b, rely, guar, post]; \<forall>s. (s,s)\<in>guar \<rbrakk>
+          \<Longrightarrow> \<turnstile> Cond b P1 P2 sat [pre, rely, guar, post]"
+
+  While: "\<lbrakk> stable pre rely; (pre \<inter> -b) \<subseteq> post; stable post rely;
+            \<turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s,s)\<in>guar \<rbrakk>
+          \<Longrightarrow> \<turnstile> While b P sat [pre, rely, guar, post]"
+
+  Await: "\<lbrakk> stable pre rely; stable post rely; 
+            \<forall>V. \<turnstile> P sat [pre \<inter> b \<inter> {V}, {(s, t). s = t}, UNIV, {s. (V, s) \<in> guar} \<inter> post] \<rbrakk>
+           \<Longrightarrow> \<turnstile> Await b P sat [pre, rely, guar, post]"
+  
+  Conseq: "\<lbrakk> pre \<subseteq> pre'; rely \<subseteq> rely'; guar' \<subseteq> guar; post' \<subseteq> post;
+             \<turnstile> P sat [pre', rely', guar', post'] \<rbrakk>
+            \<Longrightarrow> \<turnstile> P sat [pre, rely, guar, post]"
+
+constdefs 
+  Pre :: "'a rgformula \<Rightarrow> 'a set"
+  "Pre x \<equiv> fst(snd x)"
+  Post :: "'a rgformula \<Rightarrow> 'a set"
+  "Post x \<equiv> snd(snd(snd(snd x)))"
+  Rely :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
+  "Rely x \<equiv> fst(snd(snd x))"
+  Guar :: "'a rgformula \<Rightarrow> ('a \<times> 'a) set"
+  "Guar x \<equiv> fst(snd(snd(snd x)))"
+  Com :: "'a rgformula \<Rightarrow> 'a com"
+  "Com x \<equiv> fst x"
+
+subsection {* Proof System for Parallel Programs *}
+
+types 'a par_rgformula = "('a rgformula) list \<times> 'a set \<times> ('a \<times> 'a) set \<times> ('a \<times> 'a) set \<times> 'a set"
+
+consts par_rghoare :: "('a par_rgformula) set" 
+syntax 
+  "_par_rghoare" :: "('a rgformula) list \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set
+                  \<Rightarrow> bool"    ("\<turnstile> _ SAT [_, _, _, _]" [60,0,0,0,0] 45)
+translations 
+  "\<turnstile> Ps SAT [pre, rely, guar, post]" \<rightleftharpoons> "(Ps, pre, rely, guar, post) \<in> par_rghoare"
+
+inductive par_rghoare
+intros
+  Parallel: 
+  "\<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);
+    (\<Union>j\<in>{j. j<length xs}. Guar(xs!j)) \<subseteq> guar;
+     pre \<subseteq> (\<Inter>i\<in>{i. i<length xs}. Pre(xs!i)); 
+    (\<Inter>i\<in>{i. i<length xs}. Post(xs!i)) \<subseteq> post;
+    \<forall>i<length xs. \<turnstile> Com(xs!i) sat [Pre(xs!i),Rely(xs!i),Guar(xs!i),Post(xs!i)] \<rbrakk>
+   \<Longrightarrow>  \<turnstile> xs SAT [pre, rely, guar, post]"
+
+section {* Soundness*}
+
+subsubsection {* Some previous lemmas *}
+
+lemma tl_of_assum_in_assum: 
+  "(P, s) # (P, t) # xs \<in> assum (pre, rely) \<Longrightarrow> stable pre rely 
+  \<Longrightarrow> (P, t) # xs \<in> assum (pre, rely)"
+apply(simp add:assum_def)
+apply clarify
+apply(rule conjI)
+ apply(erule_tac x=0 in allE)
+ apply(simp (no_asm_use)only:stable_def)
+ apply(erule allE,erule allE,erule impE,assumption,erule mp)
+ apply(simp add:Env)
+apply clarify
+apply(erule_tac x="Suc i" in allE)
+apply simp
+done
+
+lemma etran_in_comm: 
+  "(P, t) # xs \<in> comm(guar, post) \<Longrightarrow> (P, s) # (P, t) # xs \<in> comm(guar, post)"
+apply(simp add:comm_def)
+apply clarify
+apply(case_tac i,simp+)
+done
+
+lemma ctran_in_comm: 
+  "\<lbrakk>(s, s) \<in> guar; (Q, s) # xs \<in> comm(guar, post)\<rbrakk> 
+  \<Longrightarrow> (P, s) # (Q, s) # xs \<in> comm(guar, post)"
+apply(simp add:comm_def)
+apply clarify
+apply(case_tac i,simp+)
+done
+
+lemma takecptn_is_cptn [rule_format, elim!]: 
+  "\<forall>j. c \<in> cptn \<longrightarrow> take (Suc j) c \<in> cptn"
+apply(induct "c")
+ apply(force elim: cptn.elims)
+apply clarify
+apply(case_tac j) 
+ apply simp
+ apply(rule CptnOne)
+apply simp
+apply(force intro:cptn.intros elim:cptn.elims)
+done
+
+lemma dropcptn_is_cptn [rule_format,elim!]: 
+  "\<forall>j<length c. c \<in> cptn \<longrightarrow> drop j c \<in> cptn"
+apply(induct "c")
+ apply(force elim: cptn.elims)
+apply clarify
+apply(case_tac j,simp+) 
+apply(erule cptn.elims)
+  apply simp
+ apply force
+apply force
+done
+
+lemma takepar_cptn_is_par_cptn [rule_format,elim]: 
+  "\<forall>j. c \<in> par_cptn \<longrightarrow> take (Suc j) c \<in> par_cptn"
+apply(induct "c")
+ apply(force elim: cptn.elims)
+apply clarify
+apply(case_tac j,simp) 
+ apply(rule ParCptnOne)
+apply(force intro:par_cptn.intros elim:par_cptn.elims)
+done
+
+lemma droppar_cptn_is_par_cptn [rule_format]:
+  "\<forall>j<length c. c \<in> par_cptn \<longrightarrow> drop j c \<in> par_cptn"
+apply(induct "c")
+ apply(force elim: par_cptn.elims)
+apply clarify
+apply(case_tac j,simp+) 
+apply(erule par_cptn.elims)
+  apply simp
+ apply force
+apply force
+done
+
+lemma tl_of_cptn_is_cptn: "\<lbrakk>x # xs \<in> cptn; xs \<noteq> []\<rbrakk> \<Longrightarrow> xs  \<in> cptn"
+apply(subgoal_tac "1 < length (x # xs)") 
+ apply(drule dropcptn_is_cptn,simp+)
+done
+
+lemma not_ctran_None [rule_format]: 
+  "\<forall>s. (None, s)#xs \<in> cptn \<longrightarrow> (\<forall>i<length xs. ((None, s)#xs)!i -e\<rightarrow> xs!i)"
+apply(induct xs,simp+)
+apply clarify
+apply(erule cptn.elims,simp)
+ apply simp
+ apply(case_tac i,simp)
+  apply(rule Env)
+ apply simp
+apply(force elim:ctran.elims)
+done
+
+lemma cptn_not_empty [simp]:"[] \<notin> cptn"
+apply(force elim:cptn.elims)
+done
+
+lemma etran_or_ctran [rule_format]: 
+  "\<forall>m i. x\<in>cptn \<longrightarrow> m \<le> length x 
+  \<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"
+apply(induct x,simp)
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp)
+  apply(rule Env)
+ apply simp
+ apply(erule_tac x="m - 1" in allE)
+ apply(case_tac m,simp,simp)
+ apply(subgoal_tac "(\<forall>i. Suc i < nata \<longrightarrow> (((P, t) # xs) ! i, xs ! i) \<notin> ctran)")
+  apply force
+ apply clarify
+ apply(erule_tac x="Suc ia" in allE,simp)
+apply(erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (?J j) \<notin> ctran" in allE,simp)
+done
+
+lemma etran_or_ctran2 [rule_format]: 
+  "\<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)
+  \<or> (x!i -e\<rightarrow> x!Suc i \<longrightarrow> \<not> x!i -c\<rightarrow> x!Suc i)"
+apply(induct x)
+ apply simp
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp+)
+apply(case_tac i,simp)
+ apply(force elim:etran.elims)
+apply simp
+done
+
+lemma etran_or_ctran2_disjI1: 
+  "\<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"
+by(drule etran_or_ctran2,simp_all)
+
+lemma etran_or_ctran2_disjI2: 
+  "\<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"
+by(drule etran_or_ctran2,simp_all)
+
+lemma not_ctran_None2 [rule_format]: 
+  "\<lbrakk> (None, s) # xs \<in>cptn; i<length xs\<rbrakk> \<Longrightarrow> \<not> ((None, s) # xs) ! i -c\<rightarrow> xs ! i"
+apply(frule not_ctran_None,simp)
+apply(case_tac i,simp)
+ apply(force elim:etran.elims)
+apply simp
+apply(rule etran_or_ctran2_disjI2,simp_all)
+apply(force intro:tl_of_cptn_is_cptn)
+done
+
+lemma Ex_first_occurrence [rule_format]: "P (n::nat) \<longrightarrow> (\<exists>m. P m \<and> (\<forall>i<m. \<not> P i))";
+apply(rule nat_less_induct)
+apply clarify
+apply(case_tac "\<forall>m. m<n \<longrightarrow> \<not> P m")
+apply auto
+done
+ 
+lemma stability [rule_format]: 
+  "\<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>
+  (\<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> 
+  (\<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)"
+apply(induct x)
+ apply clarify
+ apply(force elim:cptn.elims)
+apply clarify
+apply(erule cptn.elims,simp)
+ apply simp
+ apply(case_tac k,simp,simp)
+ apply(case_tac j,simp) 
+  apply(erule_tac x=0 in allE)
+  apply(erule_tac x="nat" and P="\<lambda>j. (0\<le>j) \<longrightarrow> (?J j)" in allE,simp)
+  apply(subgoal_tac "t\<in>p")
+   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)")
+    apply clarify
+    apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
+   apply clarify
+   apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
+  apply(erule_tac x=0 and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran \<longrightarrow> ?T j" in allE,simp)
+  apply(simp(no_asm_use) only:stable_def)
+  apply(erule_tac x=s in allE)
+  apply(erule_tac x=t in allE)
+  apply simp 
+  apply(erule mp)
+  apply(erule mp)
+  apply(rule Env)
+ apply simp
+ apply(erule_tac x="nata" in allE)
+ apply(erule_tac x="nat" and P="\<lambda>j. (?s\<le>j) \<longrightarrow> (?J j)" in allE,simp)
+ 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)")
+  apply clarify
+  apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
+ apply clarify
+ apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
+apply(case_tac k,simp,simp)
+apply(case_tac j)
+ apply(erule_tac x=0 and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
+ apply(erule etran.elims,simp)
+apply(erule_tac x="nata" in allE)
+apply(erule_tac x="nat" and P="\<lambda>j. (?s\<le>j) \<longrightarrow> (?J j)" in allE,simp)
+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)")
+ apply clarify
+ apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j)\<in>etran" in allE,simp)
+apply clarify
+apply(erule_tac x="Suc i" and P="\<lambda>j. (?H j) \<longrightarrow> (?J j) \<longrightarrow> (?T j)\<in>rely" in allE,simp)
+done
+
+subsection {* Soundness of the System for Component Programs *}
+
+subsubsection {* Soundness of the Basic rule *}
+
+lemma unique_ctran_Basic [rule_format]: 
+  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Basic f), s) \<longrightarrow> 
+  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)"
+apply(induct x,simp)
+apply simp
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp+)
+ apply clarify
+ apply(case_tac j,simp)
+  apply(rule Env)
+ apply simp
+apply clarify
+apply simp
+apply(case_tac i)
+ apply(case_tac j,simp,simp)
+ apply(erule ctran.elims,simp_all)
+ apply(force elim: not_ctran_None)
+apply(ind_cases "((Some (Basic f), sa), Q, t) \<in> ctran")
+apply simp
+apply(drule_tac i=nat in not_ctran_None,simp)
+apply(erule etran.elims,simp)
+done
+
+lemma exists_ctran_Basic_None [rule_format]: 
+  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Basic f), s) 
+  \<longrightarrow> i<length x \<longrightarrow> fst(x!i)=None \<longrightarrow> (\<exists>j<i. x!j -c\<rightarrow> x!Suc j)"
+apply(induct x,simp)
+apply simp
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp,simp)
+ apply(erule_tac x=nat in allE,simp)
+ apply clarify
+ apply(rule_tac x="Suc j" in exI,simp,simp)
+apply clarify
+apply(case_tac i,simp,simp)
+apply(rule_tac x=0 in exI,simp)
+done
+
+lemma Basic_sound: 
+  " \<lbrakk>pre \<subseteq> {s. f s \<in> post}; {(s, t). s \<in> pre \<and> t = f s} \<subseteq> guar; 
+  stable pre rely; stable post rely\<rbrakk>
+  \<Longrightarrow> \<Turnstile> Basic f sat [pre, rely, guar, post]"
+apply(unfold com_validity_def)
+apply clarify
+apply(simp add:comm_def)
+apply(rule conjI)
+ apply clarify
+ apply(simp add:cp_def assum_def)
+ apply clarify
+ apply(frule_tac j=0 and k=i and p=pre in stability)
+       apply simp_all
+   apply(erule_tac x=ia in allE,simp)
+  apply(erule_tac i=i and f=f in unique_ctran_Basic,simp_all)
+ apply(erule subsetD,simp)
+ apply(case_tac "x!i")
+ apply clarify
+ apply(drule_tac s="Some (Basic f)" in sym,simp)
+ apply(thin_tac "\<forall>j. ?H j")
+ apply(force elim:ctran.elims)
+apply clarify
+apply(simp add:cp_def)
+apply clarify
+apply(frule_tac i="length x - 1" and f=f in exists_ctran_Basic_None,simp+)
+  apply(case_tac x,simp+)
+  apply(rule last_fst_esp,simp add:last_length)
+ apply (case_tac x,simp+)
+apply(simp add:assum_def)
+apply clarify
+apply(frule_tac j=0 and k="j" and p=pre in stability)
+      apply simp_all
+    apply arith
+  apply(erule_tac x=i in allE,simp)
+ apply(erule_tac i=j and f=f in unique_ctran_Basic,simp_all)
+  apply arith
+ apply arith
+apply(case_tac "x!j")
+apply clarify
+apply simp
+apply(drule_tac s="Some (Basic f)" in sym,simp)
+apply(case_tac "x!Suc j",simp)
+apply(rule ctran.elims,simp)
+apply(simp_all)
+apply(drule_tac c=sa in subsetD,simp)
+apply clarify
+apply(frule_tac j="Suc j" and k="length x - 1" and p=post in stability,simp_all)
+ apply(case_tac x,simp+)
+ apply(erule_tac x=i in allE)
+apply(erule_tac i=j and f=f in unique_ctran_Basic,simp_all)
+  apply arith+
+apply(case_tac x)
+apply(simp add:last_length)+
+done
+
+subsubsection{* Soundness of the Await rule *}
+
+lemma unique_ctran_Await [rule_format]: 
+  "\<forall>s i. x \<in> cptn \<longrightarrow> x ! 0 = (Some (Await b c), s) \<longrightarrow> 
+  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)"
+apply(induct x,simp+)
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp+)
+ apply clarify
+ apply(case_tac j,simp)
+  apply(rule Env)
+ apply simp
+apply clarify
+apply simp
+apply(case_tac i)
+ apply(case_tac j,simp,simp)
+ apply(erule ctran.elims,simp_all)
+ apply(force elim: not_ctran_None)
+apply(ind_cases "((Some (Await b c), sa), Q, t) \<in> ctran",simp)
+apply(drule_tac i=nat in not_ctran_None,simp)
+apply(erule etran.elims,simp)
+done
+
+lemma exists_ctran_Await_None [rule_format]: 
+  "\<forall>s i.  x \<in> cptn \<longrightarrow> x ! 0 = (Some (Await b c), s) 
+  \<longrightarrow> i<length x \<longrightarrow> fst(x!i)=None \<longrightarrow> (\<exists>j<i. x!j -c\<rightarrow> x!Suc j)"
+apply(induct x,simp+)
+apply clarify
+apply(erule cptn.elims,simp)
+ apply(case_tac i,simp+)
+ apply(erule_tac x=nat in allE,simp)
+ apply clarify
+ apply(rule_tac x="Suc j" in exI,simp,simp)
+apply clarify
+apply(case_tac i,simp,simp)
+apply(rule_tac x=0 in exI,simp)
+done
+
+lemma Star_imp_cptn: 
+  "(P, s) -c*\<rightarrow> (R, t) \<Longrightarrow> \<exists>l \<in> cp P s. (last l)=(R, t)
+  \<and> (\<forall>i. Suc i<length l \<longrightarrow> l!i -c\<rightarrow> l!Suc i)"
+apply (erule converse_rtrancl_induct2)
+ apply(rule_tac x="[(R,t)]" in bexI)
+  apply simp
+ apply(simp add:cp_def)
+ apply(rule CptnOne)
+apply clarify
+apply(rule_tac x="(a, b)#l" in bexI)
+ apply (rule conjI)
+  apply(case_tac l,simp add:cp_def)
+  apply(simp add:last_length)
+ apply clarify
+apply(case_tac i,simp)
+apply(simp add:cp_def)
+apply force
+apply(simp add:cp_def)
+ apply(case_tac l)
+ apply(force elim:cptn.elims)
+apply simp
+apply(erule CptnComp)
+apply clarify
+done
+ 
+lemma Await_sound: 
+  "\<lbrakk>stable pre rely; stable post rely;
+  \<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>
+  \<Turnstile> P sat [pre \<inter> b \<inter> {s. s = V}, {(s, t). s = t}, UNIV, {s. (V, s) \<in> guar} \<inter> post] \<rbrakk>
+  \<Longrightarrow> \<Turnstile> Await b P sat [pre, rely, guar, post]"
+apply(unfold com_validity_def)
+apply clarify
+apply(simp add:comm_def)
+apply(rule conjI)
+ apply clarify
+ apply(simp add:cp_def assum_def)
+ apply clarify
+ apply(frule_tac j=0 and k=i and p=pre in stability,simp_all)
+   apply(erule_tac x=ia in allE,simp)
+  apply(subgoal_tac "x\<in> cp (Some(Await b P)) s")
+  apply(erule_tac i=i in unique_ctran_Await,force,simp_all)
+  apply(simp add:cp_def)
+--{* here starts the different part. *}
+ apply(erule ctran.elims,simp_all)
+ apply(drule Star_imp_cptn) 
+ apply clarify
+ apply(erule_tac x=sa in allE)
+ apply clarify
+ apply(erule_tac x=sa in allE)
+ apply(drule_tac c=l in subsetD)
+  apply (simp add:cp_def)
+  apply clarify
+  apply(erule_tac x=ia and P="\<lambda>i. ?H i \<longrightarrow> (?J i,?I i)\<in>ctran" in allE,simp)
+  apply(erule etran.elims,simp)
+ apply simp
+apply clarify
+apply(simp add:cp_def)
+apply clarify
+apply(frule_tac i="length x - 1" in exists_ctran_Await_None,force)
+  apply (case_tac x,simp+)
+ apply(rule last_fst_esp,simp add:last_length)
+ apply(case_tac x, (simp add:cptn_not_empty)+)
+apply clarify
+apply(simp add:assum_def)
+apply clarify
+apply(frule_tac j=0 and k="j" and p=pre in stability,simp_all)
+   apply arith
+  apply(erule_tac x=i in allE,simp)
+ apply(erule_tac i=j in unique_ctran_Await,force,simp_all)
+  apply arith
+ apply arith
+apply(case_tac "x!j")
+apply clarify
+apply simp
+apply(drule_tac s="Some (Await b P)" in sym,simp)
+apply(case_tac "x!Suc j",simp)
+apply(rule ctran.elims,simp)
+apply(simp_all)
+apply(drule Star_imp_cptn) 
+apply clarify
+apply(erule_tac x=sa in allE)
+apply clarify
+apply(erule_tac x=sa in allE)
+apply(drule_tac c=l in subsetD)
+ apply (simp add:cp_def)
+ apply clarify
+ apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> (?J i,?I i)\<in>ctran" in allE,simp)
+ apply(erule etran.elims,simp)
+apply simp
+apply clarify
+apply(frule_tac j="Suc j" and k="length x - 1" and p=post in stability,simp_all)
+ apply(case_tac x,simp+)
+ apply(erule_tac x=i in allE)
+apply(erule_tac i=j in unique_ctran_Await,force,simp_all)
+ apply arith+
+apply(case_tac x)
+apply(simp add:last_length)+
+done
+
+subsubsection{* Soundness of the Conditional rule *}
+
+lemma last_length2 [rule_format]: "xs\<noteq>[] \<longrightarrow> (last xs)=(xs!(length xs - (Suc 0)))"
+apply(induct xs,simp+)
+apply(case_tac "length list",simp+)
+done
+
+lemma last_drop: "Suc m<length x \<Longrightarrow> last(drop (Suc m) x) = last x"
+apply(case_tac "(drop (Suc m) x)\<noteq>[]")
+ apply(drule last_length2)
+ apply(erule ssubst)
+ apply(simp only:length_drop)
+ apply(subgoal_tac "Suc m + (length x - Suc m - (Suc 0)) \<le> length x")
+  apply(simp only:nth_drop)
+  apply(case_tac "x\<noteq>[]")
+   apply(drule last_length2)
+   apply(erule ssubst)
+   apply simp
+   apply(subgoal_tac "Suc (length x - 2)=(length x - Suc 0)")
+    apply simp
+   apply arith
+  apply simp
+ apply arith
+apply (simp add:length_greater_0_conv [THEN sym])
+done
+
+lemma Cond_sound: 
+  "\<lbrakk> stable pre rely; \<Turnstile> P1 sat [pre \<inter> b, rely, guar, post]; 
+  \<Turnstile> P2 sat [pre \<inter> - b, rely, guar, post]; \<forall>s. (s,s)\<in>guar\<rbrakk>
+  \<Longrightarrow> \<Turnstile> (Cond b P1 P2) sat [pre, rely, guar, post]"
+apply(unfold com_validity_def)
+apply clarify
+apply(simp add:cp_def comm_def)
+apply(case_tac "\<exists>i. Suc i<length x \<and> x!i -c\<rightarrow> x!Suc i")
+ prefer 2
+ apply simp
+ apply clarify
+ apply(frule_tac j="0" and k="length x - 1" and p=pre in stability,simp+)
+     apply(case_tac x,simp+)
+    apply(simp add:assum_def)
+   apply(simp add:assum_def)
+  apply(erule_tac m="length x" in etran_or_ctran,simp+)
+  apply(case_tac x,simp+)
+ apply(case_tac x, (simp add:last_length)+)
+apply(erule exE)
+apply(drule_tac n=i and P="\<lambda>i. ?H i \<and> (?J i,?I i)\<in> ctran" in Ex_first_occurrence)
+apply clarify
+apply (simp add:assum_def)
+apply(frule_tac j=0 and k="m" and p=pre in stability,simp+)
+ apply(erule_tac m="Suc m" in etran_or_ctran,simp+)
+apply(erule ctran.elims,simp_all)
+ apply(erule_tac x="sa" in allE)
+ apply(drule_tac c="drop (Suc m) x" in subsetD)
+  apply simp
+  apply(rule conjI)
+   apply force
+  apply clarify
+  apply(subgoal_tac "(Suc m) + i \<le> length x")
+   apply(subgoal_tac "(Suc m) + (Suc i) \<le> length x")
+    apply(rotate_tac -2)
+    apply simp
+    apply(erule_tac x="Suc (m + i)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE)
+    apply(subgoal_tac "Suc (Suc (m + i)) < length x",simp)
+    apply arith
+   apply arith
+  apply arith
+ apply simp
+ apply(rule conjI)
+  apply clarify
+  apply(case_tac "i\<le>m")
+   apply(drule le_imp_less_or_eq)
+   apply(erule disjE)
+    apply(erule_tac x=i in allE, erule impE, assumption)
+    apply simp+
+  apply(erule_tac x="i - (Suc m)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> (?I j)\<in>guar" in allE)
+  apply(subgoal_tac "(Suc m)+(i - Suc m) \<le> length x")
+   apply(subgoal_tac "(Suc m)+Suc (i - Suc m) \<le> length x")
+    apply(rotate_tac -2)
+    apply simp
+    apply(erule mp)
+    apply arith
+   apply arith
+  apply arith
+ apply(simp add:last_drop)
+apply(case_tac "length (drop (Suc m) x)",simp)
+apply(erule_tac x="sa" in allE)
+back
+apply(drule_tac c="drop (Suc m) x" in subsetD,simp)
+ apply(rule conjI)
+  apply force
+ apply clarify
+ apply(subgoal_tac "(Suc m) + i \<le> length x")
+  apply(subgoal_tac "(Suc m) + (Suc i) \<le> length x")
+   apply(rotate_tac -2)
+   apply simp
+   apply(erule_tac x="Suc (m + i)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE)
+   apply(subgoal_tac "Suc (Suc (m + i)) < length x")
+    apply simp
+   apply arith
+  apply arith
+ apply arith
+apply simp
+apply clarify
+apply(rule conjI)
+ apply clarify
+ apply(case_tac "i\<le>m")
+  apply(drule le_imp_less_or_eq)
+  apply(erule disjE)
+   apply(erule_tac x=i in allE, erule impE, assumption)
+   apply simp
+  apply simp
+ apply(erule_tac x="i - (Suc m)" and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> (?I j)\<in>guar" in allE)
+ apply(subgoal_tac "(Suc m)+(i - Suc m) \<le> length x")
+  apply(subgoal_tac "(Suc m)+Suc (i - Suc m) \<le> length x")
+   apply(rotate_tac -2)
+   apply simp
+   apply(erule mp)
+   apply arith
+  apply arith
+ apply arith
+apply(simp add:last_drop)
+done  
+
+subsubsection{* Soundness of the Sequential rule *}
+
+inductive_cases Seq_cases [elim!]: "(Some (Seq P Q), s) -c\<rightarrow> t"
+
+lemma last_lift_not_None: "fst ((lift Q) ((x#xs)!(length xs))) \<noteq> None"
+apply(subgoal_tac "length xs<length (x # xs)")
+ apply(drule_tac Q=Q in  lift_nth)
+ apply(erule ssubst)
+ apply (simp add:lift_def)
+ apply(case_tac "(x # xs) ! length xs",simp)
+apply simp
+done
+
+lemma Seq_sound1 [rule_format]: 
+  "x\<in> cptn_mod \<Longrightarrow> \<forall>s P. x !0=(Some (Seq P Q), s) \<longrightarrow> 
+  (\<forall>i<length x. fst(x!i)\<noteq>Some Q) \<longrightarrow> 
+  (\<exists>xs\<in> cp (Some P) s. x=map (lift Q) xs)"
+apply(erule cptn_mod.induct)
+apply(unfold cp_def)
+apply safe
+apply simp_all
+    apply(simp add:lift_def)
+    apply(rule_tac x="[(Some Pa, sa)]" in exI,simp add:CptnOne)
+   apply(subgoal_tac "(\<forall>i < Suc (length xs). fst (((Some (Seq Pa Q), t) # xs) ! i) \<noteq> Some Q)")
+    apply clarify
+    apply(case_tac xsa,simp,simp)
+    apply(rule_tac x="(Some Pa, sa) #(Some Pa, t) # list" in exI,simp)
+    apply(rule conjI,erule CptnEnv)
+    apply(simp add:lift_def)
+   apply clarify
+   apply(erule_tac x="Suc i" in allE, simp)
+  apply(ind_cases "((Some (Seq Pa Q), sa), None, t) \<in> ctran")
+ apply(rule_tac x="(Some P, sa) # xs" in exI, simp add:cptn_iff_cptn_mod lift_def)
+apply(erule_tac x="length xs" in allE, simp)
+apply(simp only:Cons_lift_append)
+apply(subgoal_tac "length xs < length ((Some P, sa) # xs)")
+ apply(simp only :nth_append length_map last_length nth_map)
+ apply(case_tac "last((Some P, sa) # xs)")
+ apply(simp add:lift_def)
+apply simp
+done
+
+lemma Seq_sound2 [rule_format]: 
+  "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>
+  (\<forall>j<i. fst(x!j)\<noteq>(Some Q)) \<longrightarrow>
+  (\<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)"
+apply(erule cptn.induct)
+apply(unfold cp_def)
+apply safe
+apply simp_all
+ apply(case_tac i,simp+)
+ apply(erule allE,erule impE,assumption,simp)
+ apply clarify
+ apply(subgoal_tac "(\<forall>j < nat. fst (((Some (Seq Pa Q), t) # xs) ! j) \<noteq> Some Q)",clarify)
+  prefer 2
+  apply force
+ apply(case_tac xsa,simp,simp)
+ apply(rule_tac x="(Some Pa, sa) #(Some Pa, t) # list" in exI,simp)
+ apply(rule conjI,erule CptnEnv)
+ apply(simp add:lift_def)
+ apply(rule_tac x=ys in exI,simp)
+apply(ind_cases "((Some (Seq Pa Q), sa), t) \<in> ctran")
+ apply simp
+ apply(rule_tac x="(Some Pa, sa)#[(None, ta)]" in exI,simp)
+ apply(rule conjI)
+  apply(drule_tac xs="[]" in CptnComp,force simp add:CptnOne,simp)
+ apply(case_tac i, simp+)
+ apply(case_tac nat,simp+)
+ apply(rule_tac x="(Some Q,ta)#xs" in exI,simp add:lift_def)
+ apply(case_tac nat,simp+)
+ apply(force)
+apply(case_tac i, simp+)
+apply(case_tac nat,simp+)
+apply(erule_tac x="Suc nata" in allE,simp)
+apply clarify
+apply(subgoal_tac "(\<forall>j<Suc nata. fst (((Some (Seq P2 Q), ta) # xs) ! j) \<noteq> Some Q)",clarify)
+ prefer 2
+ apply clarify
+ apply force
+apply(rule_tac x="(Some Pa, sa)#(Some P2, ta)#(tl xsa)" in exI,simp)
+apply(rule conjI,erule CptnComp)
+apply(rule nth_tl_if,force,simp+)
+apply(rule_tac x=ys in exI,simp)
+apply(rule conjI)
+apply(rule nth_tl_if,force,simp+)
+ apply(rule tl_zero,simp+)
+ apply force
+apply(rule conjI,simp add:lift_def)
+apply(subgoal_tac "lift Q (Some P2, ta) =(Some (Seq P2 Q), ta)") 
+ apply(simp add:Cons_lift del:map.simps)
+ apply(rule nth_tl_if)
+   apply force
+  apply simp+
+apply(simp add:lift_def)
+done
+(*
+lemma last_lift_not_None3: "fst (last (map (lift Q) (x#xs))) \<noteq> None"
+apply(simp only:last_length [THEN sym])
+apply(subgoal_tac "length xs<length (x # xs)")
+ apply(drule_tac Q=Q in  lift_nth)
+ apply(erule ssubst)
+ apply (simp add:lift_def)
+ apply(case_tac "(x # xs) ! length xs",simp)
+apply simp
+done
+*)
+
+lemma last_lift_not_None2: "fst ((lift Q) (last (x#xs))) \<noteq> None"
+apply(simp only:last_length [THEN sym])
+apply(subgoal_tac "length xs<length (x # xs)")
+ apply(drule_tac Q=Q in  lift_nth)
+ apply(erule ssubst)
+ apply (simp add:lift_def)
+ apply(case_tac "(x # xs) ! length xs",simp)
+apply simp
+done
+
+lemma last_lift_not_None: "fst ((lift Q) ((x#xs)!(length xs))) \<noteq> None"
+apply(subgoal_tac "length xs<length (x # xs)")
+ apply(drule_tac Q=Q in  lift_nth)
+ apply(erule ssubst)
+ apply (simp add:lift_def)
+ apply(case_tac "(x # xs) ! length xs",simp)
+apply simp
+done
+
+lemma Seq_sound: 
+  "\<lbrakk>\<Turnstile> P sat [pre, rely, guar, mid]; \<Turnstile> Q sat [mid, rely, guar, post]\<rbrakk>
+  \<Longrightarrow> \<Turnstile> Seq P Q sat [pre, rely, guar, post]"
+apply(unfold com_validity_def)
+apply clarify
+apply(case_tac "\<exists>i<length x. fst(x!i)=Some Q")
+ prefer 2
+ apply (simp add:cp_def cptn_iff_cptn_mod)
+ apply clarify
+ apply(frule_tac Seq_sound1,force)
+  apply force
+ apply clarify
+ apply(erule_tac x=s in allE,simp)
+ apply(drule_tac c=xs in subsetD,simp add:cp_def cptn_iff_cptn_mod)
+  apply(simp add:assum_def)
+  apply clarify
+  apply(erule_tac P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE,erule impE, assumption)
+  apply(simp add:snd_lift)
+  apply(erule mp)
+  apply(force elim:etran.elims intro:Env simp add:lift_def)
+ apply(simp add:comm_def)
+ apply(rule conjI)
+  apply clarify
+  apply(erule_tac P="\<lambda>j. ?H j \<longrightarrow> ?J j \<longrightarrow> ?I j" in allE,erule impE, assumption)
+  apply(simp add:snd_lift)
+  apply(erule mp)
+  apply(case_tac "(xs!i)")
+  apply(case_tac "(xs! Suc i)")
+  apply(case_tac "fst(xs!i)")
+   apply(erule_tac x=i in allE, simp add:lift_def)
+  apply(case_tac "fst(xs!Suc i)")
+   apply(force simp add:lift_def)
+  apply(force simp add:lift_def)
+ apply clarify
+ apply(case_tac xs,simp add:cp_def)
+ apply clarify
+ apply (simp del:map.simps)
+ apply(subgoal_tac "(map (lift Q) ((a, b) # list))\<noteq>[]")
+  apply(drule last_length2)
+  apply (simp del:map.simps)
+  apply(simp only:last_lift_not_None)
+ apply simp
+--{* @{text "\<exists>i<length x. fst (x ! i) = Some Q"} *}
+apply(erule exE)
+apply(drule_tac n=i and P="\<lambda>i. i < length x \<and> fst (x ! i) = Some Q" in Ex_first_occurrence)
+apply clarify
+apply (simp add:cp_def)
+ apply clarify
+ apply(frule_tac i=m in Seq_sound2,force)
+  apply simp+
+apply clarify
+apply(simp add:comm_def)
+apply(erule_tac x=s in allE)
+apply(drule_tac c=xs in subsetD,simp)
+ apply(case_tac "xs=[]",simp)
+ apply(simp add:cp_def assum_def nth_append)
+ apply clarify
+ apply(erule_tac x=i in allE)
+  back 
+ apply(simp add:snd_lift)
+ apply(erule mp)
+ apply(force elim:etran.elims intro:Env simp add:lift_def)
+apply simp
+apply clarify
+apply(erule_tac x="snd(xs!m)" in allE)
+apply(drule_tac c=ys in subsetD,simp add:cp_def assum_def)
+ apply(case_tac "xs\<noteq>[]")
+ apply(drule last_length2,simp)
+ apply(rule conjI)
+  apply(erule mp)
+  apply(case_tac "xs!m")
+  apply(case_tac "fst(xs!m)",simp)
+  apply(simp add:lift_def nth_append)
+ apply clarify
+ apply(erule_tac x="m+i" in allE)
+ back
+ back
+ apply(case_tac ys,(simp add:nth_append)+)
+ apply (case_tac i, (simp add:snd_lift)+)
+  apply(erule mp)
+  apply(case_tac "xs!m")
+  apply(force elim:etran.elims intro:Env simp add:lift_def)
+ apply simp 
+apply simp
+apply clarify
+apply(rule conjI,clarify)
+ apply(case_tac "i<m",simp add:nth_append)
+  apply(simp add:snd_lift)
+  apply(erule allE, erule impE, assumption, erule mp)
+  apply(case_tac "(xs ! i)")
+  apply(case_tac "(xs ! Suc i)")   
+  apply(case_tac "fst(xs ! i)",force simp add:lift_def)   
+  apply(case_tac "fst(xs ! Suc i)")
+   apply (force simp add:lift_def)
+  apply (force simp add:lift_def)
+ apply(erule_tac x="i-m" in allE) 
+ back
+ back
+ apply(subgoal_tac "Suc (i - m) < length ys",simp)
+  prefer 2
+  apply arith
+ apply(simp add:nth_append snd_lift)
+ apply(rule conjI,clarify)
+  apply(subgoal_tac "i=m")
+   prefer 2
+   apply arith
+  apply clarify
+  apply(simp add:cp_def)
+  apply(rule tl_zero)
+    apply(erule mp)
+    apply(case_tac "lift Q (xs!m)",simp add:snd_lift)
+    apply(case_tac "xs!m",case_tac "fst(xs!m)",simp add:lift_def snd_lift)
+     apply(case_tac ys,simp+)
+    apply(simp add:lift_def)
+   apply simp 
+  apply force
+ apply clarify
+ apply(rule tl_zero)
+   apply(rule tl_zero)
+     apply (subgoal_tac "i-m=Suc(i-Suc m)")
+      apply simp
+      apply(erule mp)
+      apply(case_tac ys,simp+)
+     apply arith
+    apply arith
+   apply force
+  apply arith
+ apply force
+apply clarify
+apply(case_tac "(map (lift Q) xs @ tl ys)\<noteq>[]")
+ apply(drule last_length2)
+ apply(simp add: snd_lift nth_append)
+ apply(rule conjI,clarify)
+  apply(case_tac ys,simp+)
+ apply clarify
+ apply(case_tac ys,simp+)
+ apply(drule last_length2,simp)
+apply simp
+done
+
+subsubsection{* Soundness of the While rule *}
+
+lemma assum_after_body: 
+  "\<lbrakk> \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; 
+  (Some P, s) # xs \<in> cptn_mod; fst (((Some P, s) # xs)!length xs) = None; s \<in> b;
+  (Some (While b P), s) # (Some (Seq P (While b P)), s) # map (lift (While b P)) xs @ ys \<in> assum (pre, rely)\<rbrakk>
+  \<Longrightarrow> (Some (While b P), snd (((Some P, s) # xs)!length xs)) # ys \<in> assum (pre, rely)"
+apply(simp add:assum_def com_validity_def cp_def cptn_iff_cptn_mod)
+apply clarify
+apply(erule_tac x=s in allE)
+apply(drule_tac c="(Some P, s) # xs" in subsetD,simp)
+ apply clarify
+ apply(erule_tac x="Suc i" in allE)
+ apply simp
+ apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
+ apply(erule mp)
+ apply(erule etran.elims,simp)
+ apply(case_tac "fst(((Some P, s) # xs) ! i)")
+  apply(force intro:Env simp add:lift_def)
+ apply(force intro:Env simp add:lift_def)
+apply(rule conjI)
+ apply(simp add:comm_def last_length)
+apply clarify
+apply(erule_tac x="Suc(length xs + i)" in allE,simp)
+apply(case_tac i, simp add:nth_append Cons_lift_append snd_lift del:map.simps)
+ apply(erule mp)
+ apply(case_tac "((Some P, s) # xs) ! length xs")
+ apply(simp add:lift_def)
+apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
+done
+
+lemma last_append[rule_format]:
+  "\<forall>xs. ys\<noteq>[] \<longrightarrow> ((xs@ys)!(length (xs@ys) - (Suc 0)))=(ys!(length ys - (Suc 0)))"
+apply(induct ys)
+ apply simp
+apply clarify
+apply (simp add:nth_append length_append)
+done
+
+lemma assum_after_body: 
+  "\<lbrakk> \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; 
+  (Some P, s) # xs \<in> cptn_mod; fst (last ((Some P, s) # xs)) = None; s \<in> b;
+  (Some (While b P), s) # (Some (Seq P (While b P)), s) # map (lift (While b P)) xs @ ys 
+   \<in> assum (pre, rely)\<rbrakk>
+  \<Longrightarrow> (Some (While b P), snd (last ((Some P, s) # xs))) # ys \<in> assum (pre, rely)"
+apply(simp add:assum_def com_validity_def cp_def cptn_iff_cptn_mod)
+apply clarify
+apply(erule_tac x=s in allE)
+apply(drule_tac c="(Some P, s) # xs" in subsetD,simp)
+ apply clarify
+ apply(erule_tac x="Suc i" in allE)
+ apply simp
+ apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
+ apply(erule mp)
+ apply(erule etran.elims,simp)
+ apply(case_tac "fst(((Some P, s) # xs) ! i)")
+  apply(force intro:Env simp add:lift_def)
+ apply(force intro:Env simp add:lift_def)
+apply(rule conjI)
+ apply clarify
+ apply(simp add:comm_def last_length)
+apply clarify
+apply(rule conjI)
+ apply(simp add:comm_def)
+apply clarify
+apply(erule_tac x="Suc(length xs + i)" in allE,simp)
+apply(case_tac i, simp add:nth_append Cons_lift_append snd_lift del:map.simps)
+ apply(simp add:last_length)
+ apply(erule mp)
+ apply(case_tac "last xs")
+ apply(simp add:lift_def)
+apply(simp add:Cons_lift_append nth_append snd_lift del:map.simps)
+done
+
+lemma last_append2:"ys\<noteq>[] \<Longrightarrow> last (xs@ys)=(last ys)"
+apply(frule last_length2)
+apply simp
+apply(subgoal_tac "xs@ys\<noteq>[]")
+apply(drule last_length2)
+back
+apply simp
+apply(drule_tac xs=xs in last_append)
+apply simp
+apply simp
+done
+
+lemma While_sound_aux [rule_format]: 
+  "\<lbrakk> pre \<inter> - b \<subseteq> post; \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s, s) \<in> guar;
+   stable pre rely;  stable post rely; x \<in> cptn_mod \<rbrakk> 
+  \<Longrightarrow>  \<forall>s xs. x=(Some(While b P),s)#xs \<longrightarrow> x\<in>assum(pre, rely) \<longrightarrow> x \<in> comm (guar, post)"
+apply(erule cptn_mod.induct)
+apply safe
+apply (simp_all del:last.simps)
+--{* 5 subgoals left *}
+apply(simp add:comm_def)
+--{* 4 subgoals left *}
+apply(rule etran_in_comm)
+apply(erule mp)
+apply(erule tl_of_assum_in_assum,simp)
+--{* While-None *}
+apply(ind_cases "((Some (While b P), s), None, t) \<in> ctran")
+apply(simp add:comm_def)
+apply(simp add:cptn_iff_cptn_mod [THEN sym])
+apply(rule conjI,clarify)
+ apply(force simp add:assum_def)
+apply clarify
+apply(rule conjI, clarify)
+ apply(case_tac i,simp,simp)
+ apply(force simp add:not_ctran_None2)
+apply(subgoal_tac "\<forall>i. Suc i < length ((None, sa) # xs) \<longrightarrow> (((None, sa) # xs) ! i, ((None, sa) # xs) ! Suc i)\<in> etran")
+ prefer 2
+ apply clarify
+ apply(rule_tac m="length ((None, s) # xs)" in etran_or_ctran,simp+)
+ apply(erule not_ctran_None2,simp)
+ apply simp+
+apply(frule_tac j="0" and k="length ((None, s) # xs) - 1" and p=post in stability,simp+)
+   apply(force simp add:assum_def subsetD)
+  apply(simp add:assum_def)
+  apply clarify
+  apply(erule_tac x="i" in allE,simp) 
+  apply(erule_tac x="Suc i" in allE,simp) 
+ apply simp
+apply clarify
+apply (simp add:last_length)
+--{* WhileOne *}
+apply(thin_tac "P = While b P \<longrightarrow> ?Q")
+apply(rule ctran_in_comm,simp)
+apply(simp add:Cons_lift del:map.simps)
+apply(simp add:comm_def del:map.simps)
+apply(rule conjI)
+ apply clarify
+ apply(case_tac "fst(((Some P, sa) # xs) ! i)")
+  apply(case_tac "((Some P, sa) # xs) ! i")
+  apply (simp add:lift_def)
+  apply(ind_cases "(Some (While b P), ba) -c\<rightarrow> t")
+   apply simp
+  apply simp
+ apply(simp add:snd_lift del:map.simps)
+ apply(simp only:com_validity_def cp_def cptn_iff_cptn_mod)
+ apply(erule_tac x=sa in allE)
+ apply(drule_tac c="(Some P, sa) # xs" in subsetD)
+  apply (simp add:assum_def del:map.simps)
+  apply clarify
+  apply(erule_tac x="Suc ia" in allE,simp add:snd_lift del:map.simps)
+  apply(erule mp)
+  apply(case_tac "fst(((Some P, sa) # xs) ! ia)")
+   apply(erule etran.elims,simp add:lift_def)
+   apply(rule Env)
+  apply(erule etran.elims,simp add:lift_def)
+  apply(rule Env)
+ apply (simp add:comm_def del:map.simps)
+ apply clarify
+ apply(erule allE,erule impE,assumption)
+ apply(erule mp)
+ apply(case_tac "((Some P, sa) # xs) ! i")
+ apply(case_tac "xs!i")
+ apply(simp add:lift_def)
+ apply(case_tac "fst(xs!i)")
+  apply force
+ apply force
+--{* last=None *}
+apply clarify
+apply(subgoal_tac "(map (lift (While b P)) ((Some P, sa) # xs))\<noteq>[]")
+ apply(drule last_length2)
+ apply (simp del:map.simps)
+ apply(simp only:last_lift_not_None)
+apply simp
+--{* WhileMore *}
+apply(thin_tac "P = While b P \<longrightarrow> ?Q")
+apply(rule ctran_in_comm,simp del:last.simps)
+--{* metiendo la hipotesis antes de dividir la conclusion. *}
+apply(subgoal_tac "(Some (While b P), snd (last ((Some P, sa) # xs))) # ys \<in> assum (pre, rely)")
+ apply (simp del:last.simps)
+ prefer 2
+ apply(erule assum_after_body)
+  apply (simp del:last.simps)+
+--{* lo de antes. *}
+apply(simp add:comm_def del:map.simps last.simps)
+apply(rule conjI)
+ apply clarify
+ apply(simp only:Cons_lift_append)
+ apply(case_tac "i<length xs")
+  apply(simp add:nth_append del:map.simps last.simps)
+  apply(case_tac "fst(((Some P, sa) # xs) ! i)")
+   apply(case_tac "((Some P, sa) # xs) ! i")
+   apply (simp add:lift_def del:last.simps)
+   apply(ind_cases "(Some (While b P), ba) -c\<rightarrow> t")
+    apply simp
+   apply simp
+  apply(simp add:snd_lift del:map.simps last.simps)
+  apply(thin_tac " \<forall>i. i < length ys \<longrightarrow> ?P i")
+  apply(simp only:com_validity_def cp_def cptn_iff_cptn_mod)
+  apply(erule_tac x=sa in allE)
+  apply(drule_tac c="(Some P, sa) # xs" in subsetD)
+   apply (simp add:assum_def del:map.simps last.simps)
+   apply clarify
+   apply(erule_tac x="Suc ia" in allE,simp add:nth_append snd_lift del:map.simps last.simps, erule mp)
+   apply(case_tac "fst(((Some P, sa) # xs) ! ia)")
+    apply(erule etran.elims,simp add:lift_def)
+    apply(rule Env)
+   apply(erule etran.elims,simp add:lift_def)
+   apply(rule Env)
+  apply (simp add:comm_def del:map.simps)
+  apply clarify
+  apply(erule allE,erule impE,assumption)
+  apply(erule mp)
+  apply(case_tac "((Some P, sa) # xs) ! i")
+  apply(case_tac "xs!i")
+  apply(simp add:lift_def)
+  apply(case_tac "fst(xs!i)")
+   apply force
+ apply force
+--{*  @{text "i \<ge> length xs"} *}
+apply(subgoal_tac "i-length xs <length ys") 
+ prefer 2
+ apply arith
+apply(erule_tac x="i-length xs" in allE,clarify)
+apply(case_tac "i=length xs")
+ apply (simp add:nth_append snd_lift del:map.simps last.simps)
+ apply(simp add:last_length del:last.simps)
+ apply(erule mp)
+ apply(case_tac "last((Some P, sa) # xs)")
+ apply(simp add:lift_def del:last.simps)
+--{* @{text "i>length xs"} *} 
+apply(case_tac "i-length xs")
+ apply arith
+apply(simp add:nth_append del:map.simps last.simps)
+apply(rule conjI,clarify,arith)
+apply clarify
+apply(subgoal_tac "i- Suc (length xs)=nat")
+ prefer 2
+ apply arith
+apply simp
+--{* last=None *}
+apply clarify
+apply(case_tac ys)
+ apply(simp add:Cons_lift del:map.simps last.simps)
+ apply(subgoal_tac "(map (lift (While b P)) ((Some P, sa) # xs))\<noteq>[]")
+  apply(drule last_length2)
+  apply (simp del:map.simps)
+  apply(simp only:last_lift_not_None)
+ apply simp
+apply(subgoal_tac "((Some (Seq P (While b P)), sa) # map (lift (While b P)) xs @ ys)\<noteq>[]")
+ apply(drule last_length2)
+ apply (simp del:map.simps last.simps)
+ apply(simp add:nth_append del:last.simps)
+ apply(subgoal_tac "((Some (While b P), snd (last ((Some P, sa) # xs))) # a # list)\<noteq>[]")
+  apply(drule last_length2)
+  apply (simp del:map.simps last.simps)
+ apply simp
+apply simp
+done
+
+lemma While_sound: 
+  "\<lbrakk>stable pre rely; pre \<inter> - b \<subseteq> post; stable post rely;
+    \<Turnstile> P sat [pre \<inter> b, rely, guar, pre]; \<forall>s. (s,s)\<in>guar\<rbrakk>
+  \<Longrightarrow> \<Turnstile> While b P sat [pre, rely, guar, post]"
+apply(unfold com_validity_def)
+apply clarify
+apply(erule_tac xs="tl x" in While_sound_aux)
+ apply(simp add:com_validity_def)
+ apply force
+ apply simp_all
+apply(simp add:cptn_iff_cptn_mod cp_def)
+apply(simp add:cp_def)
+apply clarify
+apply(rule nth_equalityI)
+ apply simp_all
+ apply(case_tac x,simp+)
+apply clarify
+apply(case_tac i,simp+)
+apply(case_tac x,simp+)
+done
+
+subsubsection{* Soundness of the Rule of Consequence *}
+
+lemma Conseq_sound: 
+  "\<lbrakk>pre \<subseteq> pre'; rely \<subseteq> rely'; guar' \<subseteq> guar; post' \<subseteq> post; 
+  \<Turnstile> P sat [pre', rely', guar', post']\<rbrakk>
+  \<Longrightarrow> \<Turnstile> P sat [pre, rely, guar, post]"
+apply(simp add:com_validity_def assum_def comm_def)
+apply clarify
+apply(erule_tac x=s in allE)
+apply(drule_tac c=x in subsetD)
+ apply force
+apply force
+done
+
+subsubsection {* Soundness of the system for sequential component programs *}
+
+theorem rgsound: 
+  "\<turnstile> P sat [pre, rely, guar, post] \<Longrightarrow> \<Turnstile> P sat [pre, rely, guar, post]"
+apply(erule rghoare.induct)
+ apply(force elim:Basic_sound)
+ apply(force elim:Seq_sound)
+ apply(force elim:Cond_sound)
+ apply(force elim:While_sound)
+ apply(force elim:Await_sound)
+apply(erule Conseq_sound,simp+)
+done     
+
+subsection {* Soundness of the System for Parallel Programs *}
+
+constdefs
+  ParallelCom :: "('a rgformula) list \<Rightarrow> 'a par_com"
+  "ParallelCom Ps \<equiv> map (Some \<circ> fst) Ps" 
+
+lemma two: 
+  "\<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);
+  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
+  \<forall>i<length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
+  length xs=length clist; x \<in> par_cp (ParallelCom xs) s; x\<in>par_assum(pre, rely);
+  \<forall>i<length clist. clist!i\<in>cp (Some(Com(xs!i))) s; x \<propto> clist \<rbrakk>
+  \<Longrightarrow> \<forall>j i. i<length clist \<and> Suc j<length x \<longrightarrow> (clist!i!j) -c\<rightarrow> (clist!i!Suc j) 
+  \<longrightarrow> (snd(clist!i!j), snd(clist!i!Suc j)) \<in> Guar(xs!i)"
+apply(unfold par_cp_def)
+--{* By contradiction: *}
+apply(subgoal_tac "True")
+ prefer 2
+ apply simp 
+apply(erule_tac Q="True" in contrapos_pp)
+apply simp
+apply(erule exE)
+--{* the first c-tran that does not satisfy the guarantee-condition is from @{text "\<sigma>_i"} at step @{text "m"}. *}
+apply(drule_tac n=j and P="\<lambda>j. \<exists>i. ?H i j" in Ex_first_occurrence)
+apply(erule exE)
+apply clarify
+--{* @{text "\<sigma>_i \<in> A(pre, rely_1)"} *}
+apply(subgoal_tac "take (Suc (Suc m)) (clist!i) \<in> assum(Pre(xs!i), Rely(xs!i))")
+--{* but this contradicts @{text "\<Turnstile> \<sigma>_i sat [pre_i,rely_i,guar_i,post_i]"} *}
+ 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)
+ apply(simp add:com_validity_def)
+ apply(erule_tac x=s in allE)
+ apply(simp add:cp_def comm_def)
+ apply(drule_tac c="take (Suc (Suc m)) (clist ! i)" in subsetD)
+  apply simp
+  apply(erule_tac x=i in allE, erule impE, assumption,erule conjE)
+  apply(erule takecptn_is_cptn)
+ apply simp
+ apply clarify
+ apply(erule_tac x=m and P="\<lambda>j. ?I j \<and> ?J j \<longrightarrow> ?H j" in allE)
+ apply (simp add:conjoin_def same_length_def)
+apply(simp add:assum_def)
+apply(rule conjI)
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow>  ?I j \<in>cp (?K j) (?J j)" in allE)
+ apply(simp add:cp_def par_assum_def)
+ apply(drule_tac c="s" in subsetD,simp)
+ apply simp
+apply clarify
+apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> ?M \<union> UNION (?S j) (?T j) \<subseteq>  (?L j)" in allE)
+apply simp
+apply(erule subsetD)
+apply simp
+apply(simp add:conjoin_def compat_label_def)
+apply clarify
+apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (?P j) \<or> ?Q j" in allE,simp)
+--{* each etran in @{text "\<sigma>_1[0\<dots>m]"} corresponds to  *}
+apply(erule disjE)
+--{* a c-tran in some @{text "\<sigma>_{ib}"}  *}
+ apply clarify
+ apply(case_tac "i=ib",simp)
+  apply(erule etran.elims,simp)
+ apply(erule_tac x="ib" and P="\<lambda>i. ?H i \<longrightarrow> (?I i) \<or> (?J i)" in allE,simp)
+ apply(erule disjE,arith)
+ apply(case_tac "ia=m",simp)
+  apply(erule etran.elims,simp)
+ apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (\<forall> i. ?P i j)" in allE)
+ apply(subgoal_tac "ia<m",simp)
+  prefer 2
+  apply arith
+ apply(erule_tac x=ib and P="\<lambda>j. (?I j, ?H j)\<in> ctran \<longrightarrow> (?P i j)" in allE,simp)
+ apply(simp add:same_state_def)
+ 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)
+ 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)
+ apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
+ apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
+ apply(erule_tac x="Suc ia" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+ apply(erule_tac x="Suc ia" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+ apply simp
+--{* or an e-tran in @{text "\<sigma>"}, 
+therefore it satisfies @{text "rely \<or> guar_{ib}"} *}
+apply (force simp add:par_assum_def same_state_def)
+done
+
+lemma three [rule_format]: 
+  "\<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);
+  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
+  \<forall>i<length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
+  length xs=length clist; x \<in> par_cp (ParallelCom xs) s; x\<in>par_assum(pre, rely);
+  \<forall>i<length clist. clist!i\<in>cp (Some(Com(xs!i))) s; x \<propto> clist \<rbrakk>
+  \<Longrightarrow> \<forall>j i. i<length clist \<and> Suc j<length x \<longrightarrow> (clist!i!j) -e\<rightarrow> (clist!i!Suc j) 
+  \<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))"
+apply(drule two)
+ apply simp_all
+apply clarify
+apply(simp add:conjoin_def compat_label_def)
+apply clarify
+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)
+apply(erule disjE)
+ prefer 2
+ apply(force simp add:same_state_def par_assum_def)
+apply clarify
+apply(case_tac "i=ia",simp)
+ apply(erule etran.elims,simp)
+apply(erule_tac x="ia" and P="\<lambda>i. ?H i \<longrightarrow> (?I i) \<or> (?J i)" in allE,simp)
+ apply(erule disjE,arith)
+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)
+apply(erule_tac x=ia and P="\<lambda>j. ?S j \<longrightarrow> (?I j, ?H j)\<in> ctran \<longrightarrow> (?P j)" in allE)
+apply(simp add:same_state_def)
+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)
+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)
+apply(erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
+apply(erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
+apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+apply simp
+done
+
+lemma four: 
+  "\<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);
+  (\<Union>j\<in>{j. j < length xs}. Guar (xs ! j)) \<subseteq> guar; pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i));
+  \<forall>i < length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
+  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>
+  \<Longrightarrow> (snd (x ! i), snd (x ! Suc i)) \<in> guar"
+apply(simp add: ParallelCom_def)
+apply(subgoal_tac "(map (Some \<circ> fst) xs)\<noteq>[]")
+ prefer 2
+ apply simp
+apply(frule rev_subsetD)
+ apply(erule one [THEN equalityD1])
+apply(erule subsetD)
+apply simp
+apply clarify
+apply(drule_tac pre=pre and rely=rely and  x=x and s=s and xs=xs and clist=clist in two)
+apply(assumption+)
+     apply(erule sym)
+    apply(simp add:ParallelCom_def)
+   apply assumption
+  apply(simp add:Com_def)
+ apply assumption
+apply(simp add:conjoin_def same_program_def)
+apply clarify
+apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in all_dupE)
+apply(erule_tac x="Suc i" and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in allE)
+apply(erule par_ctran.elims,simp)
+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)
+apply(erule_tac x=ia and P="\<lambda>j. ?S j \<longrightarrow> (?I j, ?H j)\<in> ctran \<longrightarrow> (?P j)" in allE)
+apply(rule_tac x=ia in exI)
+apply(simp add:same_state_def)
+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)
+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)
+apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE)
+apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in all_dupE,simp)
+apply(erule_tac x="Suc i" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+apply(erule mp)
+apply(subgoal_tac "r=fst(clist ! ia ! Suc i)",simp)
+apply(drule_tac i=ia in list_eq_if)
+back
+apply simp_all
+done
+
+lemma parcptn_not_empty [simp]:"[] \<notin> par_cptn"
+apply(force elim:par_cptn.elims)
+done
+
+lemma five: 
+  "\<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);
+  pre \<subseteq> (\<Inter>i\<in>{i. i < length xs}. Pre (xs ! i)); (\<Inter>i\<in>{i. i < length xs}. Post (xs ! i)) \<subseteq> post;
+  \<forall>i < length xs. \<Turnstile> Com (xs ! i) sat [Pre (xs ! i), Rely (xs ! i), Guar (xs ! i), Post (xs ! i)];
+  x \<in> par_cp (ParallelCom xs) s; x \<in> par_assum (pre, rely); All_None (fst (last x)) \<rbrakk>
+  \<Longrightarrow> snd (last x) \<in> post"
+apply(simp add: ParallelCom_def)
+apply(subgoal_tac "(map (Some \<circ> fst) xs)\<noteq>[]")
+ prefer 2
+ apply simp
+apply(frule rev_subsetD)
+ apply(erule one [THEN equalityD1])
+apply(erule subsetD)
+apply simp
+apply clarify
+apply(subgoal_tac "\<forall>i<length clist. clist!i\<in>assum(Pre(xs!i), Rely(xs!i))")
+ 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)
+ apply(simp add:com_validity_def)
+ apply(erule_tac x=s in allE)
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (?I j) \<in> cp (?J j) s" in allE,simp)
+ apply(drule_tac c="clist!i" in subsetD)
+  apply (force simp add:Com_def)
+ apply(simp add:comm_def conjoin_def same_program_def del:last.simps)
+ apply clarify
+ apply(erule_tac x="length x - 1" and P="\<lambda>j. ?H j \<longrightarrow> fst(?I j)=(?J j)" in allE)
+ apply (simp add:All_None_def same_length_def)
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> length(?J j)=(?K j)" in allE)
+ apply(subgoal_tac "length x - 1 < length x",simp)
+  apply(case_tac "x\<noteq>[]")
+   apply(drule last_length2,simp)
+   apply(erule_tac x="clist!i" in ballE)
+    apply(simp add:same_state_def)
+    apply(subgoal_tac "clist!i\<noteq>[]")
+     apply(drule_tac xs="clist!i" in last_length2,simp)
+    apply(case_tac x)
+     apply (force simp add:par_cp_def)
+    apply (force simp add:par_cp_def)
+   apply force
+  apply (force simp add:par_cp_def)
+ apply(case_tac x)
+  apply (force simp add:par_cp_def)
+ apply (force simp add:par_cp_def)
+apply clarify
+apply(simp add:assum_def)
+apply(rule conjI)
+ apply(simp add:conjoin_def same_state_def par_cp_def)
+ apply clarify
+ 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)
+ apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+ apply(case_tac x,simp+)
+ apply (simp add:par_assum_def)
+ apply clarify
+ apply(drule_tac c="snd (clist ! ia ! 0)" in subsetD)
+ apply assumption
+ apply simp
+apply clarify
+apply(erule_tac x=ia in all_dupE)
+apply simp
+apply(rule subsetD)
+ apply simp
+apply(erule_tac pre=pre and rely=rely and x=x and s=s in  three)
+ apply(erule_tac x=ic in allE,erule mp)
+ apply simp_all
+ apply(simp add:ParallelCom_def)
+ apply(force simp add:Com_def)
+apply(simp add:conjoin_def same_length_def)
+done
+
+lemma ParallelEmpty [rule_format]: 
+  "\<forall>i s. x \<in> par_cp (ParallelCom []) s \<longrightarrow> 
+  Suc i < length x \<longrightarrow> (x ! i, x ! Suc i) \<notin> par_ctran"
+apply(induct_tac x)
+ apply(simp add:par_cp_def ParallelCom_def)
+apply clarify
+apply(case_tac list,simp,simp)
+apply(case_tac i)
+ apply(simp add:par_cp_def ParallelCom_def)
+ apply(erule par_ctran.elims,simp)
+apply(simp add:par_cp_def ParallelCom_def)
+apply clarify
+apply(erule par_cptn.elims,simp)
+ apply simp
+apply(erule par_ctran.elims)
+back
+apply simp
+done
+
+theorem par_rgsound: 
+  "\<turnstile> c SAT [pre, rely, guar, post] \<Longrightarrow> \<Turnstile> (ParallelCom c) SAT [pre, rely, guar, post]"
+apply(erule par_rghoare.induct)
+apply(case_tac xs,simp)
+ apply(simp add:par_com_validity_def par_comm_def)
+ apply clarify
+ apply(case_tac "post=UNIV",simp)
+  apply clarify
+  apply(drule ParallelEmpty)
+   apply assumption
+  apply simp
+ apply clarify
+ apply simp
+apply(subgoal_tac "xs\<noteq>[]")
+ prefer 2
+ apply simp
+apply(thin_tac "xs = a # list")
+apply(simp add:par_com_validity_def par_comm_def)
+apply clarify
+apply(rule conjI)
+ apply clarify
+ apply(erule_tac pre=pre and rely=rely and guar=guar and x=x and s=s and xs=xs in four)
+        apply(assumption+)
+     apply clarify
+     apply (erule allE, erule impE, assumption,erule rgsound)
+    apply(assumption+)
+apply clarify
+apply(erule_tac pre=pre and rely=rely and post=post and x=x and s=s and xs=xs in five)
+      apply(assumption+)
+   apply clarify
+   apply (erule allE, erule impE, assumption,erule rgsound)
+  apply(assumption+) 
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/RG_Syntax.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/RG_Syntax.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,90 @@
+
+header {* \section{Concrete Syntax} *}
+
+theory RG_Syntax = Quote_Antiquote + RG_Hoare:
+
+syntax
+  "_Assign"    :: "idt \<Rightarrow> 'b \<Rightarrow> 'a com"                     ("(\<acute>_ :=/ _)" [70, 65] 61)
+  "_skip"      :: "'a com"                                  ("SKIP")
+  "_Seq"       :: "'a com \<Rightarrow> 'a com \<Rightarrow> 'a com"              ("(_;;/ _)" [60,61] 60)
+  "_Cond"      :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com \<Rightarrow> 'a com"   ("(0IF _/ THEN _/ ELSE _/FI)" [0, 0, 0] 61)
+  "_Cond2"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0IF _ THEN _ FI)" [0,0] 56)
+  "_While"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0WHILE _ /DO _ /OD)"  [0, 0] 61)
+  "_Await"     :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a com"             ("(0AWAIT _ /THEN /_ /END)"  [0,0] 61)
+  "_Atom"      :: "'a com \<Rightarrow> 'a com"                        ("(\<langle>_\<rangle>)" 61)
+  "_Wait"      :: "'a bexp \<Rightarrow> 'a com"                       ("(0WAIT _ END)" 61)
+
+translations
+  "\<acute>\<spacespace>x := a" \<rightharpoonup> "Basic \<guillemotleft>\<acute>\<spacespace>(_update_name x a)\<guillemotright>"
+  "SKIP" \<rightleftharpoons> "Basic id"
+  "c1;; c2" \<rightleftharpoons> "Seq c1 c2"
+  "IF b THEN c1 ELSE c2 FI" \<rightharpoonup> "Cond .{b}. c1 c2"
+  "IF b THEN c FI" \<rightleftharpoons> "IF b THEN c ELSE SKIP FI"
+  "WHILE b DO c OD" \<rightharpoonup> "While .{b}. c"
+  "AWAIT b THEN c END" \<rightleftharpoons> "Await .{b}. c"
+  "\<langle>c\<rangle>" \<rightleftharpoons> "AWAIT True THEN c END"
+  "WAIT b END" \<rightleftharpoons> "AWAIT b THEN SKIP END"
+
+nonterminals
+  prgs
+
+syntax
+  "_PAR"        :: "prgs \<Rightarrow> 'a"              ("COBEGIN//_//COEND" 60)
+  "_prg"        :: "'a \<Rightarrow> prgs"              ("_" 57)
+  "_prgs"       :: "['a, prgs] \<Rightarrow> prgs"      ("_//\<parallel>//_" [60,57] 57)
+
+translations
+  "_prg a" \<rightharpoonup> "[a]"
+  "_prgs a ps" \<rightharpoonup> "a # ps"
+  "_PAR ps" \<rightharpoonup> "ps"
+
+syntax
+  "_prg_scheme" :: "['a, 'a, 'a, 'a] \<Rightarrow> prgs"  ("SCHEME [_ \<le> _ < _] _" [0,0,0,60] 57)
+
+translations
+  "_prg_scheme j i k c" \<rightleftharpoons> "(map (\<lambda>i. c) [j..k(])"
+
+text {* Translations for variables before and after a transition: *}
+
+syntax 
+  "_before" :: "id \<Rightarrow> 'a" ("\<ordmasculine>_")
+  "_after"  :: "id \<Rightarrow> 'a" ("\<ordfeminine>_")
+ 
+translations
+  "\<ordmasculine>x" \<rightleftharpoons> "x \<acute>fst"
+  "\<ordfeminine>x" \<rightleftharpoons> "x \<acute>snd"
+
+print_translation {*
+  let
+    fun quote_tr' f (t :: ts) =
+          Term.list_comb (f $ Syntax.quote_tr' "_antiquote" t, ts)
+      | quote_tr' _ _ = raise Match;
+
+    val assert_tr' = quote_tr' (Syntax.const "_Assert");
+
+    fun bexp_tr' name ((Const ("Collect", _) $ t) :: ts) =
+          quote_tr' (Syntax.const name) (t :: ts)
+      | bexp_tr' _ _ = raise Match;
+
+    fun upd_tr' (x_upd, T) =
+      (case try (unsuffix RecordPackage.updateN) x_upd of
+        Some x => (x, if T = dummyT then T else Term.domain_type T)
+      | None => raise Match);
+
+    fun update_name_tr' (Free x) = Free (upd_tr' x)
+      | update_name_tr' ((c as Const ("_free", _)) $ Free x) =
+          c $ Free (upd_tr' x)
+      | update_name_tr' (Const x) = Const (upd_tr' x)
+      | update_name_tr' _ = raise Match;
+
+    fun assign_tr' (Abs (x, _, f $ t $ Bound 0) :: ts) =
+          quote_tr' (Syntax.const "_Assign" $ update_name_tr' f)
+            (Abs (x, dummyT, t) :: ts)
+      | assign_tr' _ = raise Match;
+  in
+    [("Collect", assert_tr'), ("Basic", assign_tr'),
+      ("Cond", bexp_tr' "_Cond"), ("While", bexp_tr' "_While_inv")]
+  end
+*}
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/RG_Tran.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/RG_Tran.thy	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,1076 @@
+
+header {* \section{Operational Semantics} *}
+
+theory RG_Tran = RG_Com:
+
+subsection {* Semantics of Component Programs *}
+
+subsubsection {* Environment transitions *}
+
+types 'a conf = "(('a com) option) \<times> 'a"
+
+consts etran    :: "('a conf \<times> 'a conf) set" 
+syntax  "_etran"  :: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"  ("_ -e\<rightarrow> _" [81,81] 80)
+translations  "P -e\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> etran"
+inductive etran
+intros
+  Env: "(P, s) -e\<rightarrow> (P, t)"
+
+subsubsection {* Component transitions *}
+
+consts ctran    :: "('a conf \<times> 'a conf) set"
+syntax
+  "_ctran"  :: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"   ("_ -c\<rightarrow> _" [81,81] 80)
+  "_ctran_*":: "'a conf \<Rightarrow> 'a conf \<Rightarrow> bool"   ("_ -c*\<rightarrow> _" [81,81] 80)
+translations
+  "P -c\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> ctran"
+  "P -c*\<rightarrow> Q" \<rightleftharpoons> "(P,Q) \<in> ctran^*"
+
+inductive  ctran 
+intros
+  Basic:  "(Some(Basic f), s) -c\<rightarrow> (None, f s)"
+
+  Seq1:   "(Some P0, s) -c\<rightarrow> (None, t) \<Longrightarrow> (Some(Seq P0 P1), s) -c\<rightarrow> (Some P1, t)"
+
+  Seq2:   "(Some P0, s) -c\<rightarrow> (Some P2, t) \<Longrightarrow> (Some(Seq P0 P1), s) -c\<rightarrow> (Some(Seq P2 P1), t)"
+
+  CondT: "s\<in>b  \<Longrightarrow> (Some(Cond b P1 P2), s) -c\<rightarrow> (Some P1, s)"
+  CondF: "s\<notin>b \<Longrightarrow> (Some(Cond b P1 P2), s) -c\<rightarrow> (Some P2, s)"
+
+  WhileF: "s\<notin>b \<Longrightarrow> (Some(While b P), s) -c\<rightarrow> (None, s)"
+  WhileT: "s\<in>b  \<Longrightarrow> (Some(While b P), s) -c\<rightarrow> (Some(Seq P (While b P)), s)"
+
+  Await:  "\<lbrakk>s\<in>b; (Some P, s) -c*\<rightarrow> (None, t)\<rbrakk> \<Longrightarrow> (Some(Await b P), s) -c\<rightarrow> (None, t)" 
+
+monos "rtrancl_mono"
+
+subsection {* Semantics of Parallel Programs *}
+
+types 'a par_conf = "('a par_com) \<times> 'a"
+consts
+  par_etran :: "('a par_conf \<times> 'a par_conf) set"
+  par_ctran :: "('a par_conf \<times> 'a par_conf) set"
+syntax
+  "_par_etran":: "['a par_conf,'a par_conf] \<Rightarrow> bool" ("_ -pe\<rightarrow> _" [81,81] 80)
+  "_par_ctran":: "['a par_conf,'a par_conf] \<Rightarrow> bool" ("_ -pc\<rightarrow> _" [81,81] 80)
+translations
+  "P -pe\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> par_etran"
+  "P -pc\<rightarrow> Q"  \<rightleftharpoons> "(P,Q) \<in> par_ctran"
+
+inductive  par_etran
+intros
+  ParEnv:  "(Ps, s) -pe\<rightarrow> (Ps, t)"
+
+inductive  par_ctran
+intros
+  ParComp: "\<lbrakk>i<length Ps; (Ps!i, s) -c\<rightarrow> (r, t)\<rbrakk> \<Longrightarrow> (Ps, s) -pc\<rightarrow> (Ps[i:=r], t)"
+
+subsection {* Computations *}
+
+subsubsection {* Sequential computations *}
+
+types 'a confs = "('a conf) list"
+consts cptn :: "('a confs) set"
+inductive  "cptn"
+intros
+  CptnOne: "[(P,s)] \<in> cptn"
+  CptnEnv: "(P, t)#xs \<in> cptn \<Longrightarrow> (P,s)#(P,t)#xs \<in> cptn"
+  CptnComp: "\<lbrakk>(P,s) -c\<rightarrow> (Q,t); (Q, t)#xs \<in> cptn \<rbrakk> \<Longrightarrow> (P,s)#(Q,t)#xs \<in> cptn"
+
+constdefs
+  cp :: "('a com) option \<Rightarrow> 'a \<Rightarrow> ('a confs) set"
+  "cp P s \<equiv> {l. l!0=(P,s) \<and> l \<in> cptn}"  
+
+subsubsection {* Parallel computations *}
+
+types  'a par_confs = "('a par_conf) list"
+consts par_cptn :: "('a par_confs) set"
+inductive  "par_cptn"
+intros
+  ParCptnOne: "[(P,s)] \<in> par_cptn"
+  ParCptnEnv: "(P,t)#xs \<in> par_cptn \<Longrightarrow> (P,s)#(P,t)#xs \<in> par_cptn"
+  ParCptnComp: "\<lbrakk> (P,s) -pc\<rightarrow> (Q,t); (Q,t)#xs \<in> par_cptn \<rbrakk> \<Longrightarrow> (P,s)#(Q,t)#xs \<in> par_cptn"
+
+constdefs
+  par_cp :: "'a par_com \<Rightarrow> 'a \<Rightarrow> ('a par_confs) set"
+  "par_cp P s \<equiv> {l. l!0=(P,s) \<and> l \<in> par_cptn}"  
+
+subsection{* Modular Definition of Computation *}
+
+constdefs 
+  lift :: "'a com \<Rightarrow> 'a conf \<Rightarrow> 'a conf"
+  "lift Q \<equiv> \<lambda>(P, s). (if P=None then (Some Q,s) else (Some(Seq (the P) Q), s))"
+
+consts  cptn_mod :: "('a confs) set"
+inductive  "cptn_mod"
+intros
+  CptnModOne: "[(P, s)] \<in> cptn_mod"
+  CptnModEnv: "(P, t)#xs \<in> cptn_mod \<Longrightarrow> (P, s)#(P, t)#xs \<in> cptn_mod"
+  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"
+  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"
+  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"
+  CptnModSeq1: "\<lbrakk>(Some P0, s)#xs \<in> cptn_mod; zs=map (lift P1) xs \<rbrakk>
+                 \<Longrightarrow> (Some(Seq P0 P1), s)#zs \<in> cptn_mod"
+  CptnModSeq2: 
+  "\<lbrakk>(Some P0, s)#xs \<in> cptn_mod; fst(last ((Some P0, s)#xs)) = None; 
+  (Some P1, snd(last ((Some P0, s)#xs)))#ys \<in> cptn_mod; 
+  zs=(map (lift P1) xs)@ys \<rbrakk> \<Longrightarrow> (Some(Seq P0 P1), s)#zs \<in> cptn_mod"
+
+  CptnModWhile1: 
+  "\<lbrakk> (Some P, s)#xs \<in> cptn_mod; s \<in> b; zs=map (lift (While b P)) xs \<rbrakk> 
+  \<Longrightarrow> (Some(While b P), s)#(Some(Seq P (While b P)), s)#zs \<in> cptn_mod"
+  CptnModWhile2: 
+  "\<lbrakk> (Some P, s)#xs \<in> cptn_mod; fst(last ((Some P, s)#xs))=None; s \<in> b; 
+  zs=(map (lift (While b P)) xs)@ys; 
+  (Some(While b P), snd(last ((Some P, s)#xs)))#ys \<in> cptn_mod\<rbrakk> 
+  \<Longrightarrow> (Some(While b P), s)#(Some(Seq P (While b P)), s)#zs \<in> cptn_mod"
+
+subsection {* Equivalence of Both Definitions.*}
+
+lemma last_length: "((a#xs)!(length xs))=last (a#xs)"
+apply simp
+apply(induct xs,simp+)
+apply(case_tac list)
+apply simp_all
+done
+
+lemma div_seq [rule_format]: "list \<in> cptn_mod \<Longrightarrow>
+ (\<forall>s P Q zs. list=(Some (Seq P Q), s)#zs \<longrightarrow>
+  (\<exists>xs. (Some P, s)#xs \<in> cptn_mod  \<and> (zs=(map (lift Q) xs) \<or>
+  ( fst(((Some P, s)#xs)!length xs)=None \<and> 
+  (\<exists>ys. (Some Q, snd(((Some P, s)#xs)!length xs))#ys \<in> cptn_mod  
+  \<and> zs=(map (lift (Q)) xs)@ys)))))"
+apply(erule cptn_mod.induct)
+apply simp_all
+    apply clarify
+    apply(force intro:CptnModOne)
+   apply clarify
+   apply(erule_tac x=Pa in allE)
+   apply(erule_tac x=Q in allE)
+   apply simp
+   apply clarify
+   apply(erule disjE)
+    apply(rule_tac x="(Some Pa,t)#xsa" in exI)
+    apply(rule conjI)
+     apply clarify
+     apply(erule CptnModEnv)
+    apply(rule disjI1)
+    apply(simp add:lift_def)
+   apply clarify
+   apply(rule_tac x="(Some Pa,t)#xsa" in exI)
+   apply(rule conjI)
+    apply(erule CptnModEnv)
+   apply(rule disjI2)
+   apply(rule conjI)
+    apply(case_tac xsa,simp,simp)
+   apply(rule_tac x="ys" in exI)
+   apply(rule conjI)
+    apply simp
+   apply(simp add:lift_def)
+  apply clarify
+  apply(erule ctran.elims,simp_all)
+ apply clarify
+ apply(rule_tac x="xs" in exI)
+ apply simp
+ apply clarify
+apply(rule_tac x="xs" in exI)
+apply(simp add: last_length)
+done
+
+lemma cptn_onlyif_cptn_mod_aux [rule_format]:
+  "\<forall>s Q t xs.((Some a, s), Q, t) \<in> ctran \<longrightarrow> (Q, t) # xs \<in> cptn_mod 
+  \<longrightarrow> (Some a, s) # (Q, t) # xs \<in> cptn_mod"
+apply(induct a)
+apply simp_all
+--{* basic *}
+apply clarify
+apply(erule ctran.elims,simp_all)
+apply(rule CptnModNone,rule Basic,simp)
+apply clarify
+apply(erule ctran.elims,simp_all)
+--{* Seq1 *}
+apply(rule_tac xs="[(None,ta)]" in CptnModSeq2)
+  apply(erule CptnModNone)
+  apply(rule CptnModOne)
+ apply simp
+apply simp
+apply(simp add:lift_def)
+--{* Seq2 *}
+apply(erule_tac x=sa in allE)
+apply(erule_tac x="Some P2" in allE)
+apply(erule allE,erule impE, assumption)
+apply(drule div_seq,simp)
+apply force
+apply clarify
+apply(erule disjE)
+ apply clarify
+ apply(erule allE,erule impE, assumption)
+ apply(erule_tac CptnModSeq1)
+ apply(simp add:lift_def)
+apply clarify 
+apply(erule allE,erule impE, assumption)
+apply(erule_tac CptnModSeq2)
+  apply (simp add:last_length)
+ apply (simp add:last_length)
+apply(simp add:lift_def)
+--{* Cond *}
+apply clarify
+apply(erule ctran.elims,simp_all)
+apply(force elim: CptnModCondT)
+apply(force elim: CptnModCondF)
+--{* While *}
+apply  clarify
+apply(erule ctran.elims,simp_all)
+apply(rule CptnModNone,erule WhileF,simp)
+apply(drule div_seq,force)
+apply clarify
+apply (erule disjE)
+ apply(force elim:CptnModWhile1)
+apply clarify
+apply(force simp add:last_length elim:CptnModWhile2)
+--{* await *}
+apply clarify
+apply(erule ctran.elims,simp_all)
+apply(rule CptnModNone,erule Await,simp+)
+done
+
+lemma cptn_onlyif_cptn_mod [rule_format]: "c \<in> cptn \<Longrightarrow> c \<in> cptn_mod"
+apply(erule cptn.induct)
+  apply(rule CptnModOne)
+ apply(erule CptnModEnv)
+apply(case_tac P)
+ apply simp
+ apply(erule ctran.elims,simp_all)
+apply(force elim:cptn_onlyif_cptn_mod_aux)
+done
+
+lemma lift_is_cptn: "c\<in>cptn \<Longrightarrow> map (lift P) c \<in> cptn"
+apply(erule cptn.induct)
+  apply(force simp add:lift_def CptnOne)
+ apply(force intro:CptnEnv simp add:lift_def)
+apply(force simp add:lift_def intro:CptnComp Seq2 Seq1 elim:ctran.elims)
+done
+
+lemma cptn_append_is_cptn [rule_format]: 
+ "\<forall>b a. b#c1\<in>cptn \<longrightarrow>  a#c2\<in>cptn \<longrightarrow> (b#c1)!length c1=a \<longrightarrow> b#c1@c2\<in>cptn"
+apply(induct c1)
+ apply simp
+apply clarify
+apply(erule cptn.elims,simp_all)
+ apply(force intro:CptnEnv)
+apply(force elim:CptnComp)
+done
+
+lemma last_lift: "\<lbrakk>xs\<noteq>[]; fst(xs!(length xs - (Suc 0)))=None\<rbrakk> 
+ \<Longrightarrow> fst((map (lift P) xs)!(length (map (lift P) xs)- (Suc 0)))=(Some P)"
+apply(case_tac "(xs ! (length xs - (Suc 0)))")
+apply (simp add:lift_def)
+done
+
+lemma last_fst [rule_format]: "P((a#x)!length x) \<longrightarrow> \<not>P a \<longrightarrow> P (x!(length x - (Suc 0)))" 
+apply(induct x,simp+)
+done
+
+lemma last_fst_esp: 
+ "fst(((Some a,s)#xs)!(length xs))=None \<Longrightarrow> fst(xs!(length xs - (Suc 0)))=None" 
+apply(erule last_fst)
+apply simp
+done
+
+lemma last_snd: "xs\<noteq>[] \<Longrightarrow> 
+  snd(((map (lift P) xs))!(length (map (lift P) xs) - (Suc 0)))=snd(xs!(length xs - (Suc 0)))"
+apply(case_tac "(xs ! (length xs - (Suc 0)))",simp)
+apply (simp add:lift_def)
+done
+
+lemma Cons_lift: "(Some (Seq P Q), s) # (map (lift Q) xs) = map (lift Q) ((Some P, s) # xs)"
+by(simp add:lift_def)
+
+lemma Cons_lift_append: 
+  "(Some (Seq P Q), s) # (map (lift Q) xs) @ ys = map (lift Q) ((Some P, s) # xs)@ ys "
+by(simp add:lift_def)
+
+lemma lift_nth: "i<length xs \<Longrightarrow> map (lift Q) xs ! i = lift Q  (xs! i)"
+by (simp add:lift_def)
+
+lemma snd_lift: "i< length xs \<Longrightarrow> snd(lift Q (xs ! i))= snd (xs ! i)"
+apply(case_tac "xs!i")
+apply(simp add:lift_def)
+done
+
+lemma cptn_if_cptn_mod: "c \<in> cptn_mod \<Longrightarrow> c \<in> cptn"
+apply(erule cptn_mod.induct)
+        apply(rule CptnOne)
+       apply(erule CptnEnv)
+      apply(erule CptnComp,simp)
+     apply(rule CptnComp)
+     apply(erule CondT,simp)
+    apply(rule CptnComp)
+    apply(erule CondF,simp)
+--{* Seq1 *}   
+apply(erule cptn.elims,simp_all)
+  apply(rule CptnOne)
+ apply clarify
+ apply(drule_tac P=P1 in lift_is_cptn)
+ apply(simp add:lift_def)
+ apply(rule CptnEnv,simp)
+apply clarify
+apply(simp add:lift_def)
+apply(rule conjI)
+ apply clarify
+ apply(rule CptnComp)
+  apply(rule Seq1,simp)
+ apply(drule_tac P=P1 in lift_is_cptn)
+ apply(simp add:lift_def)
+apply clarify
+apply(rule CptnComp)
+ apply(rule Seq2,simp)
+apply(drule_tac P=P1 in lift_is_cptn)
+apply(simp add:lift_def)
+--{* Seq2 *}
+apply(rule cptn_append_is_cptn)
+  apply(drule_tac P=P1 in lift_is_cptn)
+  apply(simp add:lift_def)
+ apply simp
+apply(case_tac "xs\<noteq>[]")
+ apply(drule_tac P=P1 in last_lift)
+  apply(rule last_fst_esp)
+  apply (simp add:last_length)
+ apply(simp add:Cons_lift del:map.simps)
+ apply(rule conjI, clarify, simp)
+ apply(case_tac "(((Some P0, s) # xs) ! length xs)")
+ apply clarify
+ apply (simp add:lift_def last_length)
+apply (simp add:last_length)
+--{* While1 *}
+apply(rule CptnComp)
+apply(rule WhileT,simp)
+apply(drule_tac P="While b P" in lift_is_cptn)
+apply(simp add:lift_def)
+--{* While2 *}
+apply(rule CptnComp)
+apply(rule WhileT,simp)
+apply(rule cptn_append_is_cptn)
+apply(drule_tac P="While b P" in lift_is_cptn)
+  apply(simp add:lift_def)
+ apply simp
+apply(case_tac "xs\<noteq>[]")
+ apply(drule_tac P="While b P" in last_lift)
+  apply(rule last_fst_esp,simp add:last_length)
+ apply(simp add:Cons_lift del:map.simps)
+ apply(rule conjI, clarify, simp)
+ apply(case_tac "(((Some P, s) # xs) ! length xs)")
+ apply clarify
+ apply (simp add:last_length lift_def)
+apply simp
+done
+
+theorem cptn_iff_cptn_mod: "(c \<in> cptn) = (c \<in> cptn_mod)"
+apply(rule iffI)
+ apply(erule cptn_onlyif_cptn_mod)
+apply(erule cptn_if_cptn_mod)
+done
+
+section {* Validity  of Correctness Formulas*}
+
+subsection {* Validity for Component Programs. *}
+
+types 'a rgformula = "'a com \<times> 'a set \<times> ('a \<times> 'a) set \<times> ('a \<times> 'a) set \<times> 'a set"
+
+constdefs
+  assum :: "('a set \<times> ('a \<times> 'a) set) \<Rightarrow> ('a confs) set"
+  "assum \<equiv> \<lambda>(pre, rely). {c. snd(c!0) \<in> pre \<and> (\<forall>i. Suc i<length c \<longrightarrow> 
+               c!i -e\<rightarrow> c!(Suc i) \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> rely)}"
+
+  comm :: "(('a \<times> 'a) set \<times> 'a set) \<Rightarrow> ('a confs) set"
+  "comm \<equiv> \<lambda>(guar, post). {c. (\<forall>i. Suc i<length c \<longrightarrow> 
+               c!i -c\<rightarrow> c!(Suc i) \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> guar) \<and> 
+               (fst (last c) = None \<longrightarrow> snd (last c) \<in> post)}"
+
+  com_validity :: "'a com \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set \<Rightarrow> bool" 
+                 ("\<Turnstile> _ sat [_, _, _, _]" [60,0,0,0,0] 45)
+  "\<Turnstile> P sat [pre, rely, guar, post] \<equiv> 
+   \<forall>s. cp (Some P) s \<inter> assum(pre, rely) \<subseteq> comm(guar, post)"
+
+subsection {* Validity for Parallel Programs. *}
+
+constdefs
+  All_None :: "(('a com) option) list \<Rightarrow> bool"
+  "All_None xs \<equiv> \<forall>c\<in>set xs. c=None"
+
+  par_assum :: "('a set \<times> ('a \<times> 'a) set) \<Rightarrow> ('a par_confs) set"
+  "par_assum \<equiv> \<lambda>(pre, rely). {c. snd(c!0) \<in> pre \<and> (\<forall>i. Suc i<length c \<longrightarrow> 
+             c!i -pe\<rightarrow> c!Suc i \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> rely)}"
+
+  par_comm :: "(('a \<times> 'a) set \<times> 'a set) \<Rightarrow> ('a par_confs) set"
+  "par_comm \<equiv> \<lambda>(guar, post). {c. (\<forall>i. Suc i<length c \<longrightarrow>   
+        c!i -pc\<rightarrow> c!Suc i \<longrightarrow> (snd(c!i), snd(c!Suc i)) \<in> guar) \<and> 
+         (All_None (fst (last c)) \<longrightarrow> snd( last c) \<in> post)}"
+
+  par_com_validity :: "'a  par_com \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a set
+                  \<Rightarrow> bool"  ("\<Turnstile> _ SAT [_, _, _, _]" [60,0,0,0,0] 45)
+  "\<Turnstile> Ps SAT [pre, rely, guar, post] \<equiv> 
+   \<forall>s. par_cp Ps s \<inter> par_assum(pre, rely) \<subseteq> par_comm(guar, post)"
+
+subsection {* Compositionality of the Semantics *}
+
+subsubsection {* Definition of the conjoin operator *}
+
+constdefs
+  same_length :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
+  "same_length c clist \<equiv> (\<forall>i<length clist. length(clist!i)=length c)"
+ 
+  same_state :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
+  "same_state c clist \<equiv> (\<forall>i <length clist. \<forall>j<length c. snd(c!j) = snd((clist!i)!j))"
+
+  same_program :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
+  "same_program c clist \<equiv> (\<forall>j<length c. fst(c!j) = map (\<lambda>x. fst(nth x j)) clist)"
+
+  compat_label :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"
+  "compat_label c clist \<equiv> (\<forall>j. Suc j<length c \<longrightarrow> 
+         (c!j -pc\<rightarrow> c!Suc j \<and> (\<exists>i<length clist. (clist!i)!j -c\<rightarrow> (clist!i)! Suc j \<and> 
+                              (\<forall>l<length clist. l\<noteq>i \<longrightarrow> (clist!l)!j -e\<rightarrow> (clist!l)! Suc j))) \<or> 
+         (c!j -pe\<rightarrow> c!Suc j \<and> (\<forall>i<length clist. (clist!i)!j -e\<rightarrow> (clist!i)! Suc j)))"
+
+  conjoin :: "'a par_confs \<Rightarrow> ('a confs) list \<Rightarrow> bool"  ("_ \<propto> _" [65,65] 64)
+  "c \<propto> clist \<equiv> (same_length c clist) \<and> (same_state c clist) \<and> (same_program c clist) \<and> (compat_label c clist)"
+
+subsubsection {* Some previous lemmas *}
+
+lemma list_eq_if [rule_format]: "\<forall>ys. xs=ys \<longrightarrow> (length xs = length ys) \<longrightarrow> (\<forall>i<length xs. xs!i=ys!i)"
+apply (induct xs)
+ apply simp
+apply clarify
+done
+
+lemma list_eq: "(length xs = length ys \<and> (\<forall>i<length xs. xs!i=ys!i)) = (xs=ys)"
+apply(rule iffI)
+ apply clarify
+ apply(erule nth_equalityI)
+ apply simp+
+done
+
+lemma nth_tl: "\<lbrakk> ys!0=a; ys\<noteq>[] \<rbrakk> \<Longrightarrow> ys=(a#(tl ys))"
+apply(case_tac ys)
+ apply simp+
+done
+
+lemma nth_tl_if [rule_format]: "ys\<noteq>[] \<longrightarrow> ys!0=a \<longrightarrow> P ys \<longrightarrow> P (a#(tl ys))"
+apply(induct ys)
+ apply simp+
+done
+
+lemma nth_tl_onlyif [rule_format]: "ys\<noteq>[] \<longrightarrow> ys!0=a \<longrightarrow> P (a#(tl ys)) \<longrightarrow> P ys"
+apply(induct ys)
+ apply simp+
+done
+
+lemma seq_not_eq1: "Seq c1 c2\<noteq>c1"
+apply(rule com.induct)
+apply simp_all
+apply clarify
+done
+
+lemma seq_not_eq2: "Seq c1 c2\<noteq>c2"
+apply(rule com.induct)
+apply simp_all
+apply clarify
+done
+
+lemma if_not_eq1: "Cond b c1 c2 \<noteq>c1"
+apply(rule com.induct)
+apply simp_all
+apply clarify
+done
+
+lemma if_not_eq2: "Cond b c1 c2\<noteq>c2"
+apply(rule com.induct)
+apply simp_all
+apply clarify
+done
+
+lemmas seq_and_if_not_eq [simp] = seq_not_eq1 seq_not_eq2 
+seq_not_eq1 [THEN not_sym] seq_not_eq2 [THEN not_sym] 
+if_not_eq1 if_not_eq2 if_not_eq1 [THEN not_sym] if_not_eq2 [THEN not_sym]
+
+lemma prog_not_eq_in_ctran_aux [rule_format]: "(P,s) -c\<rightarrow> (Q,t) \<Longrightarrow> (P\<noteq>Q)"
+apply(erule ctran.induct)
+apply simp_all
+done
+
+lemma prog_not_eq_in_ctran [simp]: "\<not> (P,s) -c\<rightarrow> (P,t)"
+apply clarify
+apply(drule prog_not_eq_in_ctran_aux)
+apply simp
+done
+
+lemma prog_not_eq_in_par_ctran_aux [rule_format]: "(P,s) -pc\<rightarrow> (Q,t) \<Longrightarrow> (P\<noteq>Q)"
+apply(erule par_ctran.induct)
+apply(drule prog_not_eq_in_ctran_aux)
+apply clarify
+apply(drule list_eq_if)
+ apply simp_all
+apply force
+done
+
+lemma prog_not_eq_in_par_ctran [simp]: "\<not> (P,s) -pc\<rightarrow> (P,t)"
+apply clarify
+apply(drule prog_not_eq_in_par_ctran_aux)
+apply simp
+done
+
+lemma tl_in_cptn: "\<lbrakk> a#xs \<in>cptn; xs\<noteq>[] \<rbrakk> \<Longrightarrow> xs\<in>cptn"
+apply(force elim:cptn.elims)
+done
+
+lemma tl_zero[rule_format]: "P (ys!Suc j) \<longrightarrow> Suc j<length ys \<longrightarrow> ys\<noteq>[] \<longrightarrow> P (tl(ys)!j)"
+apply(induct ys)
+ apply simp_all
+done
+
+subsection {* The Semantics is Compositional *}
+
+lemma aux_if [rule_format]: 
+  "\<forall>xs s clist. (length clist = length xs \<and> (\<forall>i<length xs. (xs!i,s)#clist!i \<in> cptn) 
+  \<and> ((xs, s)#ys \<propto> map (\<lambda>i. (fst i,s)#snd i) (zip xs clist)) 
+   \<longrightarrow> (xs, s)#ys \<in> par_cptn)"
+apply(induct ys)
+ apply(clarify)
+ apply(rule ParCptnOne)
+apply(clarify)
+apply(simp add:conjoin_def compat_label_def)
+apply clarify
+apply(erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (?P j \<or> ?Q j)" in all_dupE,simp)
+apply(erule disjE)
+--{* first step is a Component step *}
+ apply clarify 
+ apply simp
+ apply(subgoal_tac "a=(xs[i:=(fst(clist!i!0))])")
+  apply(subgoal_tac "b=snd(clist!i!0)",simp)
+   prefer 2
+   apply(simp add: same_state_def)
+   apply(erule_tac x=i in allE,erule impE,assumption, 
+         erule_tac x=1 and P="\<lambda>j. (?H j) \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+  prefer 2
+  apply(simp add:same_program_def)
+  apply(erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (fst (?s j))=(?t j)" in allE,simp)
+  apply(rule nth_equalityI,simp)
+  apply clarify
+  apply(case_tac "i=ia",simp,simp)
+  apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+  apply(drule_tac t=i in not_sym,simp)
+  apply(erule etran.elims,simp)
+ apply(rule ParCptnComp)
+  apply(erule ParComp,simp)
+--{* applying the induction hypothesis *}
+ apply(erule_tac x="xs[i := fst (clist ! i ! 0)]" in allE)
+ apply(erule_tac x="snd (clist ! i ! 0)" in allE)
+ apply(erule mp)
+ apply(rule_tac x="map tl clist" in exI,simp)
+ apply(rule conjI,clarify)
+  apply(case_tac "i=ia",simp)
+   apply(rule nth_tl_if)
+     apply(force simp add:same_length_def length_Suc_conv)
+    apply simp
+   apply(erule allE,erule impE,assumption,erule tl_in_cptn)
+   apply(force simp add:same_length_def length_Suc_conv)
+  apply(rule nth_tl_if)
+    apply(force simp add:same_length_def length_Suc_conv)
+   apply(simp add:same_state_def)
+   apply(erule_tac x=ia in allE, erule impE, assumption, 
+     erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+   apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+   apply(drule_tac t=i  in not_sym,simp)
+   apply(erule etran.elims,simp)
+  apply(erule allE,erule impE,assumption,erule tl_in_cptn)
+  apply(force simp add:same_length_def length_Suc_conv)
+ apply(simp add:same_length_def same_state_def)
+ apply(rule conjI)
+  apply clarify
+  apply(case_tac j,simp,simp)
+  apply(erule_tac x=ia in allE, erule impE, assumption,
+        erule_tac x="Suc(Suc nat)" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+  apply(force simp add:same_length_def length_Suc_conv)
+ apply(rule conjI)
+  apply(simp add:same_program_def)
+  apply clarify
+  apply(case_tac j,simp)
+   apply(rule nth_equalityI,simp)
+   apply clarify
+   apply(case_tac "i=ia",simp,simp)
+  apply(erule_tac x="Suc(Suc nat)" and P="\<lambda>j. ?H j \<longrightarrow> (fst (?s j))=(?t j)" in allE,simp)
+  apply(rule nth_equalityI,simp,simp)
+  apply(force simp add:length_Suc_conv)
+ apply(rule allI,rule impI)
+ apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (?I j \<or> ?J j)" in allE,simp)
+ apply(erule disjE) 
+  apply clarify
+  apply(rule_tac x=ia in exI,simp)
+  apply(case_tac "i=ia",simp)
+   apply(rule conjI)
+    apply(force simp add: length_Suc_conv)
+   apply clarify
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE,erule impE,assumption)
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE,erule impE,assumption)
+   apply simp
+   apply(case_tac j,simp)
+    apply(rule tl_zero)
+      apply(drule_tac t=l in not_sym,simp)
+      apply(erule_tac x=l in allE, erule impE, assumption, 
+            erule_tac x=1 and P="\<lambda>j.  (?H j) \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+      apply(force elim:etran.elims intro:Env)
+     apply force
+    apply force
+   apply simp
+   apply(rule tl_zero)
+     apply(erule tl_zero)
+      apply force
+     apply force
+    apply force
+   apply force
+  apply(rule conjI,simp)
+   apply(rule nth_tl_if)
+     apply force
+    apply(erule_tac x=ia  in allE, erule impE, assumption,
+          erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+    apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+    apply(drule_tac t=i  in not_sym,simp)
+    apply(erule etran.elims,simp)
+   apply(erule tl_zero)
+    apply force
+   apply force
+  apply clarify
+  apply(case_tac "i=l",simp)
+   apply(rule nth_tl_if)
+     apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+    apply simp
+   apply(erule_tac P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE,erule impE,assumption,erule impE,assumption)
+   apply(erule tl_zero,force)
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+   apply(rule nth_tl_if)
+     apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+    apply(erule_tac x=l  in allE, erule impE, assumption,
+          erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+    apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE,erule impE, assumption,simp)
+    apply(drule not_sym,erule impE,assumption )
+    apply(erule etran.elims,simp)
+   apply(rule tl_zero)
+    apply force
+   apply force
+  apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+ apply(rule disjI2)
+ apply(case_tac j,simp)
+  apply clarify
+  apply(rule tl_zero)
+    apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> ?I j\<in>etran" in allE,erule impE, assumption)
+    apply(case_tac "i=ia",simp,simp)
+    apply(erule_tac x=ia  in allE, erule impE, assumption,
+    erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+    apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE,erule impE, assumption,simp)
+    apply(drule not_sym,erule impE,assumption)
+    apply(force elim:etran.elims intro:Env)
+   apply force
+  apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+ apply simp
+ apply clarify
+ apply(rule tl_zero)
+   apply(rule tl_zero,force)
+    apply force
+   apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+  apply force
+ apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+--{* first step is an environmental step *}
+apply clarify
+apply(erule par_etran.elims)
+apply simp
+apply(rule ParCptnEnv)
+apply(erule_tac x="Ps" in allE)
+apply(erule_tac x="t" in allE)
+apply(erule mp)
+apply(rule_tac x="map tl clist" in exI,simp)
+apply(rule conjI)
+ apply clarify
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (?I ?s j) \<in> cptn" in allE,simp)
+ apply(erule cptn.elims)
+   apply(simp add:same_length_def)
+   apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+  apply(simp add:same_state_def)
+  apply(erule_tac x=i  in allE, erule impE, assumption,
+   erule_tac x=1 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> ?J j \<in>etran" in allE,simp)
+ apply(erule etran.elims,simp)
+apply(simp add:same_state_def same_length_def)
+apply(rule conjI,clarify)
+ apply(case_tac j,simp,simp)
+ apply(erule_tac x=i  in allE, erule impE, assumption,
+       erule_tac x="Suc(Suc nat)" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+ apply(rule tl_zero)
+   apply(simp)
+  apply force
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+apply(rule conjI)
+ apply(simp add:same_program_def)
+ apply clarify
+ apply(case_tac j,simp)
+  apply(rule nth_equalityI,simp)
+  apply clarify
+  apply simp
+ apply(erule_tac x="Suc(Suc nat)" and P="\<lambda>j. ?H j \<longrightarrow> (fst (?s j))=(?t j)" in allE,simp)
+ apply(rule nth_equalityI,simp,simp)
+ apply(force simp add:length_Suc_conv)
+apply(rule allI,rule impI)
+apply(erule_tac x="Suc j" and P="\<lambda>j. ?H j \<longrightarrow> (?I j \<or> ?J j)" in allE,simp)
+apply(erule disjE) 
+ apply clarify
+ apply(rule_tac x=i in exI,simp)
+ apply(rule conjI)
+  apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> ?J i \<in>etran" in allE, erule impE, assumption)
+  apply(erule etran.elims,simp)
+  apply(erule_tac x=i  in allE, erule impE, assumption,
+        erule_tac x=1 and P="\<lambda>j.  (?H j) \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+  apply(rule nth_tl_if)
+   apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+  apply simp
+ apply(erule tl_zero,force) 
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+ apply clarify
+ apply(erule_tac x=l and P="\<lambda>i. ?H i \<longrightarrow> ?J i \<in>etran" in allE, erule impE, assumption)
+ apply(erule etran.elims,simp)
+ apply(erule_tac x=l  in allE, erule impE, assumption,
+       erule_tac x=1 and P="\<lambda>j.  (?H j) \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+ apply(rule nth_tl_if)
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+  apply simp
+  apply(rule tl_zero,force)
+  apply force
+ apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+apply(rule disjI2)
+apply simp
+apply clarify
+apply(case_tac j,simp)
+ apply(rule tl_zero)
+   apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> ?J i \<in>etran" in allE, erule impE, assumption)
+   apply(erule_tac x=i and P="\<lambda>i. ?H i \<longrightarrow> ?J i \<in>etran" in allE, erule impE, assumption)
+   apply(force elim:etran.elims intro:Env)
+  apply force
+ apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+apply simp
+apply(rule tl_zero)
+  apply(rule tl_zero,force)
+   apply force
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+ apply force
+apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+done
+
+lemma less_Suc_0 [iff]: "(n < Suc 0) = (n = 0)"
+by auto
+
+lemma aux_onlyif [rule_format]: "\<forall>xs s. (xs, s)#ys \<in> par_cptn \<longrightarrow> 
+  (\<exists>clist. (length clist = length xs) \<and> 
+  (xs, s)#ys \<propto> map (\<lambda>i. (fst i,s)#(snd i)) (zip xs clist) \<and> 
+  (\<forall>i<length xs. (xs!i,s)#(clist!i) \<in> cptn))"
+apply(induct ys)
+ apply(clarify)
+ apply(rule_tac x="map (\<lambda>i. []) [0..length xs(]" in exI)
+ apply(simp add: conjoin_def same_length_def same_state_def same_program_def compat_label_def)
+ apply(rule conjI)
+  apply(rule nth_equalityI,simp,simp)
+ apply(force intro: cptn.intros)
+apply(clarify)
+apply(erule par_cptn.elims,simp)
+ apply simp
+ apply(erule_tac x="xs" in allE)
+ apply(erule_tac x="t" in allE,simp)
+ apply clarify
+ apply(rule_tac x="(map (\<lambda>j. (P!j, t)#(clist!j)) [0..length P(])" in exI,simp)
+ apply(rule conjI)
+  prefer 2
+  apply clarify
+  apply(rule CptnEnv,simp)
+ apply(simp add:conjoin_def same_length_def same_state_def)
+ apply (rule conjI)
+  apply clarify
+  apply(case_tac j,simp,simp)
+ apply(rule conjI)
+  apply(simp add:same_program_def)
+  apply clarify
+  apply(case_tac j,simp)
+   apply(rule nth_equalityI,simp,simp)
+  apply simp
+  apply(rule nth_equalityI,simp,simp)
+ apply(simp add:compat_label_def)
+ apply clarify
+ apply(case_tac j,simp)
+  apply(simp add:ParEnv)
+  apply clarify
+  apply(simp add:Env)
+ apply simp
+ apply(erule_tac x=nat in allE,erule impE, assumption)
+ apply(erule disjE,simp)
+  apply clarify
+  apply(rule_tac x=i in exI,simp)
+ apply force
+apply(erule par_ctran.elims,simp)
+apply(erule_tac x="Ps[i:=r]" in allE)
+apply(erule_tac x="ta" in allE,simp)
+apply clarify
+apply(rule_tac x="(map (\<lambda>j. (Ps!j, ta)#(clist!j)) [0..length Ps(]) [i:=((r, ta)#(clist!i))]" in exI,simp)
+apply(rule conjI)
+ prefer 2
+ apply clarify
+ apply(case_tac "i=ia",simp)
+  apply(erule CptnComp)
+  apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (?I j \<in> cptn)" in allE,simp)
+ apply simp
+ apply(erule_tac x=ia in allE)
+ apply(rule CptnEnv,simp)
+apply(simp add:conjoin_def)
+apply (rule conjI)
+ apply(simp add:same_length_def)
+ apply clarify
+ apply(case_tac "i=ia",simp,simp)
+apply(rule conjI)
+ apply(simp add:same_state_def)
+ apply clarify
+ apply(case_tac j,simp,simp)
+ apply(case_tac "i=ia",simp,simp)
+apply(rule conjI)
+ apply(simp add:same_program_def)
+ apply clarify
+ apply(case_tac j,simp)
+  apply(rule nth_equalityI,simp,simp)
+ apply simp
+ apply(rule nth_equalityI,simp,simp)
+ apply(erule_tac x=nat and P="\<lambda>j. ?H j \<longrightarrow> (fst (?a j))=((?b j))" in allE)
+ apply(case_tac nat)
+  apply clarify
+  apply(case_tac "i=ia",simp,simp)
+ apply clarify
+ apply(case_tac "i=ia",simp,simp)
+apply(simp add:compat_label_def)
+apply clarify
+apply(case_tac j)
+ apply(rule conjI,simp)
+  apply(erule ParComp,assumption)
+  apply clarify
+  apply(rule_tac x=i in exI,simp)
+ apply clarify
+ apply(drule not_sym,simp)
+ apply(rule Env)
+apply simp
+apply(erule_tac x=nat and P="\<lambda>j. ?H j \<longrightarrow> (?P j \<or> ?Q j)" in allE,simp)
+apply(erule disjE)
+ apply clarify
+ apply(rule_tac x=ia in exI,simp)
+ apply(rule conjI)
+  apply(case_tac "i=ia",simp,simp)
+  apply(rotate_tac -1,simp)
+ apply clarify
+ apply(case_tac "i=l",simp)
+  apply(case_tac "l=ia",simp,simp)
+  apply(erule_tac x=l in allE,erule impE,assumption,erule impE, assumption,simp)
+ apply simp
+ apply(erule_tac x=l in allE,erule impE,assumption,erule impE, assumption,simp)
+apply clarify
+apply(erule_tac x=ia and P="\<lambda>j. ?H j \<longrightarrow> (?P j)\<in>etran" in allE, erule impE, assumption)
+apply(case_tac "i=ia",simp)
+apply(rotate_tac -1,simp)
+done
+
+lemma one_iff_aux: "xs\<noteq>[] \<Longrightarrow> (\<forall>ys. ((xs, s)#ys \<in> par_cptn) = 
+ (\<exists>clist. length clist= length xs \<and> 
+ ((xs, s)#ys \<propto> map (\<lambda>i. (fst i,s)#(snd i)) (zip xs clist)) \<and> 
+ (\<forall>i<length xs. (xs!i,s)#(clist!i) \<in> cptn))) = 
+ (par_cp (xs) s = {c. \<exists>clist. (length clist)=(length xs) \<and>
+ (\<forall>i<length clist. (clist!i) \<in> cp(xs!i) s) \<and> c \<propto> clist})" 
+apply (rule iffI)
+ apply(rule subset_antisym)
+  apply(rule subsetI) 
+  apply(clarify)
+  apply(simp add:par_cp_def cp_def)
+  apply(case_tac x)
+   apply(force elim:par_cptn.elims)
+  apply simp
+  apply(erule_tac x="list" in allE)
+  apply clarify
+  apply simp
+  apply(rule_tac x="map (\<lambda>i. (fst i, s) # snd i) (zip xs clist)" in exI,simp)
+ apply(rule subsetI) 
+ apply(clarify)
+ apply(case_tac x)
+  apply(erule_tac x=0 in allE)
+  apply(simp add:cp_def conjoin_def same_length_def same_program_def same_state_def compat_label_def)
+  apply clarify
+  apply(erule cptn.elims,force,force,force)
+ apply(simp add:par_cp_def conjoin_def  same_length_def same_program_def same_state_def compat_label_def)
+ apply clarify
+ apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in all_dupE)
+ apply(subgoal_tac "a = xs")
+  apply(subgoal_tac "b = s",simp)
+   prefer 3
+   apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (fst (?s j))=((?t j))" in allE)
+   apply (simp add:cp_def)
+   apply(rule nth_equalityI,simp,simp)
+  prefer 2
+  apply(erule_tac x=0 in allE)
+  apply (simp add:cp_def)
+  apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (\<forall>i. ?T i \<longrightarrow> (snd (?d j i))=(snd (?e j i)))" in allE,simp)
+  apply(erule_tac x=0 and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+ apply(erule_tac x=list in allE)
+ apply(rule_tac x="map tl clist" in exI,simp) 
+ apply(rule conjI)
+  apply clarify
+  apply(case_tac j,simp)
+   apply(erule_tac x=i  in allE, erule impE, assumption,
+        erule_tac x="0" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE,simp)
+  apply(erule_tac x=i  in allE, erule impE, assumption,
+        erule_tac x="Suc nat" and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+  apply(case_tac "clist!i",simp,simp)
+ apply(rule conjI)
+  apply clarify
+  apply(rule nth_equalityI,simp,simp)
+  apply(case_tac j)
+   apply clarify
+   apply(erule_tac x=i in allE)
+   apply(simp add:cp_def)
+  apply clarify
+  apply simp
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+  apply(case_tac "clist!i",simp,simp)
+ apply(thin_tac "?H = (\<exists>i. ?J i)")
+ apply(rule conjI)
+  apply clarify
+  apply(erule_tac x=j in allE,erule impE, assumption,erule disjE)
+   apply clarify
+   apply(rule_tac x=i in exI,simp)
+   apply(case_tac j,simp)
+    apply(rule conjI)
+     apply(erule_tac x=i in allE)
+     apply(simp add:cp_def)
+     apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+     apply(case_tac "clist!i",simp,simp)
+    apply clarify
+    apply(erule_tac x=l in allE)
+    apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+    apply clarify
+    apply(simp add:cp_def)
+    apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+    apply(case_tac "clist!l",simp,simp)
+   apply simp
+   apply(rule conjI)
+    apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+    apply(case_tac "clist!i",simp,simp)
+   apply clarify
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+   apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+   apply(case_tac "clist!l",simp,simp)
+  apply clarify
+  apply(erule_tac x=i in allE)
+  apply(simp add:cp_def)
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+  apply(case_tac "clist!i",simp)
+  apply(rule nth_tl_if,simp,simp)
+  apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (?P j)\<in>etran" in allE, erule impE, assumption,simp)
+  apply(simp add:cp_def)
+  apply clarify
+  apply(rule nth_tl_if)
+   apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+   apply(case_tac "clist!i",simp,simp)
+  apply force
+ apply force
+apply clarify
+apply(rule iffI)
+ apply(simp add:par_cp_def)
+ apply(erule_tac c="(xs, s) # ys" in equalityCE)
+  apply simp
+  apply clarify
+  apply(rule_tac x="map tl clist" in exI)
+  apply simp
+  apply (rule conjI)
+   apply(simp add:conjoin_def cp_def)
+   apply(rule conjI)
+    apply clarify
+    apply(unfold same_length_def)
+    apply clarify
+    apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,simp)
+   apply(rule conjI)
+    apply(simp add:same_state_def)
+    apply clarify
+    apply(erule_tac x=i in allE, erule impE, assumption,
+       erule_tac x=j and P="\<lambda>j. ?H j \<longrightarrow> (snd (?d j))=(snd (?e j))" in allE)
+    apply(case_tac j,simp)
+    apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+    apply(case_tac "clist!i",simp,simp)
+   apply(rule conjI)
+    apply(simp add:same_program_def)
+    apply clarify
+    apply(rule nth_equalityI,simp,simp)
+    apply(case_tac j,simp)
+    apply clarify
+    apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+    apply(case_tac "clist!i",simp,simp)
+   apply clarify
+   apply(simp add:compat_label_def)
+   apply(rule allI,rule impI)
+   apply(erule_tac x=j in allE,erule impE, assumption)
+   apply(erule disjE)
+    apply clarify
+    apply(rule_tac x=i in exI,simp)
+    apply(rule conjI)
+     apply(erule_tac x=i in allE)
+     apply(case_tac j,simp)
+      apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+      apply(case_tac "clist!i",simp,simp)
+     apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+     apply(case_tac "clist!i",simp,simp)
+    apply clarify
+    apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> ?I j \<longrightarrow> ?J j" in allE)
+    apply(erule_tac x=l and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE)
+    apply(case_tac "clist!l",simp,simp)
+    apply(erule_tac x=l in allE,simp)
+   apply(rule disjI2)
+   apply clarify
+   apply(rule tl_zero)
+     apply(case_tac j,simp,simp)
+     apply(rule tl_zero,force)   
+      apply force
+     apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+    apply force
+   apply(erule_tac x=i and P="\<lambda>j. ?H j \<longrightarrow> (length (?s j) = ?t)" in allE,force)
+  apply clarify
+  apply(erule_tac x=i in allE)
+  apply(simp add:cp_def)
+  apply(rule nth_tl_if)
+    apply(simp add:conjoin_def)
+    apply clarify
+    apply(simp add:same_length_def)
+    apply(erule_tac x=i in allE,simp)
+   apply simp
+  apply simp
+ apply simp
+apply clarify
+apply(erule_tac c="(xs, s) # ys" in equalityCE)
+ apply(simp add:par_cp_def)
+apply simp
+apply(erule_tac x="map (\<lambda>i. (fst i, s) # snd i) (zip xs clist)" in allE)
+apply simp
+apply clarify
+apply(simp add:cp_def)
+done
+
+theorem one: "xs\<noteq>[] \<Longrightarrow> 
+ par_cp xs s = {c. \<exists>clist. (length clist)=(length xs) \<and> 
+               (\<forall>i<length clist. (clist!i) \<in> cp(xs!i) s) \<and> c \<propto> clist}"
+apply(frule one_iff_aux)
+apply(drule sym)
+apply(erule iffD2)
+apply clarify
+apply(rule iffI)
+ apply(erule aux_onlyif)
+apply clarify
+apply(force intro:aux_if)
+done
+
+end
\ No newline at end of file
diff -r 98f0a09a33c3 -r 791e3b4c4039 src/HOL/HoareParallel/ROOT.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/HoareParallel/ROOT.ML	Tue Mar 05 17:11:25 2002 +0100
@@ -0,0 +1,5 @@
+
+time_use_thy "OG_Examples";
+time_use_thy "Gar_Coll";
+time_use_thy "Mul_Gar_Coll";
+time_use_thy "RG_Examples";