conversion of UNITY to Isar scripts
authorpaulson
Mon Mar 28 16:19:56 2005 +0200 (2005-03-28)
changeset 15634bca33c49b083
parent 15633 741deccec4e3
child 15635 8408a06590a6
conversion of UNITY to Isar scripts
src/ZF/IsaMakefile
src/ZF/UNITY/ClientImpl.thy
src/ZF/UNITY/Constrains.ML
src/ZF/UNITY/Constrains.thy
src/ZF/UNITY/GenPrefix.ML
src/ZF/UNITY/GenPrefix.thy
src/ZF/UNITY/Mutex.ML
src/ZF/UNITY/Mutex.thy
src/ZF/UNITY/SubstAx.ML
src/ZF/UNITY/SubstAx.thy
src/ZF/UNITY/WFair.ML
src/ZF/UNITY/WFair.thy
     1.1 --- a/src/ZF/IsaMakefile	Sat Mar 26 18:20:29 2005 +0100
     1.2 +++ b/src/ZF/IsaMakefile	Mon Mar 28 16:19:56 2005 +0200
     1.3 @@ -115,15 +115,13 @@
     1.4  ZF-UNITY: ZF $(LOG)/ZF-UNITY.gz
     1.5  
     1.6  $(LOG)/ZF-UNITY.gz: $(OUT)/ZF UNITY/ROOT.ML \
     1.7 -  UNITY/Comp.thy UNITY/Constrains.ML UNITY/Constrains.thy \
     1.8 -  UNITY/FP.thy UNITY/Guar.thy \
     1.9 -  UNITY/Mutex.ML UNITY/Mutex.thy UNITY/State.thy \
    1.10 -  UNITY/SubstAx.ML UNITY/SubstAx.thy UNITY/UNITY.thy UNITY/Union.thy \
    1.11 +  UNITY/Comp.thy UNITY/Constrains.thy UNITY/FP.thy\
    1.12 +  UNITY/GenPrefix.thy UNITY/Guar.thy UNITY/Mutex.thy UNITY/State.thy \
    1.13 +  UNITY/SubstAx.thy UNITY/UNITY.thy UNITY/Union.thy \
    1.14    UNITY/AllocBase.thy UNITY/AllocImpl.thy\
    1.15    UNITY/ClientImpl.thy UNITY/Distributor.thy\
    1.16    UNITY/Follows.thy UNITY/Increasing.thy UNITY/Merge.thy\
    1.17 -  UNITY/Monotonicity.thy UNITY/MultisetSum.thy\
    1.18 -  UNITY/WFair.ML UNITY/WFair.thy
    1.19 +  UNITY/Monotonicity.thy UNITY/MultisetSum.thy UNITY/WFair.thy
    1.20  	@$(ISATOOL) usedir $(OUT)/ZF UNITY
    1.21  
    1.22  
     2.1 --- a/src/ZF/UNITY/ClientImpl.thy	Sat Mar 26 18:20:29 2005 +0100
     2.2 +++ b/src/ZF/UNITY/ClientImpl.thy	Mon Mar 28 16:19:56 2005 +0200
     2.3 @@ -9,13 +9,6 @@
     2.4  
     2.5  theory ClientImpl = AllocBase + Guar:
     2.6  
     2.7 -(*move to Constrains.thy when the latter is converted to Isar format*)
     2.8 -method_setup constrains = {*
     2.9 -    Method.ctxt_args (fn ctxt =>
    2.10 -        Method.METHOD (fn facts =>
    2.11 -            gen_constrains_tac (local_clasimpset_of ctxt) 1)) *}
    2.12 -    "for proving safety properties"
    2.13 -
    2.14  consts
    2.15    ask :: i (* input history:  tokens requested *)
    2.16    giv :: i (* output history: tokens granted *)
     3.1 --- a/src/ZF/UNITY/Constrains.ML	Sat Mar 26 18:20:29 2005 +0100
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,461 +0,0 @@
     3.4 -(*  Title:      ZF/UNITY/Constrains.ML
     3.5 -    ID:         $Id \\<in> Constrains.ML,v 1.10 2003/06/20 10:10:45 paulson Exp $
     3.6 -    Author:     Sidi O Ehmety, Computer Laboratory
     3.7 -    Copyright   2001  University of Cambridge
     3.8 -
     3.9 -Safety relations \\<in> restricted to the set of reachable states.
    3.10 -
    3.11 -Proofs ported from HOL.
    3.12 -*)
    3.13 -
    3.14 -(*** traces and reachable ***)
    3.15 -
    3.16 -Goal  "reachable(F) <= state";
    3.17 -by (cut_inst_tac [("F", "F")] Init_type 1);
    3.18 -by (cut_inst_tac [("F", "F")] Acts_type 1);
    3.19 -by (cut_inst_tac [("F", "F")] reachable.dom_subset 1);
    3.20 -by (Blast_tac 1);
    3.21 -qed "reachable_type";
    3.22 -
    3.23 -Goalw [st_set_def] "st_set(reachable(F))";
    3.24 -by (rtac reachable_type 1);
    3.25 -qed "st_set_reachable";
    3.26 -AddIffs [st_set_reachable];
    3.27 -
    3.28 -Goal "reachable(F) Int state = reachable(F)";
    3.29 -by (cut_facts_tac [reachable_type] 1);
    3.30 -by Auto_tac;
    3.31 -qed "reachable_Int_state";
    3.32 -AddIffs [reachable_Int_state];
    3.33 -
    3.34 -Goal "state Int reachable(F) = reachable(F)";
    3.35 -by (cut_facts_tac [reachable_type] 1);
    3.36 -by Auto_tac;
    3.37 -qed "state_Int_reachable";
    3.38 -AddIffs [state_Int_reachable];
    3.39 -
    3.40 -Goal 
    3.41 -"F \\<in> program ==> reachable(F)={s \\<in> state. \\<exists>evs. <s,evs>:traces(Init(F), Acts(F))}";
    3.42 -by (rtac equalityI 1);
    3.43 -by Safe_tac;
    3.44 -by (blast_tac (claset() addDs [reachable_type RS subsetD]) 1);
    3.45 -by (etac traces.induct 2);
    3.46 -by (etac reachable.induct 1);
    3.47 -by (ALLGOALS (blast_tac (claset() addIs reachable.intrs @ traces.intrs)));
    3.48 -qed "reachable_equiv_traces";
    3.49 -
    3.50 -Goal "Init(F) <= reachable(F)";
    3.51 -by (blast_tac (claset() addIs reachable.intrs) 1);
    3.52 -qed "Init_into_reachable";
    3.53 -
    3.54 -Goal "[| F \\<in> program; G \\<in> program; \
    3.55 -\   Acts(G) <= Acts(F)  |] ==> G \\<in> stable(reachable(F))";
    3.56 -by (blast_tac (claset() 
    3.57 -   addIs [stableI, constrainsI, st_setI,
    3.58 -          reachable_type RS subsetD] @ reachable.intrs) 1);
    3.59 -qed "stable_reachable";
    3.60 -
    3.61 -AddSIs [stable_reachable];
    3.62 -Addsimps [stable_reachable];
    3.63 -
    3.64 -(*The set of all reachable states is an invariant...*)
    3.65 -Goalw [invariant_def, initially_def]
    3.66 -   "F \\<in> program ==> F \\<in> invariant(reachable(F))";
    3.67 -by (blast_tac (claset() addIs [reachable_type RS subsetD]@reachable.intrs) 1);
    3.68 -qed "invariant_reachable";
    3.69 -
    3.70 -(*...in fact the strongest invariant!*)
    3.71 -Goal "F \\<in> invariant(A) ==> reachable(F) <= A";
    3.72 -by (cut_inst_tac [("F", "F")] Acts_type 1);
    3.73 -by (cut_inst_tac [("F", "F")] Init_type 1);
    3.74 -by (cut_inst_tac [("F", "F")] reachable_type 1);
    3.75 -by (full_simp_tac (simpset() addsimps [stable_def, constrains_def, 
    3.76 -                                       invariant_def, initially_def]) 1);
    3.77 -by (rtac subsetI 1);
    3.78 -by (etac reachable.induct 1);
    3.79 -by (REPEAT (blast_tac (claset()  addIs reachable.intrs) 1));
    3.80 -qed "invariant_includes_reachable";
    3.81 -
    3.82 -(*** Co ***)
    3.83 -
    3.84 -Goal "F \\<in> B co B'==>F:(reachable(F) Int B) co (reachable(F) Int B')";
    3.85 -by (forward_tac [constrains_type RS subsetD] 1);
    3.86 -by (forward_tac [[asm_rl, asm_rl, subset_refl] MRS stable_reachable] 1);
    3.87 -by (ALLGOALS(asm_full_simp_tac (simpset() addsimps [stable_def, constrains_Int])));
    3.88 -qed "constrains_reachable_Int";
    3.89 -
    3.90 -(*Resembles the previous definition of Constrains*)
    3.91 -Goalw [Constrains_def]
    3.92 -"A Co B = {F \\<in> program. F:(reachable(F) Int A) co (reachable(F)  Int  B)}";
    3.93 -by (blast_tac (claset() addDs [constrains_reachable_Int, 
    3.94 -                                      constrains_type RS subsetD]
    3.95 -                        addIs [constrains_weaken]) 1);
    3.96 -qed "Constrains_eq_constrains";
    3.97 -val Constrains_def2 =  Constrains_eq_constrains RS  eq_reflection;
    3.98 -
    3.99 -Goalw [Constrains_def] 
   3.100 - "F \\<in> A co A' ==> F \\<in> A Co A'";
   3.101 -by (blast_tac (claset() addIs [constrains_weaken_L] addDs [constrainsD2]) 1);
   3.102 -qed "constrains_imp_Constrains";
   3.103 -
   3.104 -val prems = Goalw [Constrains_def, constrains_def, st_set_def]
   3.105 -"[|(!!act s s'. [| act \\<in> Acts(F); <s,s'>:act; s \\<in> A |] ==> s':A'); F \\<in> program|]==>F \\<in> A Co A'";
   3.106 -by (auto_tac (claset(), simpset() addsimps prems));
   3.107 -by (blast_tac (claset() addDs [reachable_type RS subsetD]) 1);
   3.108 -qed "ConstrainsI";
   3.109 -
   3.110 -Goalw [Constrains_def] 
   3.111 - "A Co B <= program";
   3.112 -by (Blast_tac 1);
   3.113 -qed "Constrains_type";
   3.114 -
   3.115 -Goal "F \\<in> 0 Co B <-> F \\<in> program";
   3.116 -by (auto_tac (claset() addDs [Constrains_type RS subsetD]
   3.117 -                       addIs [constrains_imp_Constrains], simpset()));
   3.118 -qed "Constrains_empty";
   3.119 -AddIffs [Constrains_empty];
   3.120 -
   3.121 -Goalw [Constrains_def] "F \\<in> A Co state <-> F \\<in> program";
   3.122 -by (auto_tac (claset() addDs [Constrains_type RS subsetD]
   3.123 -                       addIs [constrains_imp_Constrains], simpset()));
   3.124 -qed "Constrains_state";
   3.125 -AddIffs [Constrains_state];
   3.126 -
   3.127 -Goalw  [Constrains_def2] 
   3.128 -        "[| F \\<in> A Co A'; A'<=B' |] ==> F \\<in> A Co B'";
   3.129 -by (blast_tac (claset()  addIs [constrains_weaken_R]) 1);
   3.130 -qed "Constrains_weaken_R";
   3.131 -
   3.132 -Goalw  [Constrains_def2] 
   3.133 -    "[| F \\<in> A Co A'; B<=A |] ==> F \\<in> B Co A'";
   3.134 -by (blast_tac (claset() addIs [constrains_weaken_L, st_set_subset]) 1);
   3.135 -qed "Constrains_weaken_L";  
   3.136 -
   3.137 -Goalw [Constrains_def2]
   3.138 -   "[| F \\<in> A Co A'; B<=A; A'<=B' |] ==> F \\<in> B Co B'";
   3.139 -by (blast_tac (claset() addIs [constrains_weaken, st_set_subset]) 1);
   3.140 -qed "Constrains_weaken";
   3.141 -
   3.142 -(** Union **)
   3.143 -Goalw [Constrains_def2] 
   3.144 -"[| F \\<in> A Co A'; F \\<in> B Co B' |] ==> F \\<in> (A Un B) Co (A' Un B')";
   3.145 -by Auto_tac;
   3.146 -by (asm_full_simp_tac (simpset() addsimps [Int_Un_distrib]) 1);
   3.147 -by (blast_tac (claset() addIs [constrains_Un]) 1);
   3.148 -qed "Constrains_Un";
   3.149 -
   3.150 -val [major, minor] = Goalw [Constrains_def2]
   3.151 -"[|(!!i. i \\<in> I==>F \\<in> A(i) Co A'(i)); F \\<in> program|] ==> F:(\\<Union>i \\<in> I. A(i)) Co (\\<Union>i \\<in> I. A'(i))";
   3.152 -by (cut_facts_tac [minor] 1);
   3.153 -by (auto_tac (claset() addDs [major]
   3.154 -                       addIs [constrains_UN],
   3.155 -              simpset() delsimps UN_simps addsimps [Int_UN_distrib]));
   3.156 -qed "Constrains_UN";
   3.157 -
   3.158 -(** Intersection **)
   3.159 -
   3.160 -Goalw [Constrains_def]
   3.161 -"[| F \\<in> A Co A'; F \\<in> B Co B'|]==> F:(A Int B) Co (A' Int B')";
   3.162 -by (subgoal_tac "reachable(F) Int (A Int B) = \
   3.163 -              \ (reachable(F) Int A) Int (reachable(F) Int B)" 1);
   3.164 -by (ALLGOALS(force_tac (claset() addIs [constrains_Int], simpset())));
   3.165 -qed "Constrains_Int";
   3.166 -
   3.167 -val [major,minor] = Goal 
   3.168 -"[| (!!i. i \\<in> I ==>F \\<in> A(i) Co A'(i)); F \\<in> program  |] \
   3.169 -\  ==> F:(\\<Inter>i \\<in> I. A(i)) Co (\\<Inter>i \\<in> I. A'(i))";
   3.170 -by (cut_facts_tac [minor] 1);
   3.171 -by (asm_simp_tac (simpset() delsimps INT_simps
   3.172 -	  	 	    addsimps [Constrains_def]@INT_extend_simps) 1);
   3.173 -by (rtac constrains_INT 1);
   3.174 -by (dtac major 1);
   3.175 -by (auto_tac (claset(), simpset() addsimps [Constrains_def])); 
   3.176 -qed "Constrains_INT";
   3.177 -
   3.178 -Goalw [Constrains_def] "F \\<in> A Co A' ==> reachable(F) Int A <= A'";
   3.179 -by (blast_tac (claset() addDs [constrains_imp_subset]) 1);
   3.180 -qed "Constrains_imp_subset";
   3.181 -
   3.182 -Goalw [Constrains_def2]
   3.183 - "[| F \\<in> A Co B; F \\<in> B Co C |] ==> F \\<in> A Co C";
   3.184 -by (blast_tac (claset() addIs [constrains_trans, constrains_weaken]) 1);
   3.185 -qed "Constrains_trans";
   3.186 -
   3.187 -Goalw [Constrains_def2]
   3.188 -"[| F \\<in> A Co (A' Un B); F \\<in> B Co B' |] ==> F \\<in> A Co (A' Un B')";
   3.189 -by (full_simp_tac (simpset() addsimps [Int_Un_distrib]) 1);
   3.190 -by (blast_tac (claset() addIs [constrains_cancel]) 1);
   3.191 -qed "Constrains_cancel";
   3.192 -
   3.193 -(*** Stable ***)
   3.194 -(* Useful because there's no Stable_weaken.  [Tanja Vos] *)
   3.195 -
   3.196 -Goalw [stable_def, Stable_def] 
   3.197 -"F \\<in> stable(A) ==> F \\<in> Stable(A)";
   3.198 -by (etac constrains_imp_Constrains 1);
   3.199 -qed "stable_imp_Stable";
   3.200 -
   3.201 -Goal "[| F \\<in> Stable(A); A = B |] ==> F \\<in> Stable(B)";
   3.202 -by (Blast_tac 1);
   3.203 -qed "Stable_eq";
   3.204 -
   3.205 -Goal
   3.206 -"F \\<in> Stable(A) <->  (F \\<in> stable(reachable(F) Int A))";
   3.207 -by (auto_tac (claset() addDs [constrainsD2], 
   3.208 -              simpset() addsimps [Stable_def, stable_def, Constrains_def2]));
   3.209 -qed "Stable_eq_stable";
   3.210 -
   3.211 -Goalw [Stable_def] "F \\<in> A Co A ==> F \\<in> Stable(A)";
   3.212 -by (assume_tac 1);
   3.213 -qed "StableI";
   3.214 -
   3.215 -Goalw [Stable_def] "F \\<in> Stable(A) ==> F \\<in> A Co A";
   3.216 -by (assume_tac 1);
   3.217 -qed "StableD";
   3.218 -
   3.219 -Goalw [Stable_def]
   3.220 -    "[| F \\<in> Stable(A); F \\<in> Stable(A') |] ==> F \\<in> Stable(A Un A')";
   3.221 -by (blast_tac (claset() addIs [Constrains_Un]) 1);
   3.222 -qed "Stable_Un";
   3.223 -
   3.224 -Goalw [Stable_def]
   3.225 -    "[| F \\<in> Stable(A); F \\<in> Stable(A') |] ==> F \\<in> Stable (A Int A')";
   3.226 -by (blast_tac (claset() addIs [Constrains_Int]) 1);
   3.227 -qed "Stable_Int";
   3.228 -
   3.229 -Goalw [Stable_def]
   3.230 -    "[| F \\<in> Stable(C); F \\<in> A Co (C Un A') |]   \
   3.231 -\    ==> F \\<in> (C Un A) Co (C Un A')";
   3.232 -by (blast_tac (claset() addIs [Constrains_Un RS Constrains_weaken_R]) 1);
   3.233 -qed "Stable_Constrains_Un";
   3.234 -
   3.235 -Goalw [Stable_def]
   3.236 -    "[| F \\<in> Stable(C); F \\<in> (C Int A) Co A' |]   \
   3.237 -\    ==> F \\<in> (C Int A) Co (C Int A')";
   3.238 -by (blast_tac (claset() addIs [Constrains_Int RS Constrains_weaken]) 1);
   3.239 -qed "Stable_Constrains_Int";
   3.240 -
   3.241 -val [major,minor] = Goalw [Stable_def]
   3.242 -"[| (!!i. i \\<in> I ==> F \\<in> Stable(A(i))); F \\<in> program |]==> F \\<in> Stable (\\<Union>i \\<in> I. A(i))";
   3.243 -by (cut_facts_tac [minor] 1);
   3.244 -by (blast_tac (claset() addIs [Constrains_UN,major]) 1);
   3.245 -qed "Stable_UN";
   3.246 -
   3.247 -val [major,minor] = Goalw [Stable_def]
   3.248 -"[|(!!i. i \\<in> I ==> F \\<in> Stable(A(i))); F \\<in> program |]==> F \\<in> Stable (\\<Inter>i \\<in> I. A(i))";
   3.249 -by (cut_facts_tac [minor] 1);
   3.250 -by (blast_tac (claset() addIs [Constrains_INT, major]) 1);
   3.251 -qed "Stable_INT";
   3.252 -
   3.253 -Goal "F \\<in> program ==>F \\<in> Stable (reachable(F))";
   3.254 -by (asm_simp_tac (simpset() 
   3.255 -    addsimps [Stable_eq_stable, Int_absorb]) 1);
   3.256 -qed "Stable_reachable";
   3.257 -
   3.258 -Goalw [Stable_def]
   3.259 -"Stable(A) <= program";
   3.260 -by (rtac Constrains_type 1);
   3.261 -qed "Stable_type";
   3.262 -
   3.263 -(*** The Elimination Theorem.  The "free" m has become universally quantified!
   3.264 -     Should the premise be !!m instead of \\<forall>m ?  Would make it harder to use
   3.265 -     in forward proof. ***)
   3.266 -
   3.267 -Goalw [Constrains_def]  
   3.268 -"[| \\<forall>m \\<in> M. F \\<in> ({s \\<in> A. x(s) = m}) Co (B(m)); F \\<in> program |] \
   3.269 -\    ==> F \\<in> ({s \\<in> A. x(s):M}) Co (\\<Union>m \\<in> M. B(m))";
   3.270 -by Auto_tac;
   3.271 -by (res_inst_tac [("A1","reachable(F)Int A")] (elimination RS constrains_weaken_L) 1);
   3.272 -by (auto_tac (claset() addIs [constrains_weaken_L], simpset()));
   3.273 -qed "Elimination";
   3.274 -
   3.275 -(* As above, but for the special case of A=state *)
   3.276 -Goal
   3.277 - "[| \\<forall>m \\<in> M. F \\<in> {s \\<in> state. x(s) = m} Co B(m); F \\<in> program |] \
   3.278 -\    ==> F \\<in> {s \\<in> state. x(s):M} Co (\\<Union>m \\<in> M. B(m))";
   3.279 -by (blast_tac (claset() addIs [Elimination]) 1);
   3.280 -qed "Elimination2";
   3.281 -
   3.282 -(** Unless **)
   3.283 -
   3.284 -Goalw [Unless_def] "A Unless B <=program";
   3.285 -by (rtac Constrains_type 1);
   3.286 -qed "Unless_type";
   3.287 -
   3.288 -(*** Specialized laws for handling Always ***)
   3.289 -
   3.290 -(** Natural deduction rules for "Always A" **)
   3.291 -
   3.292 -Goalw [Always_def, initially_def]
   3.293 -"[| Init(F)<=A;  F \\<in> Stable(A) |] ==> F \\<in> Always(A)";
   3.294 -by (forward_tac [Stable_type RS subsetD] 1);
   3.295 -by Auto_tac;
   3.296 -qed "AlwaysI";
   3.297 -
   3.298 -Goal "F \\<in> Always(A) ==> Init(F)<=A & F \\<in> Stable(A)";
   3.299 -by (asm_full_simp_tac (simpset() addsimps [Always_def, initially_def]) 1);
   3.300 -qed "AlwaysD";
   3.301 -
   3.302 -bind_thm ("AlwaysE", AlwaysD RS conjE);
   3.303 -bind_thm ("Always_imp_Stable", AlwaysD RS conjunct2);
   3.304 -
   3.305 -(*The set of all reachable states is Always*)
   3.306 -Goal "F \\<in> Always(A) ==> reachable(F) <= A";
   3.307 -by (full_simp_tac (simpset() addsimps 
   3.308 -        [Stable_def, Constrains_def, constrains_def, Always_def, initially_def]) 1);
   3.309 -by (rtac subsetI 1);
   3.310 -by (etac reachable.induct 1);
   3.311 -by (REPEAT (blast_tac (claset() addIs reachable.intrs) 1));
   3.312 -qed "Always_includes_reachable";
   3.313 -
   3.314 -Goalw [Always_def, invariant_def, Stable_def, stable_def]
   3.315 -     "F \\<in> invariant(A) ==> F \\<in> Always(A)";
   3.316 -by (blast_tac (claset() addIs [constrains_imp_Constrains]) 1);
   3.317 -qed "invariant_imp_Always";
   3.318 -
   3.319 -bind_thm ("Always_reachable", invariant_reachable RS invariant_imp_Always);
   3.320 -
   3.321 -Goal "Always(A) = {F \\<in> program. F \\<in> invariant(reachable(F) Int A)}";
   3.322 -by (simp_tac (simpset() addsimps [Always_def, invariant_def, Stable_def, 
   3.323 -                                  Constrains_def2, stable_def, initially_def]) 1);
   3.324 -by (rtac equalityI 1);
   3.325 -by (ALLGOALS(Clarify_tac));
   3.326 -by (REPEAT(blast_tac (claset() addIs reachable.intrs@[reachable_type]) 1));
   3.327 -qed "Always_eq_invariant_reachable";
   3.328 -
   3.329 -(*the RHS is the traditional definition of the "always" operator*)
   3.330 -Goal "Always(A) = {F \\<in> program. reachable(F) <= A}";
   3.331 -by (rtac equalityI 1);
   3.332 -by (ALLGOALS(Clarify_tac));
   3.333 -by (auto_tac (claset() addDs [invariant_includes_reachable],
   3.334 -              simpset() addsimps [subset_Int_iff, invariant_reachable,
   3.335 -                                  Always_eq_invariant_reachable]));
   3.336 -qed "Always_eq_includes_reachable";
   3.337 -
   3.338 -Goalw [Always_def, initially_def] "Always(A) <= program";
   3.339 -by Auto_tac;
   3.340 -qed "Always_type";
   3.341 -
   3.342 -Goal "Always(state) = program";
   3.343 -by (rtac equalityI 1);
   3.344 -by (auto_tac (claset() addDs [Always_type RS subsetD, 
   3.345 -                              reachable_type RS subsetD], 
   3.346 -              simpset() addsimps [Always_eq_includes_reachable]));
   3.347 -qed "Always_state_eq";
   3.348 -Addsimps [Always_state_eq];
   3.349 -
   3.350 -Goal "F \\<in> program ==> F \\<in> Always(state)";
   3.351 -by (auto_tac (claset() addDs [reachable_type RS subsetD], simpset() 
   3.352 -    addsimps [Always_eq_includes_reachable]));
   3.353 -qed "state_AlwaysI";
   3.354 -
   3.355 -Goal "st_set(A) ==> Always(A) = (\\<Union>I \\<in> Pow(A). invariant(I))";
   3.356 -by (simp_tac (simpset() addsimps [Always_eq_includes_reachable]) 1);
   3.357 -by (rtac equalityI 1);
   3.358 -by (ALLGOALS(Clarify_tac));
   3.359 -by (REPEAT(blast_tac (claset() 
   3.360 -         addIs [invariantI, impOfSubs Init_into_reachable, 
   3.361 -         impOfSubs invariant_includes_reachable]
   3.362 -                        addDs [invariant_type RS subsetD]) 1));
   3.363 -qed "Always_eq_UN_invariant";
   3.364 -
   3.365 -Goal "[| F \\<in> Always(A); A <= B |] ==> F \\<in> Always(B)";
   3.366 -by (auto_tac (claset(), simpset() addsimps [Always_eq_includes_reachable]));
   3.367 -qed "Always_weaken";
   3.368 -
   3.369 -
   3.370 -(*** "Co" rules involving Always ***)
   3.371 -val Int_absorb2 = rewrite_rule [iff_def] subset_Int_iff RS conjunct1 RS mp;
   3.372 -
   3.373 -Goal "F \\<in> Always(I) ==> (F:(I Int A) Co A') <-> (F \\<in> A Co A')";
   3.374 -by (asm_simp_tac
   3.375 -    (simpset() addsimps [Always_includes_reachable RS Int_absorb2,
   3.376 -                         Constrains_def, Int_assoc RS sym]) 1);
   3.377 -qed "Always_Constrains_pre";
   3.378 -
   3.379 -Goal "F \\<in> Always(I) ==> (F \\<in> A Co (I Int A')) <->(F \\<in> A Co A')";
   3.380 -by (asm_simp_tac
   3.381 -    (simpset() addsimps [Always_includes_reachable RS Int_absorb2,
   3.382 -                         Constrains_eq_constrains, Int_assoc RS sym]) 1);
   3.383 -qed "Always_Constrains_post";
   3.384 -
   3.385 -Goal "[| F \\<in> Always(I);  F \\<in> (I Int A) Co A' |] ==> F \\<in> A Co A'";
   3.386 -by (blast_tac (claset() addIs [Always_Constrains_pre RS iffD1]) 1);
   3.387 -qed "Always_ConstrainsI";
   3.388 -
   3.389 -(* [| F \\<in> Always(I);  F \\<in> A Co A' |] ==> F \\<in> A Co (I Int A') *)
   3.390 -bind_thm ("Always_ConstrainsD", Always_Constrains_post RS iffD2);
   3.391 -
   3.392 -(*The analogous proof of Always_LeadsTo_weaken doesn't terminate*)
   3.393 -Goal 
   3.394 -"[|F \\<in> Always(C); F \\<in> A Co A'; C Int B<=A; C Int A'<=B'|]==>F \\<in> B Co B'";
   3.395 -by (rtac Always_ConstrainsI 1);
   3.396 -by (dtac Always_ConstrainsD 2);
   3.397 -by (ALLGOALS(Asm_simp_tac));
   3.398 -by (blast_tac (claset() addIs [Constrains_weaken]) 1);
   3.399 -qed "Always_Constrains_weaken";
   3.400 -
   3.401 -(** Conjoining Always properties **)
   3.402 -Goal "Always(A Int B) = Always(A) Int Always(B)";
   3.403 -by (auto_tac (claset(), simpset() addsimps [Always_eq_includes_reachable]));
   3.404 -qed "Always_Int_distrib";
   3.405 -
   3.406 -(* the premise i \\<in> I is need since \\<Inter>is formally not defined for I=0 *)
   3.407 -Goal "i \\<in> I==>Always(\\<Inter>i \\<in> I. A(i)) = (\\<Inter>i \\<in> I. Always(A(i)))";
   3.408 -by (rtac equalityI 1);
   3.409 -by (auto_tac (claset(), simpset() addsimps
   3.410 -              [Inter_iff, Always_eq_includes_reachable]));
   3.411 -qed "Always_INT_distrib";
   3.412 -
   3.413 -
   3.414 -Goal "[| F \\<in> Always(A);  F \\<in> Always(B) |] ==> F \\<in> Always(A Int B)";
   3.415 -by (asm_simp_tac (simpset() addsimps [Always_Int_distrib]) 1);
   3.416 -qed "Always_Int_I";
   3.417 -
   3.418 -(*Allows a kind of "implication introduction"*)
   3.419 -Goal "[| F \\<in> Always(A) |] ==> (F \\<in> Always(C-A Un B)) <-> (F \\<in> Always(B))";
   3.420 -by (auto_tac (claset(), simpset() addsimps [Always_eq_includes_reachable]));
   3.421 -qed "Always_Diff_Un_eq";
   3.422 -
   3.423 -(*Delete the nearest invariance assumption (which will be the second one
   3.424 -  used by Always_Int_I) *)
   3.425 -val Always_thin =
   3.426 -    read_instantiate_sg (sign_of thy)
   3.427 -                [("V", "?F \\<in> Always(?A)")] thin_rl;
   3.428 -
   3.429 -(*Combines two invariance ASSUMPTIONS into one.  USEFUL??*)
   3.430 -val Always_Int_tac = dtac Always_Int_I THEN' assume_tac THEN' etac Always_thin;
   3.431 -
   3.432 -(*Combines a list of invariance THEOREMS into one.*)
   3.433 -val Always_Int_rule = foldr1 (fn (th1,th2) => [th1,th2] MRS Always_Int_I);
   3.434 -
   3.435 -(*To allow expansion of the program's definition when appropriate*)
   3.436 -val program_defs_ref = ref ([]: thm list);
   3.437 -
   3.438 -(*proves "co" properties when the program is specified*)
   3.439 -
   3.440 -fun gen_constrains_tac(cs,ss) i = 
   3.441 -   SELECT_GOAL
   3.442 -      (EVERY [REPEAT (Always_Int_tac 1),
   3.443 -              REPEAT (etac Always_ConstrainsI 1
   3.444 -                      ORELSE
   3.445 -                      resolve_tac [StableI, stableI,
   3.446 -                                   constrains_imp_Constrains] 1),
   3.447 -              rtac constrainsI 1,
   3.448 -              (* Three subgoals *)
   3.449 -              rewrite_goal_tac [st_set_def] 3,
   3.450 -              REPEAT (Force_tac 2),
   3.451 -              full_simp_tac (ss addsimps !program_defs_ref) 1,
   3.452 -              ALLGOALS (clarify_tac cs),
   3.453 -              REPEAT (FIRSTGOAL (etac disjE)),
   3.454 -              ALLGOALS Clarify_tac,
   3.455 -              REPEAT (FIRSTGOAL (etac disjE)),
   3.456 -              ALLGOALS (clarify_tac cs),
   3.457 -              ALLGOALS (asm_full_simp_tac ss),
   3.458 -              ALLGOALS (clarify_tac cs)]) i;
   3.459 -
   3.460 -fun constrains_tac st = gen_constrains_tac (claset(), simpset()) st;
   3.461 -
   3.462 -(*For proving invariants*)
   3.463 -fun always_tac i = 
   3.464 -    rtac AlwaysI i THEN Force_tac i THEN constrains_tac i;
     4.1 --- a/src/ZF/UNITY/Constrains.thy	Sat Mar 26 18:20:29 2005 +0100
     4.2 +++ b/src/ZF/UNITY/Constrains.thy	Mon Mar 28 16:19:56 2005 +0200
     4.3 @@ -1,14 +1,14 @@
     4.4 -(*  Title:      ZF/UNITY/Constrains.thy
     4.5 -    ID:         $Id$
     4.6 +(*  ID:         $Id$
     4.7      Author:     Sidi O Ehmety, Computer Laboratory
     4.8      Copyright   2001  University of Cambridge
     4.9 -
    4.10 -Safety relations: restricted to the set of reachable states.
    4.11 -
    4.12 -Theory ported from HOL.
    4.13  *)
    4.14  
    4.15 -Constrains = UNITY +
    4.16 +header{*Weak Safety Properties*}
    4.17 +
    4.18 +theory Constrains
    4.19 +imports UNITY
    4.20 +
    4.21 +begin
    4.22  consts traces :: "[i, i] => i"
    4.23    (* Initial states and program => (final state, reversed trace to it)... 
    4.24        the domain may also be state*list(state) *)
    4.25 @@ -16,27 +16,27 @@
    4.26    domains 
    4.27       "traces(init, acts)" <=
    4.28           "(init Un (UN act:acts. field(act)))*list(UN act:acts. field(act))"
    4.29 -  intrs 
    4.30 +  intros 
    4.31           (*Initial trace is empty*)
    4.32 -    Init  "s: init ==> <s,[]> : traces(init,acts)"
    4.33 +    Init: "s: init ==> <s,[]> : traces(init,acts)"
    4.34  
    4.35 -    Acts  "[| act:acts;  <s,evs> : traces(init,acts);  <s,s'>: act |]
    4.36 +    Acts: "[| act:acts;  <s,evs> : traces(init,acts);  <s,s'>: act |]
    4.37             ==> <s', Cons(s,evs)> : traces(init, acts)"
    4.38    
    4.39 -  type_intrs "list.intrs@[UnI1, UnI2, UN_I, fieldI2, fieldI1]"
    4.40 +  type_intros list.intros UnI1 UnI2 UN_I fieldI2 fieldI1
    4.41  
    4.42 -  consts reachable :: "i=>i"
    4.43  
    4.44 +consts reachable :: "i=>i"
    4.45  inductive
    4.46    domains
    4.47    "reachable(F)" <= "Init(F) Un (UN act:Acts(F). field(act))"
    4.48 -  intrs 
    4.49 -    Init  "s:Init(F) ==> s:reachable(F)"
    4.50 +  intros 
    4.51 +    Init: "s:Init(F) ==> s:reachable(F)"
    4.52  
    4.53 -    Acts  "[| act: Acts(F);  s:reachable(F);  <s,s'>: act |]
    4.54 +    Acts: "[| act: Acts(F);  s:reachable(F);  <s,s'>: act |]
    4.55             ==> s':reachable(F)"
    4.56  
    4.57 -  type_intrs "[UnI1, UnI2, fieldI2, UN_I]"
    4.58 +  type_intros UnI1 UnI2 fieldI2 UN_I
    4.59  
    4.60    
    4.61  consts
    4.62 @@ -44,10 +44,10 @@
    4.63    op_Unless  :: "[i, i] => i"  (infixl "Unless" 60)
    4.64  
    4.65  defs
    4.66 -  Constrains_def
    4.67 +  Constrains_def:
    4.68      "A Co B == {F:program. F:(reachable(F) Int A) co B}"
    4.69  
    4.70 -  Unless_def
    4.71 +  Unless_def:
    4.72      "A Unless B == (A-B) Co (A Un B)"
    4.73  
    4.74  constdefs
    4.75 @@ -57,5 +57,519 @@
    4.76    Always :: "i => i"
    4.77      "Always(A) == initially(A) Int Stable(A)"
    4.78  
    4.79 +
    4.80 +(*** traces and reachable ***)
    4.81 +
    4.82 +lemma reachable_type: "reachable(F) <= state"
    4.83 +apply (cut_tac F = F in Init_type)
    4.84 +apply (cut_tac F = F in Acts_type)
    4.85 +apply (cut_tac F = F in reachable.dom_subset, blast)
    4.86 +done
    4.87 +
    4.88 +lemma st_set_reachable: "st_set(reachable(F))"
    4.89 +apply (unfold st_set_def)
    4.90 +apply (rule reachable_type)
    4.91 +done
    4.92 +declare st_set_reachable [iff]
    4.93 +
    4.94 +lemma reachable_Int_state: "reachable(F) Int state = reachable(F)"
    4.95 +by (cut_tac reachable_type, auto)
    4.96 +declare reachable_Int_state [iff]
    4.97 +
    4.98 +lemma state_Int_reachable: "state Int reachable(F) = reachable(F)"
    4.99 +by (cut_tac reachable_type, auto)
   4.100 +declare state_Int_reachable [iff]
   4.101 +
   4.102 +lemma reachable_equiv_traces: 
   4.103 +"F \<in> program ==> reachable(F)={s \<in> state. \<exists>evs. <s,evs>:traces(Init(F), Acts(F))}"
   4.104 +apply (rule equalityI, safe)
   4.105 +apply (blast dest: reachable_type [THEN subsetD])
   4.106 +apply (erule_tac [2] traces.induct)
   4.107 +apply (erule reachable.induct)
   4.108 +apply (blast intro: reachable.intros traces.intros)+
   4.109 +done
   4.110 +
   4.111 +lemma Init_into_reachable: "Init(F) <= reachable(F)"
   4.112 +by (blast intro: reachable.intros)
   4.113 +
   4.114 +lemma stable_reachable: "[| F \<in> program; G \<in> program;  
   4.115 +    Acts(G) <= Acts(F)  |] ==> G \<in> stable(reachable(F))"
   4.116 +apply (blast intro: stableI constrainsI st_setI
   4.117 +             reachable_type [THEN subsetD] reachable.intros)
   4.118 +done
   4.119 +
   4.120 +declare stable_reachable [intro!]
   4.121 +declare stable_reachable [simp]
   4.122 +
   4.123 +(*The set of all reachable states is an invariant...*)
   4.124 +lemma invariant_reachable: 
   4.125 +   "F \<in> program ==> F \<in> invariant(reachable(F))"
   4.126 +apply (unfold invariant_def initially_def)
   4.127 +apply (blast intro: reachable_type [THEN subsetD] reachable.intros)
   4.128 +done
   4.129 +
   4.130 +(*...in fact the strongest invariant!*)
   4.131 +lemma invariant_includes_reachable: "F \<in> invariant(A) ==> reachable(F) <= A"
   4.132 +apply (cut_tac F = F in Acts_type)
   4.133 +apply (cut_tac F = F in Init_type)
   4.134 +apply (cut_tac F = F in reachable_type)
   4.135 +apply (simp (no_asm_use) add: stable_def constrains_def invariant_def initially_def)
   4.136 +apply (rule subsetI)
   4.137 +apply (erule reachable.induct)
   4.138 +apply (blast intro: reachable.intros)+
   4.139 +done
   4.140 +
   4.141 +(*** Co ***)
   4.142 +
   4.143 +lemma constrains_reachable_Int: "F \<in> B co B'==>F:(reachable(F) Int B) co (reachable(F) Int B')"
   4.144 +apply (frule constrains_type [THEN subsetD])
   4.145 +apply (frule stable_reachable [OF _ _ subset_refl])
   4.146 +apply (simp_all add: stable_def constrains_Int)
   4.147 +done
   4.148 +
   4.149 +(*Resembles the previous definition of Constrains*)
   4.150 +lemma Constrains_eq_constrains: 
   4.151 +"A Co B = {F \<in> program. F:(reachable(F) Int A) co (reachable(F)  Int  B)}"
   4.152 +apply (unfold Constrains_def)
   4.153 +apply (blast dest: constrains_reachable_Int constrains_type [THEN subsetD]
   4.154 +             intro: constrains_weaken)
   4.155 +done
   4.156 +
   4.157 +lemmas Constrains_def2 = Constrains_eq_constrains [THEN eq_reflection]
   4.158 +
   4.159 +lemma constrains_imp_Constrains: "F \<in> A co A' ==> F \<in> A Co A'"
   4.160 +apply (unfold Constrains_def)
   4.161 +apply (blast intro: constrains_weaken_L dest: constrainsD2)
   4.162 +done
   4.163 +
   4.164 +lemma ConstrainsI: 
   4.165 +    "[|!!act s s'. [| act \<in> Acts(F); <s,s'>:act; s \<in> A |] ==> s':A'; 
   4.166 +       F \<in> program|]
   4.167 +     ==> F \<in> A Co A'"
   4.168 +apply (auto simp add: Constrains_def constrains_def st_set_def)
   4.169 +apply (blast dest: reachable_type [THEN subsetD])
   4.170 +done
   4.171 +
   4.172 +lemma Constrains_type: 
   4.173 + "A Co B <= program"
   4.174 +apply (unfold Constrains_def, blast)
   4.175 +done
   4.176 +
   4.177 +lemma Constrains_empty: "F \<in> 0 Co B <-> F \<in> program"
   4.178 +by (auto dest: Constrains_type [THEN subsetD]
   4.179 +            intro: constrains_imp_Constrains)
   4.180 +declare Constrains_empty [iff]
   4.181 +
   4.182 +lemma Constrains_state: "F \<in> A Co state <-> F \<in> program"
   4.183 +apply (unfold Constrains_def)
   4.184 +apply (auto dest: Constrains_type [THEN subsetD] intro: constrains_imp_Constrains)
   4.185 +done
   4.186 +declare Constrains_state [iff]
   4.187 +
   4.188 +lemma Constrains_weaken_R: 
   4.189 +        "[| F \<in> A Co A'; A'<=B' |] ==> F \<in> A Co B'"
   4.190 +apply (unfold Constrains_def2)
   4.191 +apply (blast intro: constrains_weaken_R)
   4.192 +done
   4.193 +
   4.194 +lemma Constrains_weaken_L: 
   4.195 +    "[| F \<in> A Co A'; B<=A |] ==> F \<in> B Co A'"
   4.196 +apply (unfold Constrains_def2)
   4.197 +apply (blast intro: constrains_weaken_L st_set_subset)
   4.198 +done
   4.199 +
   4.200 +lemma Constrains_weaken: 
   4.201 +   "[| F \<in> A Co A'; B<=A; A'<=B' |] ==> F \<in> B Co B'"
   4.202 +apply (unfold Constrains_def2)
   4.203 +apply (blast intro: constrains_weaken st_set_subset)
   4.204 +done
   4.205 +
   4.206 +(** Union **)
   4.207 +lemma Constrains_Un: 
   4.208 +    "[| F \<in> A Co A'; F \<in> B Co B' |] ==> F \<in> (A Un B) Co (A' Un B')"
   4.209 +apply (unfold Constrains_def2, auto)
   4.210 +apply (simp add: Int_Un_distrib)
   4.211 +apply (blast intro: constrains_Un)
   4.212 +done
   4.213 +
   4.214 +lemma Constrains_UN: 
   4.215 +    "[|(!!i. i \<in> I==>F \<in> A(i) Co A'(i)); F \<in> program|] 
   4.216 +     ==> F:(\<Union>i \<in> I. A(i)) Co (\<Union>i \<in> I. A'(i))"
   4.217 +by (auto intro: constrains_UN simp del: UN_simps 
   4.218 +         simp add: Constrains_def2 Int_UN_distrib)
   4.219 +
   4.220 +
   4.221 +(** Intersection **)
   4.222 +
   4.223 +lemma Constrains_Int: 
   4.224 +    "[| F \<in> A Co A'; F \<in> B Co B'|]==> F:(A Int B) Co (A' Int B')"
   4.225 +apply (unfold Constrains_def)
   4.226 +apply (subgoal_tac "reachable (F) Int (A Int B) = (reachable (F) Int A) Int (reachable (F) Int B) ")
   4.227 +apply (auto intro: constrains_Int)
   4.228 +done
   4.229 +
   4.230 +lemma Constrains_INT: 
   4.231 +    "[| (!!i. i \<in> I ==>F \<in> A(i) Co A'(i)); F \<in> program  |]  
   4.232 +     ==> F:(\<Inter>i \<in> I. A(i)) Co (\<Inter>i \<in> I. A'(i))"
   4.233 +apply (simp (no_asm_simp) del: INT_simps add: Constrains_def INT_extend_simps)
   4.234 +apply (rule constrains_INT)
   4.235 +apply (auto simp add: Constrains_def)
   4.236 +done
   4.237 +
   4.238 +lemma Constrains_imp_subset: "F \<in> A Co A' ==> reachable(F) Int A <= A'"
   4.239 +apply (unfold Constrains_def)
   4.240 +apply (blast dest: constrains_imp_subset)
   4.241 +done
   4.242 +
   4.243 +lemma Constrains_trans: 
   4.244 + "[| F \<in> A Co B; F \<in> B Co C |] ==> F \<in> A Co C"
   4.245 +apply (unfold Constrains_def2)
   4.246 +apply (blast intro: constrains_trans constrains_weaken)
   4.247 +done
   4.248 +
   4.249 +lemma Constrains_cancel: 
   4.250 +"[| F \<in> A Co (A' Un B); F \<in> B Co B' |] ==> F \<in> A Co (A' Un B')"
   4.251 +apply (unfold Constrains_def2)
   4.252 +apply (simp (no_asm_use) add: Int_Un_distrib)
   4.253 +apply (blast intro: constrains_cancel)
   4.254 +done
   4.255 +
   4.256 +(*** Stable ***)
   4.257 +(* Useful because there's no Stable_weaken.  [Tanja Vos] *)
   4.258 +
   4.259 +lemma stable_imp_Stable: 
   4.260 +"F \<in> stable(A) ==> F \<in> Stable(A)"
   4.261 +
   4.262 +apply (unfold stable_def Stable_def)
   4.263 +apply (erule constrains_imp_Constrains)
   4.264 +done
   4.265 +
   4.266 +lemma Stable_eq: "[| F \<in> Stable(A); A = B |] ==> F \<in> Stable(B)"
   4.267 +by blast
   4.268 +
   4.269 +lemma Stable_eq_stable: 
   4.270 +"F \<in> Stable(A) <->  (F \<in> stable(reachable(F) Int A))"
   4.271 +apply (auto dest: constrainsD2 simp add: Stable_def stable_def Constrains_def2)
   4.272 +done
   4.273 +
   4.274 +lemma StableI: "F \<in> A Co A ==> F \<in> Stable(A)"
   4.275 +by (unfold Stable_def, assumption)
   4.276 +
   4.277 +lemma StableD: "F \<in> Stable(A) ==> F \<in> A Co A"
   4.278 +by (unfold Stable_def, assumption)
   4.279 +
   4.280 +lemma Stable_Un: 
   4.281 +    "[| F \<in> Stable(A); F \<in> Stable(A') |] ==> F \<in> Stable(A Un A')"
   4.282 +apply (unfold Stable_def)
   4.283 +apply (blast intro: Constrains_Un)
   4.284 +done
   4.285 +
   4.286 +lemma Stable_Int: 
   4.287 +    "[| F \<in> Stable(A); F \<in> Stable(A') |] ==> F \<in> Stable (A Int A')"
   4.288 +apply (unfold Stable_def)
   4.289 +apply (blast intro: Constrains_Int)
   4.290 +done
   4.291 +
   4.292 +lemma Stable_Constrains_Un: 
   4.293 +    "[| F \<in> Stable(C); F \<in> A Co (C Un A') |]    
   4.294 +     ==> F \<in> (C Un A) Co (C Un A')"
   4.295 +apply (unfold Stable_def)
   4.296 +apply (blast intro: Constrains_Un [THEN Constrains_weaken_R])
   4.297 +done
   4.298 +
   4.299 +lemma Stable_Constrains_Int: 
   4.300 +    "[| F \<in> Stable(C); F \<in> (C Int A) Co A' |]    
   4.301 +     ==> F \<in> (C Int A) Co (C Int A')"
   4.302 +apply (unfold Stable_def)
   4.303 +apply (blast intro: Constrains_Int [THEN Constrains_weaken])
   4.304 +done
   4.305 +
   4.306 +lemma Stable_UN: 
   4.307 +    "[| (!!i. i \<in> I ==> F \<in> Stable(A(i))); F \<in> program |]
   4.308 +     ==> F \<in> Stable (\<Union>i \<in> I. A(i))"
   4.309 +apply (simp add: Stable_def)
   4.310 +apply (blast intro: Constrains_UN)
   4.311 +done
   4.312 +
   4.313 +lemma Stable_INT: 
   4.314 +    "[|(!!i. i \<in> I ==> F \<in> Stable(A(i))); F \<in> program |]
   4.315 +     ==> F \<in> Stable (\<Inter>i \<in> I. A(i))"
   4.316 +apply (simp add: Stable_def)
   4.317 +apply (blast intro: Constrains_INT)
   4.318 +done
   4.319 +
   4.320 +lemma Stable_reachable: "F \<in> program ==>F \<in> Stable (reachable(F))"
   4.321 +apply (simp (no_asm_simp) add: Stable_eq_stable Int_absorb)
   4.322 +done
   4.323 +
   4.324 +lemma Stable_type: "Stable(A) <= program"
   4.325 +apply (unfold Stable_def)
   4.326 +apply (rule Constrains_type)
   4.327 +done
   4.328 +
   4.329 +(*** The Elimination Theorem.  The "free" m has become universally quantified!
   4.330 +     Should the premise be !!m instead of \<forall>m ?  Would make it harder to use
   4.331 +     in forward proof. ***)
   4.332 +
   4.333 +lemma Elimination: 
   4.334 +    "[| \<forall>m \<in> M. F \<in> ({s \<in> A. x(s) = m}) Co (B(m)); F \<in> program |]  
   4.335 +     ==> F \<in> ({s \<in> A. x(s):M}) Co (\<Union>m \<in> M. B(m))"
   4.336 +apply (unfold Constrains_def, auto)
   4.337 +apply (rule_tac A1 = "reachable (F) Int A" 
   4.338 +	in UNITY.elimination [THEN constrains_weaken_L])
   4.339 +apply (auto intro: constrains_weaken_L)
   4.340 +done
   4.341 +
   4.342 +(* As above, but for the special case of A=state *)
   4.343 +lemma Elimination2: 
   4.344 + "[| \<forall>m \<in> M. F \<in> {s \<in> state. x(s) = m} Co B(m); F \<in> program |]  
   4.345 +     ==> F \<in> {s \<in> state. x(s):M} Co (\<Union>m \<in> M. B(m))"
   4.346 +apply (blast intro: Elimination)
   4.347 +done
   4.348 +
   4.349 +(** Unless **)
   4.350 +
   4.351 +lemma Unless_type: "A Unless B <=program"
   4.352 +
   4.353 +apply (unfold Unless_def)
   4.354 +apply (rule Constrains_type)
   4.355 +done
   4.356 +
   4.357 +(*** Specialized laws for handling Always ***)
   4.358 +
   4.359 +(** Natural deduction rules for "Always A" **)
   4.360 +
   4.361 +lemma AlwaysI: 
   4.362 +"[| Init(F)<=A;  F \<in> Stable(A) |] ==> F \<in> Always(A)"
   4.363 +
   4.364 +apply (unfold Always_def initially_def)
   4.365 +apply (frule Stable_type [THEN subsetD], auto)
   4.366 +done
   4.367 +
   4.368 +lemma AlwaysD: "F \<in> Always(A) ==> Init(F)<=A & F \<in> Stable(A)"
   4.369 +by (simp add: Always_def initially_def)
   4.370 +
   4.371 +lemmas AlwaysE = AlwaysD [THEN conjE, standard]
   4.372 +lemmas Always_imp_Stable = AlwaysD [THEN conjunct2, standard]
   4.373 +
   4.374 +(*The set of all reachable states is Always*)
   4.375 +lemma Always_includes_reachable: "F \<in> Always(A) ==> reachable(F) <= A"
   4.376 +apply (simp (no_asm_use) add: Stable_def Constrains_def constrains_def Always_def initially_def)
   4.377 +apply (rule subsetI)
   4.378 +apply (erule reachable.induct)
   4.379 +apply (blast intro: reachable.intros)+
   4.380 +done
   4.381 +
   4.382 +lemma invariant_imp_Always: 
   4.383 +     "F \<in> invariant(A) ==> F \<in> Always(A)"
   4.384 +apply (unfold Always_def invariant_def Stable_def stable_def)
   4.385 +apply (blast intro: constrains_imp_Constrains)
   4.386 +done
   4.387 +
   4.388 +lemmas Always_reachable = invariant_reachable [THEN invariant_imp_Always, standard]
   4.389 +
   4.390 +lemma Always_eq_invariant_reachable: "Always(A) = {F \<in> program. F \<in> invariant(reachable(F) Int A)}"
   4.391 +apply (simp (no_asm) add: Always_def invariant_def Stable_def Constrains_def2 stable_def initially_def)
   4.392 +apply (rule equalityI, auto) 
   4.393 +apply (blast intro: reachable.intros reachable_type)
   4.394 +done
   4.395 +
   4.396 +(*the RHS is the traditional definition of the "always" operator*)
   4.397 +lemma Always_eq_includes_reachable: "Always(A) = {F \<in> program. reachable(F) <= A}"
   4.398 +apply (rule equalityI, safe)
   4.399 +apply (auto dest: invariant_includes_reachable 
   4.400 +   simp add: subset_Int_iff invariant_reachable Always_eq_invariant_reachable)
   4.401 +done
   4.402 +
   4.403 +lemma Always_type: "Always(A) <= program"
   4.404 +by (unfold Always_def initially_def, auto)
   4.405 +
   4.406 +lemma Always_state_eq: "Always(state) = program"
   4.407 +apply (rule equalityI)
   4.408 +apply (auto dest: Always_type [THEN subsetD] reachable_type [THEN subsetD]
   4.409 +            simp add: Always_eq_includes_reachable)
   4.410 +done
   4.411 +declare Always_state_eq [simp]
   4.412 +
   4.413 +lemma state_AlwaysI: "F \<in> program ==> F \<in> Always(state)"
   4.414 +by (auto dest: reachable_type [THEN subsetD]
   4.415 +            simp add: Always_eq_includes_reachable)
   4.416 +
   4.417 +lemma Always_eq_UN_invariant: "st_set(A) ==> Always(A) = (\<Union>I \<in> Pow(A). invariant(I))"
   4.418 +apply (simp (no_asm) add: Always_eq_includes_reachable)
   4.419 +apply (rule equalityI, auto) 
   4.420 +apply (blast intro: invariantI rev_subsetD [OF _ Init_into_reachable] 
   4.421 +		    rev_subsetD [OF _ invariant_includes_reachable]  
   4.422 +             dest: invariant_type [THEN subsetD])+
   4.423 +done
   4.424 +
   4.425 +lemma Always_weaken: "[| F \<in> Always(A); A <= B |] ==> F \<in> Always(B)"
   4.426 +by (auto simp add: Always_eq_includes_reachable)
   4.427 +
   4.428 +
   4.429 +(*** "Co" rules involving Always ***)
   4.430 +lemmas Int_absorb2 = subset_Int_iff [unfolded iff_def, THEN conjunct1, THEN mp]
   4.431 +
   4.432 +lemma Always_Constrains_pre: "F \<in> Always(I) ==> (F:(I Int A) Co A') <-> (F \<in> A Co A')"
   4.433 +apply (simp (no_asm_simp) add: Always_includes_reachable [THEN Int_absorb2] Constrains_def Int_assoc [symmetric])
   4.434 +done
   4.435 +
   4.436 +lemma Always_Constrains_post: "F \<in> Always(I) ==> (F \<in> A Co (I Int A')) <->(F \<in> A Co A')"
   4.437 +apply (simp (no_asm_simp) add: Always_includes_reachable [THEN Int_absorb2] Constrains_eq_constrains Int_assoc [symmetric])
   4.438 +done
   4.439 +
   4.440 +lemma Always_ConstrainsI: "[| F \<in> Always(I);  F \<in> (I Int A) Co A' |] ==> F \<in> A Co A'"
   4.441 +by (blast intro: Always_Constrains_pre [THEN iffD1])
   4.442 +
   4.443 +(* [| F \<in> Always(I);  F \<in> A Co A' |] ==> F \<in> A Co (I Int A') *)
   4.444 +lemmas Always_ConstrainsD = Always_Constrains_post [THEN iffD2, standard]
   4.445 +
   4.446 +(*The analogous proof of Always_LeadsTo_weaken doesn't terminate*)
   4.447 +lemma Always_Constrains_weaken: 
   4.448 +"[|F \<in> Always(C); F \<in> A Co A'; C Int B<=A; C Int A'<=B'|]==>F \<in> B Co B'"
   4.449 +apply (rule Always_ConstrainsI)
   4.450 +apply (drule_tac [2] Always_ConstrainsD, simp_all) 
   4.451 +apply (blast intro: Constrains_weaken)
   4.452 +done
   4.453 +
   4.454 +(** Conjoining Always properties **)
   4.455 +lemma Always_Int_distrib: "Always(A Int B) = Always(A) Int Always(B)"
   4.456 +by (auto simp add: Always_eq_includes_reachable)
   4.457 +
   4.458 +(* the premise i \<in> I is need since \<Inter>is formally not defined for I=0 *)
   4.459 +lemma Always_INT_distrib: "i \<in> I==>Always(\<Inter>i \<in> I. A(i)) = (\<Inter>i \<in> I. Always(A(i)))"
   4.460 +apply (rule equalityI)
   4.461 +apply (auto simp add: Inter_iff Always_eq_includes_reachable)
   4.462 +done
   4.463 +
   4.464 +
   4.465 +lemma Always_Int_I: "[| F \<in> Always(A);  F \<in> Always(B) |] ==> F \<in> Always(A Int B)"
   4.466 +apply (simp (no_asm_simp) add: Always_Int_distrib)
   4.467 +done
   4.468 +
   4.469 +(*Allows a kind of "implication introduction"*)
   4.470 +lemma Always_Diff_Un_eq: "[| F \<in> Always(A) |] ==> (F \<in> Always(C-A Un B)) <-> (F \<in> Always(B))"
   4.471 +by (auto simp add: Always_eq_includes_reachable)
   4.472 +
   4.473 +(*Delete the nearest invariance assumption (which will be the second one
   4.474 +  used by Always_Int_I) *)
   4.475 +lemmas Always_thin = thin_rl [of "F \<in> Always(A)", standard]
   4.476 +
   4.477 +ML
   4.478 +{*
   4.479 +val reachable_type = thm "reachable_type";
   4.480 +val st_set_reachable = thm "st_set_reachable";
   4.481 +val reachable_Int_state = thm "reachable_Int_state";
   4.482 +val state_Int_reachable = thm "state_Int_reachable";
   4.483 +val reachable_equiv_traces = thm "reachable_equiv_traces";
   4.484 +val Init_into_reachable = thm "Init_into_reachable";
   4.485 +val stable_reachable = thm "stable_reachable";
   4.486 +val invariant_reachable = thm "invariant_reachable";
   4.487 +val invariant_includes_reachable = thm "invariant_includes_reachable";
   4.488 +val constrains_reachable_Int = thm "constrains_reachable_Int";
   4.489 +val Constrains_eq_constrains = thm "Constrains_eq_constrains";
   4.490 +val Constrains_def2 = thm "Constrains_def2";
   4.491 +val constrains_imp_Constrains = thm "constrains_imp_Constrains";
   4.492 +val ConstrainsI = thm "ConstrainsI";
   4.493 +val Constrains_type = thm "Constrains_type";
   4.494 +val Constrains_empty = thm "Constrains_empty";
   4.495 +val Constrains_state = thm "Constrains_state";
   4.496 +val Constrains_weaken_R = thm "Constrains_weaken_R";
   4.497 +val Constrains_weaken_L = thm "Constrains_weaken_L";
   4.498 +val Constrains_weaken = thm "Constrains_weaken";
   4.499 +val Constrains_Un = thm "Constrains_Un";
   4.500 +val Constrains_UN = thm "Constrains_UN";
   4.501 +val Constrains_Int = thm "Constrains_Int";
   4.502 +val Constrains_INT = thm "Constrains_INT";
   4.503 +val Constrains_imp_subset = thm "Constrains_imp_subset";
   4.504 +val Constrains_trans = thm "Constrains_trans";
   4.505 +val Constrains_cancel = thm "Constrains_cancel";
   4.506 +val stable_imp_Stable = thm "stable_imp_Stable";
   4.507 +val Stable_eq = thm "Stable_eq";
   4.508 +val Stable_eq_stable = thm "Stable_eq_stable";
   4.509 +val StableI = thm "StableI";
   4.510 +val StableD = thm "StableD";
   4.511 +val Stable_Un = thm "Stable_Un";
   4.512 +val Stable_Int = thm "Stable_Int";
   4.513 +val Stable_Constrains_Un = thm "Stable_Constrains_Un";
   4.514 +val Stable_Constrains_Int = thm "Stable_Constrains_Int";
   4.515 +val Stable_UN = thm "Stable_UN";
   4.516 +val Stable_INT = thm "Stable_INT";
   4.517 +val Stable_reachable = thm "Stable_reachable";
   4.518 +val Stable_type = thm "Stable_type";
   4.519 +val Elimination = thm "Elimination";
   4.520 +val Elimination2 = thm "Elimination2";
   4.521 +val Unless_type = thm "Unless_type";
   4.522 +val AlwaysI = thm "AlwaysI";
   4.523 +val AlwaysD = thm "AlwaysD";
   4.524 +val AlwaysE = thm "AlwaysE";
   4.525 +val Always_imp_Stable = thm "Always_imp_Stable";
   4.526 +val Always_includes_reachable = thm "Always_includes_reachable";
   4.527 +val invariant_imp_Always = thm "invariant_imp_Always";
   4.528 +val Always_reachable = thm "Always_reachable";
   4.529 +val Always_eq_invariant_reachable = thm "Always_eq_invariant_reachable";
   4.530 +val Always_eq_includes_reachable = thm "Always_eq_includes_reachable";
   4.531 +val Always_type = thm "Always_type";
   4.532 +val Always_state_eq = thm "Always_state_eq";
   4.533 +val state_AlwaysI = thm "state_AlwaysI";
   4.534 +val Always_eq_UN_invariant = thm "Always_eq_UN_invariant";
   4.535 +val Always_weaken = thm "Always_weaken";
   4.536 +val Int_absorb2 = thm "Int_absorb2";
   4.537 +val Always_Constrains_pre = thm "Always_Constrains_pre";
   4.538 +val Always_Constrains_post = thm "Always_Constrains_post";
   4.539 +val Always_ConstrainsI = thm "Always_ConstrainsI";
   4.540 +val Always_ConstrainsD = thm "Always_ConstrainsD";
   4.541 +val Always_Constrains_weaken = thm "Always_Constrains_weaken";
   4.542 +val Always_Int_distrib = thm "Always_Int_distrib";
   4.543 +val Always_INT_distrib = thm "Always_INT_distrib";
   4.544 +val Always_Int_I = thm "Always_Int_I";
   4.545 +val Always_Diff_Un_eq = thm "Always_Diff_Un_eq";
   4.546 +val Always_thin = thm "Always_thin";
   4.547 +
   4.548 +(*Combines two invariance ASSUMPTIONS into one.  USEFUL??*)
   4.549 +val Always_Int_tac = dtac Always_Int_I THEN' assume_tac THEN' etac Always_thin;
   4.550 +
   4.551 +(*Combines a list of invariance THEOREMS into one.*)
   4.552 +val Always_Int_rule = foldr1 (fn (th1,th2) => [th1,th2] MRS Always_Int_I);
   4.553 +
   4.554 +(*To allow expansion of the program's definition when appropriate*)
   4.555 +val program_defs_ref = ref ([]: thm list);
   4.556 +
   4.557 +(*proves "co" properties when the program is specified*)
   4.558 +
   4.559 +fun gen_constrains_tac(cs,ss) i = 
   4.560 +   SELECT_GOAL
   4.561 +      (EVERY [REPEAT (Always_Int_tac 1),
   4.562 +              REPEAT (etac Always_ConstrainsI 1
   4.563 +                      ORELSE
   4.564 +                      resolve_tac [StableI, stableI,
   4.565 +                                   constrains_imp_Constrains] 1),
   4.566 +              rtac constrainsI 1,
   4.567 +              (* Three subgoals *)
   4.568 +              rewrite_goal_tac [st_set_def] 3,
   4.569 +              REPEAT (Force_tac 2),
   4.570 +              full_simp_tac (ss addsimps !program_defs_ref) 1,
   4.571 +              ALLGOALS (clarify_tac cs),
   4.572 +              REPEAT (FIRSTGOAL (etac disjE)),
   4.573 +              ALLGOALS Clarify_tac,
   4.574 +              REPEAT (FIRSTGOAL (etac disjE)),
   4.575 +              ALLGOALS (clarify_tac cs),
   4.576 +              ALLGOALS (asm_full_simp_tac ss),
   4.577 +              ALLGOALS (clarify_tac cs)]) i;
   4.578 +
   4.579 +fun constrains_tac st = gen_constrains_tac (claset(), simpset()) st;
   4.580 +
   4.581 +(*For proving invariants*)
   4.582 +fun always_tac i = 
   4.583 +    rtac AlwaysI i THEN Force_tac i THEN constrains_tac i;
   4.584 +*}
   4.585 +
   4.586 +method_setup constrains = {*
   4.587 +    Method.ctxt_args (fn ctxt =>
   4.588 +        Method.METHOD (fn facts =>
   4.589 +            gen_constrains_tac (local_clasimpset_of ctxt) 1)) *}
   4.590 +    "for proving safety properties"
   4.591 +
   4.592 +
   4.593  end
   4.594  
     5.1 --- a/src/ZF/UNITY/GenPrefix.ML	Sat Mar 26 18:20:29 2005 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,690 +0,0 @@
     5.4 -(*  Title:      ZF/UNITY/GenPrefix.ML
     5.5 -    ID:         $Id \\<in> GenPrefix.ML,v 1.8 2003/06/20 16:13:16 paulson Exp $
     5.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     5.7 -    Copyright   2001  University of Cambridge
     5.8 -
     5.9 -Charpentier's Generalized Prefix Relation
    5.10 -   <xs,ys>:gen_prefix(r)
    5.11 -     if ys = xs' @ zs where length(xs) = length(xs')
    5.12 -     and corresponding elements of xs, xs' are pairwise related by r
    5.13 -
    5.14 -Based on Lex/Prefix
    5.15 -*)
    5.16 -
    5.17 -Goalw [refl_def]
    5.18 - "[| refl(A, r); x \\<in> A |] ==> <x,x>:r";
    5.19 -by Auto_tac;
    5.20 -qed "reflD";
    5.21 -
    5.22 -(*** preliminary lemmas ***)
    5.23 -
    5.24 -Goal "xs \\<in> list(A) ==> <[], xs> \\<in> gen_prefix(A, r)";
    5.25 -by (dtac (rotate_prems  1 gen_prefix.append) 1);
    5.26 -by (rtac gen_prefix.Nil 1);
    5.27 -by Auto_tac;
    5.28 -qed "Nil_gen_prefix";
    5.29 -Addsimps [Nil_gen_prefix];
    5.30 -
    5.31 -
    5.32 -Goal "<xs,ys> \\<in> gen_prefix(A, r) ==> length(xs) \\<le> length(ys)";
    5.33 -by (etac gen_prefix.induct 1);
    5.34 -by (subgoal_tac "ys \\<in> list(A)" 3);
    5.35 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD]
    5.36 -                       addIs [le_trans], 
    5.37 -              simpset() addsimps [length_app]));
    5.38 -qed "gen_prefix_length_le";
    5.39 -
    5.40 -
    5.41 -Goal "[| <xs', ys'> \\<in> gen_prefix(A, r) |] \
    5.42 -\  ==> (\\<forall>x xs. x \\<in> A --> xs'= Cons(x,xs) --> \
    5.43 -\      (\\<exists>y ys. y \\<in> A & ys' = Cons(y,ys) &\
    5.44 -\      <x,y>:r & <xs, ys> \\<in> gen_prefix(A, r)))";
    5.45 -by (etac gen_prefix.induct 1);
    5.46 -by (force_tac (claset() addIs [gen_prefix.append],
    5.47 -               simpset()) 3);
    5.48 -by (REPEAT(Asm_simp_tac 1));
    5.49 -val lemma = result();
    5.50 -
    5.51 -(*As usual converting it to an elimination rule is tiresome*)
    5.52 -val major::prems = 
    5.53 -Goal "[| <Cons(x,xs), zs> \\<in> gen_prefix(A, r); \
    5.54 -\   !!y ys. [|zs = Cons(y, ys); y \\<in> A; x \\<in> A; <x,y>:r; \
    5.55 -\     <xs,ys> \\<in> gen_prefix(A, r) |] ==> P \
    5.56 -\     |] ==> P";
    5.57 -by (cut_facts_tac [major] 1);
    5.58 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
    5.59 -by (Clarify_tac 1);
    5.60 -by (etac ConsE 1);
    5.61 -by (cut_facts_tac [major RS lemma] 1);
    5.62 -by (Full_simp_tac 1);
    5.63 -by (dtac mp 1);
    5.64 -by (Asm_simp_tac 1);
    5.65 -by (REPEAT (eresolve_tac [exE, conjE] 1));
    5.66 -by (REPEAT (ares_tac prems 1));
    5.67 -qed "Cons_gen_prefixE";
    5.68 -AddSEs [Cons_gen_prefixE];
    5.69 -
    5.70 -Goal 
    5.71 -"(<Cons(x,xs),Cons(y,ys)> \\<in> gen_prefix(A, r)) \
    5.72 -\ <-> (x \\<in> A & y \\<in> A & <x,y>:r & <xs,ys> \\<in> gen_prefix(A, r))";
    5.73 -by (auto_tac (claset() addIs [gen_prefix.prepend], simpset()));
    5.74 -qed"Cons_gen_prefix_Cons";
    5.75 -AddIffs [Cons_gen_prefix_Cons];
    5.76 -
    5.77 -(** Monotonicity of gen_prefix **)
    5.78 -
    5.79 -Goal "r<=s ==> gen_prefix(A, r) <= gen_prefix(A, s)";
    5.80 -by (Clarify_tac 1);
    5.81 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
    5.82 -by (Clarify_tac 1);
    5.83 -by (etac rev_mp 1);
    5.84 -by (etac gen_prefix.induct 1);
    5.85 -by (auto_tac (claset() addIs 
    5.86 -         [gen_prefix.append], simpset()));
    5.87 -qed "gen_prefix_mono2";
    5.88 -
    5.89 -Goal "A<=B ==>gen_prefix(A, r) <= gen_prefix(B, r)";
    5.90 -by (Clarify_tac 1);
    5.91 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
    5.92 -by (Clarify_tac 1);
    5.93 -by (etac rev_mp 1);
    5.94 -by (eres_inst_tac [("P", "y \\<in> list(A)")] rev_mp 1);
    5.95 -by (eres_inst_tac [("P", "xa \\<in> list(A)")] rev_mp 1);
    5.96 -by (etac gen_prefix.induct 1);
    5.97 -by (Asm_simp_tac 1);
    5.98 -by (Clarify_tac 1);
    5.99 -by (REPEAT(etac ConsE 1));
   5.100 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD] 
   5.101 -                       addIs [gen_prefix.append, list_mono RS subsetD],
   5.102 -             simpset()));
   5.103 -qed "gen_prefix_mono1";
   5.104 -
   5.105 -Goal "[| A <= B; r <= s |] ==> gen_prefix(A, r) <= gen_prefix(B, s)";
   5.106 -by (rtac subset_trans 1);
   5.107 -by (rtac gen_prefix_mono1 1);
   5.108 -by (rtac gen_prefix_mono2 2);
   5.109 -by Auto_tac;
   5.110 -qed "gen_prefix_mono";
   5.111 -
   5.112 -(*** gen_prefix order ***)
   5.113 -
   5.114 -(* reflexivity *)
   5.115 -Goalw [refl_def] "refl(A, r) ==> refl(list(A), gen_prefix(A, r))";
   5.116 -by Auto_tac;
   5.117 -by (induct_tac "x" 1);
   5.118 -by Auto_tac;
   5.119 -qed "refl_gen_prefix";
   5.120 -Addsimps [refl_gen_prefix RS reflD];
   5.121 -
   5.122 -(* Transitivity *)
   5.123 -(* A lemma for proving gen_prefix_trans_comp *)
   5.124 -
   5.125 -Goal "xs \\<in> list(A) ==> \
   5.126 -\  \\<forall>zs. <xs @ ys, zs> \\<in> gen_prefix(A, r) --> <xs, zs>: gen_prefix(A, r)";
   5.127 -by (etac list.induct 1);
   5.128 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD], simpset()));
   5.129 -qed_spec_mp "append_gen_prefix";
   5.130 -
   5.131 -(* Lemma proving transitivity and more*)
   5.132 -
   5.133 -Goal "<x, y>: gen_prefix(A, r) ==> \
   5.134 -\  (\\<forall>z \\<in> list(A). <y,z> \\<in> gen_prefix(A, s)--><x, z> \\<in> gen_prefix(A, s O r))";
   5.135 -by (etac gen_prefix.induct 1);
   5.136 -by (auto_tac (claset() addEs [ConsE], simpset() addsimps [Nil_gen_prefix]));
   5.137 -by (subgoal_tac "ys \\<in> list(A)" 1);
   5.138 -by (blast_tac (claset() addDs [gen_prefix.dom_subset RS subsetD]) 2);
   5.139 -by (dres_inst_tac [("xs", "ys"), ("r", "s")] append_gen_prefix 1);
   5.140 -by Auto_tac;
   5.141 -qed_spec_mp "gen_prefix_trans_comp";
   5.142 -
   5.143 -Goal "trans(r) ==> r O r <= r";
   5.144 -by (auto_tac (claset() addDs [transD], simpset()));
   5.145 -qed "trans_comp_subset";
   5.146 -
   5.147 -Goal "trans(r) ==> trans(gen_prefix(A,r))";
   5.148 -by (simp_tac (simpset() addsimps [trans_def]) 1);
   5.149 -by (Clarify_tac 1);
   5.150 -by (rtac (impOfSubs (trans_comp_subset RS gen_prefix_mono2)) 1);
   5.151 - by (assume_tac 2);
   5.152 -by (rtac gen_prefix_trans_comp 1);
   5.153 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD], simpset()));
   5.154 -qed_spec_mp "trans_gen_prefix";
   5.155 -
   5.156 -Goal
   5.157 - "trans(r) ==> trans[list(A)](gen_prefix(A, r))";
   5.158 -by (dres_inst_tac [("A", "A")] trans_gen_prefix 1);
   5.159 -by (rewrite_goal_tac [trans_def, trans_on_def] 1);
   5.160 -by (Blast_tac 1);
   5.161 -qed "trans_on_gen_prefix";
   5.162 -
   5.163 -Goalw [prefix_def]
   5.164 -"[| <x,y> \\<in> prefix(A); <y, z> \\<in> gen_prefix(A, r); r<=A*A |] \
   5.165 -\ ==>  <x, z> \\<in> gen_prefix(A, r)";
   5.166 -by (res_inst_tac [("P", "%r. <x,z> \\<in> gen_prefix(A, r)")]
   5.167 -             (right_comp_id RS subst) 1);
   5.168 -by (REPEAT(blast_tac (claset() addDs [gen_prefix_trans_comp, 
   5.169 -                  gen_prefix.dom_subset RS subsetD]) 1));
   5.170 -qed_spec_mp "prefix_gen_prefix_trans";
   5.171 -
   5.172 -
   5.173 -Goalw [prefix_def]
   5.174 -"[| <x,y> \\<in> gen_prefix(A,r); <y, z> \\<in> prefix(A); r<=A*A |] \
   5.175 -\ ==>  <x, z> \\<in> gen_prefix(A, r)";
   5.176 -by (res_inst_tac [("P", "%r. <x,z> \\<in> gen_prefix(A, r)")] (left_comp_id RS subst) 1);
   5.177 -by (REPEAT(blast_tac (claset() addDs [gen_prefix_trans_comp, 
   5.178 -                                      gen_prefix.dom_subset RS subsetD]) 1));
   5.179 -qed_spec_mp "gen_prefix_prefix_trans";
   5.180 -
   5.181 -(** Antisymmetry **)
   5.182 -
   5.183 -Goal "n \\<in> nat ==> \\<forall>b \\<in> nat. n #+ b \\<le> n --> b = 0";
   5.184 -by (induct_tac "n" 1);
   5.185 -by Auto_tac;
   5.186 -qed_spec_mp "nat_le_lemma";
   5.187 -
   5.188 -Goal "antisym(r) ==> antisym(gen_prefix(A, r))";
   5.189 -by (simp_tac (simpset() addsimps [antisym_def]) 1);
   5.190 -by (rtac (impI RS allI RS allI) 1);
   5.191 -by (etac gen_prefix.induct 1);
   5.192 -by (full_simp_tac (simpset() addsimps [antisym_def]) 2);
   5.193 -by (Blast_tac 2);
   5.194 -by (Blast_tac 1);
   5.195 -(*append case is hardest*)
   5.196 -by (Clarify_tac 1);
   5.197 -by (subgoal_tac "length(zs) = 0" 1);
   5.198 -by (subgoal_tac "ys \\<in> list(A)" 1);
   5.199 -by (blast_tac (claset() addDs [gen_prefix.dom_subset RS subsetD]) 2);
   5.200 -by (dres_inst_tac [("psi", "<ys @ zs, xs> \\<in> gen_prefix(A,r)")] asm_rl 1);
   5.201 -by (Asm_full_simp_tac 1);
   5.202 -by (subgoal_tac "length(ys @ zs)  = length(ys) #+ length(zs) &ys \\<in> list(A)&xs \\<in> list(A)" 1);
   5.203 -by (blast_tac (claset() addIs [length_app] 
   5.204 -                        addDs [gen_prefix.dom_subset RS subsetD]) 2);
   5.205 -by (REPEAT (dtac gen_prefix_length_le 1));
   5.206 -by (Clarify_tac 1);
   5.207 -by (Asm_full_simp_tac 1);
   5.208 -by (dres_inst_tac [("j", "length(xs)")] le_trans 1);
   5.209 -by (Blast_tac 1);
   5.210 -by (auto_tac (claset() addIs [nat_le_lemma], simpset()));
   5.211 -qed_spec_mp "antisym_gen_prefix";
   5.212 -
   5.213 -(*** recursion equations ***)
   5.214 -
   5.215 -Goal "xs \\<in> list(A) ==> <xs, []> \\<in> gen_prefix(A,r) <-> (xs = [])";
   5.216 -by (induct_tac "xs" 1);
   5.217 -by Auto_tac;
   5.218 -qed "gen_prefix_Nil";
   5.219 -Addsimps [gen_prefix_Nil];
   5.220 -
   5.221 -Goalw [refl_def]
   5.222 - "[| refl(A, r);  xs \\<in> list(A) |] ==> \
   5.223 -\   <xs@ys, xs@zs>: gen_prefix(A, r) <-> <ys,zs> \\<in> gen_prefix(A, r)";
   5.224 -by (induct_tac "xs" 1);
   5.225 -by (ALLGOALS Asm_simp_tac);
   5.226 -qed "same_gen_prefix_gen_prefix";
   5.227 -Addsimps [same_gen_prefix_gen_prefix];
   5.228 -
   5.229 -Goal "[| xs \\<in> list(A); ys \\<in> list(A); y \\<in> A |] ==> \
   5.230 -\   <xs, Cons(y,ys)> \\<in> gen_prefix(A,r)  <-> \
   5.231 -\     (xs=[] | (\\<exists>z zs. xs=Cons(z,zs) & z \\<in> A & <z,y>:r & <zs,ys> \\<in> gen_prefix(A,r)))";
   5.232 -by (induct_tac "xs" 1);
   5.233 -by Auto_tac;
   5.234 -qed "gen_prefix_Cons";
   5.235 -
   5.236 -Goal "[| refl(A,r);  <xs,ys> \\<in> gen_prefix(A, r); zs \\<in> list(A) |] \
   5.237 -\     ==>  <xs@zs, take(length(xs), ys) @ zs> \\<in> gen_prefix(A, r)";
   5.238 -by (etac gen_prefix.induct 1);
   5.239 -by (Asm_simp_tac 1);
   5.240 -by (ALLGOALS(forward_tac [gen_prefix.dom_subset RS subsetD]));
   5.241 -by Auto_tac;
   5.242 -by (ftac gen_prefix_length_le 1);
   5.243 -by (subgoal_tac "take(length(xs), ys) \\<in> list(A)" 1);
   5.244 -by (ALLGOALS (asm_simp_tac (simpset() addsimps 
   5.245 -         [diff_is_0_iff RS iffD2, take_type ])));
   5.246 -qed "gen_prefix_take_append";
   5.247 -
   5.248 -Goal "[| refl(A, r);  <xs,ys> \\<in> gen_prefix(A,r);   \
   5.249 -\        length(xs) = length(ys); zs \\<in> list(A) |] \
   5.250 -\     ==>  <xs@zs, ys @ zs> \\<in> gen_prefix(A, r)";
   5.251 -by (dres_inst_tac [("zs", "zs")]  gen_prefix_take_append 1);
   5.252 -by (REPEAT(assume_tac 1));
   5.253 -by (subgoal_tac "take(length(xs), ys)=ys" 1);
   5.254 -by (auto_tac (claset() addSIs [take_all] 
   5.255 -                       addDs [gen_prefix.dom_subset RS subsetD], 
   5.256 -              simpset()));
   5.257 -qed "gen_prefix_append_both";
   5.258 -
   5.259 -(*NOT suitable for rewriting since [y] has the form y#ys*)
   5.260 -Goal "xs \\<in> list(A) ==> xs @ Cons(y, ys) = (xs @ [y]) @ ys";
   5.261 -by (auto_tac (claset(), simpset() addsimps [app_assoc]));
   5.262 -qed "append_cons_conv";
   5.263 -
   5.264 -Goal "[| <xs,ys> \\<in> gen_prefix(A, r);  refl(A, r) |] \
   5.265 -\     ==> length(xs) < length(ys) --> \
   5.266 -\         <xs @ [nth(length(xs), ys)], ys> \\<in> gen_prefix(A, r)";
   5.267 -by (etac gen_prefix.induct 1);
   5.268 -by (Blast_tac 1);
   5.269 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
   5.270 -by (Clarify_tac 1);
   5.271 -by (ALLGOALS(asm_full_simp_tac (simpset() addsimps [length_type])));
   5.272 -(* Append case is hardest *)
   5.273 -by (forward_tac [gen_prefix_length_le RS (le_iff RS iffD1) ] 1);
   5.274 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
   5.275 -by (Clarify_tac 1);
   5.276 -by (subgoal_tac "length(xs):nat&length(ys):nat &length(zs):nat" 1);
   5.277 -by (blast_tac (claset() addIs [length_type]) 2);
   5.278 -by (Clarify_tac 1);
   5.279 -by (ALLGOALS (asm_full_simp_tac (simpset() 
   5.280 -            addsimps [nth_append, length_type, length_app])));
   5.281 -by (Clarify_tac 1);
   5.282 -by (rtac conjI 1);
   5.283 -by (blast_tac (claset() addIs [gen_prefix.append]) 1);
   5.284 -by (thin_tac "length(xs) < length(ys) -->?u" 1);
   5.285 -by (eres_inst_tac [("a","zs")] list.elim 1);
   5.286 -by Auto_tac;  
   5.287 -by (res_inst_tac [("P1", "%x. <?u(x), ?v>:?w")] (nat_diff_split RS iffD2) 1);
   5.288 -by Auto_tac;
   5.289 -by (stac append_cons_conv 1);
   5.290 -by (rtac gen_prefix.append 2);
   5.291 -by (auto_tac (claset() addEs [ConsE],
   5.292 -              simpset() addsimps [gen_prefix_append_both]));
   5.293 -val append_one_gen_prefix_lemma = result() RS mp;
   5.294 -
   5.295 -Goal "[| <xs,ys>: gen_prefix(A, r);  length(xs) < length(ys);  refl(A, r) |] \
   5.296 -\     ==> <xs @ [nth(length(xs), ys)], ys> \\<in> gen_prefix(A, r)";
   5.297 -by (blast_tac (claset() addIs [append_one_gen_prefix_lemma]) 1);
   5.298 -qed "append_one_gen_prefix";
   5.299 -
   5.300 -
   5.301 -(** Proving the equivalence with Charpentier's definition **)
   5.302 -
   5.303 -Goal "xs \\<in> list(A) ==>  \
   5.304 -\ \\<forall>ys \\<in> list(A). \\<forall>i \\<in> nat. i < length(xs) \
   5.305 -\         --> <xs, ys>: gen_prefix(A, r) --> <nth(i, xs), nth(i, ys)>:r";
   5.306 -by (induct_tac "xs" 1);
   5.307 -by (ALLGOALS(Clarify_tac));
   5.308 -by (ALLGOALS(Asm_full_simp_tac));
   5.309 -by (etac natE 1);
   5.310 -by (ALLGOALS(Asm_full_simp_tac));
   5.311 -qed_spec_mp "gen_prefix_imp_nth_lemma";
   5.312 -
   5.313 -Goal "[| <xs,ys> \\<in> gen_prefix(A,r); i < length(xs)|] \
   5.314 -\     ==> <nth(i, xs), nth(i, ys)>:r";
   5.315 -by (cut_inst_tac [("A","A")] gen_prefix.dom_subset 1); 
   5.316 -by (rtac gen_prefix_imp_nth_lemma 1);
   5.317 -by (auto_tac (claset(), simpset() addsimps [lt_nat_in_nat]));  
   5.318 -qed "gen_prefix_imp_nth";
   5.319 -
   5.320 -Goal "xs \\<in> list(A) ==> \
   5.321 -\ \\<forall>ys \\<in> list(A). length(xs) \\<le> length(ys)  \
   5.322 -\     --> (\\<forall>i. i < length(xs) --> <nth(i, xs), nth(i,ys)>:r)  \
   5.323 -\     --> <xs, ys> \\<in> gen_prefix(A, r)";
   5.324 -by (induct_tac "xs" 1);
   5.325 -by (ALLGOALS Asm_simp_tac); 
   5.326 -by (Clarify_tac 1);
   5.327 -by (eres_inst_tac [("a","ys")] list.elim 1);
   5.328 -by (asm_full_simp_tac (simpset() addsimps []) 1);  
   5.329 -by (force_tac (claset() addSIs [nat_0_le], simpset() addsimps [lt_nat_in_nat]) 1); 
   5.330 -qed_spec_mp "nth_imp_gen_prefix";
   5.331 -
   5.332 -Goal "(<xs,ys> \\<in> gen_prefix(A,r)) <-> \
   5.333 -\     (xs \\<in> list(A) & ys \\<in> list(A) & length(xs) \\<le> length(ys) & \
   5.334 -\     (\\<forall>i. i < length(xs) --> <nth(i,xs), nth(i, ys)>: r))";
   5.335 -by (rtac iffI 1);
   5.336 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
   5.337 -by (ftac gen_prefix_length_le 1);
   5.338 -by (ALLGOALS(Clarify_tac));
   5.339 -by (rtac nth_imp_gen_prefix 2);
   5.340 -by (dtac gen_prefix_imp_nth 1);
   5.341 -by (auto_tac (claset(), simpset() addsimps [lt_nat_in_nat])); 
   5.342 -qed "gen_prefix_iff_nth";
   5.343 -
   5.344 -(** prefix is a partial order: **)
   5.345 -
   5.346 -Goalw [prefix_def] 
   5.347 -   "refl(list(A), prefix(A))";
   5.348 -by (rtac refl_gen_prefix 1);
   5.349 -by (auto_tac (claset(), simpset() addsimps [refl_def]));
   5.350 -qed "refl_prefix";
   5.351 -Addsimps [refl_prefix RS reflD];
   5.352 -
   5.353 -Goalw [prefix_def] "trans(prefix(A))";
   5.354 -by (rtac trans_gen_prefix 1);
   5.355 -by (auto_tac (claset(), simpset() addsimps [trans_def]));
   5.356 -qed "trans_prefix";
   5.357 -
   5.358 -bind_thm("prefix_trans", trans_prefix RS transD);
   5.359 -
   5.360 -Goalw [prefix_def] "trans[list(A)](prefix(A))";
   5.361 -by (rtac trans_on_gen_prefix 1);
   5.362 -by (auto_tac (claset(), simpset() addsimps [trans_def]));
   5.363 -qed "trans_on_prefix";
   5.364 -
   5.365 -bind_thm("prefix_trans_on", trans_on_prefix RS trans_onD);
   5.366 -
   5.367 -(* Monotonicity of "set" operator WRT prefix *)
   5.368 -
   5.369 -Goalw [prefix_def] 
   5.370 -"<xs,ys> \\<in> prefix(A) ==> set_of_list(xs) <= set_of_list(ys)";
   5.371 -by (etac gen_prefix.induct 1);
   5.372 -by (subgoal_tac "xs \\<in> list(A)&ys \\<in> list(A)" 3);
   5.373 -by (blast_tac (claset() addDs [gen_prefix.dom_subset RS subsetD]) 4);
   5.374 -by (auto_tac (claset(), simpset() addsimps [set_of_list_append]));
   5.375 -qed "set_of_list_prefix_mono";  
   5.376 -
   5.377 -(** recursion equations **)
   5.378 -
   5.379 -Goalw [prefix_def] "xs \\<in> list(A) ==> <[],xs> \\<in> prefix(A)";
   5.380 -by (asm_simp_tac (simpset() addsimps [Nil_gen_prefix]) 1);
   5.381 -qed "Nil_prefix";
   5.382 -Addsimps[Nil_prefix];
   5.383 -
   5.384 -
   5.385 -Goalw [prefix_def] "<xs, []> \\<in> prefix(A) <-> (xs = [])";
   5.386 -by Auto_tac;
   5.387 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
   5.388 -by (dres_inst_tac [("psi", "<xs, []> \\<in> gen_prefix(A, id(A))")] asm_rl 1);
   5.389 -by (asm_full_simp_tac (simpset() addsimps [gen_prefix_Nil]) 1);
   5.390 -qed "prefix_Nil";
   5.391 -AddIffs [prefix_Nil];
   5.392 -
   5.393 -Goalw [prefix_def] 
   5.394 -"<Cons(x,xs), Cons(y,ys)> \\<in> prefix(A) <-> (x=y & <xs,ys> \\<in> prefix(A) & y \\<in> A)";
   5.395 -by Auto_tac;
   5.396 -qed"Cons_prefix_Cons";
   5.397 -AddIffs [Cons_prefix_Cons];
   5.398 -
   5.399 -Goalw [prefix_def] 
   5.400 -"xs \\<in> list(A)==> <xs@ys,xs@zs> \\<in> prefix(A) <-> (<ys,zs> \\<in> prefix(A))";
   5.401 -by (subgoal_tac "refl(A,id(A))" 1);
   5.402 -by (Asm_simp_tac 1);
   5.403 -by (auto_tac (claset(), simpset() addsimps[refl_def]));
   5.404 -qed "same_prefix_prefix";
   5.405 -Addsimps [same_prefix_prefix];
   5.406 -
   5.407 -Goal "xs \\<in> list(A) ==> <xs@ys,xs> \\<in> prefix(A) <-> (<ys,[]> \\<in> prefix(A))";
   5.408 -by (res_inst_tac [("P", "%x. <?u, x>:?v <-> ?w(x)")] (app_right_Nil RS subst) 1);
   5.409 -by (rtac same_prefix_prefix 2);
   5.410 -by Auto_tac;
   5.411 -qed "same_prefix_prefix_Nil";
   5.412 -Addsimps [same_prefix_prefix_Nil];
   5.413 -
   5.414 -Goalw [prefix_def] 
   5.415 -"[| <xs,ys> \\<in> prefix(A); zs \\<in> list(A) |] ==> <xs,ys@zs> \\<in> prefix(A)";
   5.416 -by (etac gen_prefix.append 1);
   5.417 -by (assume_tac 1);
   5.418 -qed "prefix_appendI";
   5.419 -Addsimps [prefix_appendI];
   5.420 -
   5.421 -Goalw [prefix_def] 
   5.422 -"[| xs \\<in> list(A); ys \\<in> list(A); y \\<in> A |] ==> \
   5.423 -\ <xs,Cons(y,ys)> \\<in> prefix(A) <-> \
   5.424 -\ (xs=[] | (\\<exists>zs. xs=Cons(y,zs) & <zs,ys> \\<in> prefix(A)))";
   5.425 -by (auto_tac (claset(), simpset() addsimps [gen_prefix_Cons]));
   5.426 -qed "prefix_Cons";
   5.427 -
   5.428 -Goalw [prefix_def]
   5.429 -  "[| <xs,ys> \\<in> prefix(A); length(xs) < length(ys) |] \
   5.430 -\ ==> <xs @ [nth(length(xs),ys)], ys> \\<in> prefix(A)";
   5.431 -by (subgoal_tac "refl(A, id(A))" 1);
   5.432 -by (asm_simp_tac (simpset() addsimps [append_one_gen_prefix]) 1);
   5.433 -by (auto_tac (claset(), simpset() addsimps [refl_def]));
   5.434 -qed "append_one_prefix";
   5.435 -
   5.436 -Goalw [prefix_def] 
   5.437 -"<xs,ys> \\<in> prefix(A) ==> length(xs) \\<le> length(ys)";
   5.438 -by (blast_tac (claset() addDs [gen_prefix_length_le]) 1);
   5.439 -qed "prefix_length_le";
   5.440 -
   5.441 -Goalw [prefix_def] 
   5.442 -"<xs,ys> \\<in> prefix(A) ==> xs\\<noteq>ys --> length(xs) < length(ys)";
   5.443 -by (etac gen_prefix.induct 1);
   5.444 -by (Clarify_tac 1);
   5.445 -by (ALLGOALS(subgoal_tac "ys \\<in> list(A)&xs \\<in> list(A)"));
   5.446 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD], 
   5.447 -             simpset() addsimps [length_app, length_type]));
   5.448 -by (subgoal_tac "length(zs)=0" 1);
   5.449 -by (dtac not_lt_imp_le 2);
   5.450 -by (res_inst_tac [("j", "length(ys)")] lt_trans2 5);
   5.451 -by Auto_tac;
   5.452 -val lemma = result();
   5.453 -
   5.454 -Goalw [prefix_def]
   5.455 -"prefix(A)<=list(A)*list(A)";
   5.456 -by (blast_tac (claset() addSIs [gen_prefix.dom_subset]) 1);
   5.457 -qed "prefix_type";
   5.458 -
   5.459 -Goalw [strict_prefix_def]
   5.460 -"strict_prefix(A) <= list(A)*list(A)";
   5.461 -by (blast_tac (claset() addSIs [prefix_type RS subsetD]) 1);
   5.462 -qed "strict_prefix_type";
   5.463 -
   5.464 -Goalw [strict_prefix_def]
   5.465 - "<xs,ys>:strict_prefix(A) ==> length(xs) < length(ys)";
   5.466 -by (resolve_tac [lemma RS mp] 1);
   5.467 -by (auto_tac (claset() addDs [prefix_type RS subsetD], simpset()));
   5.468 -qed "strict_prefix_length_lt";
   5.469 -
   5.470 -(*Equivalence to the definition used in Lex/Prefix.thy*)
   5.471 -Goalw [prefix_def]
   5.472 -    "<xs,zs> \\<in> prefix(A) <-> (\\<exists>ys \\<in> list(A). zs = xs@ys) & xs \\<in> list(A)";
   5.473 -by (auto_tac (claset(),
   5.474 -       simpset() addsimps [gen_prefix_iff_nth, lt_nat_in_nat,
   5.475 -                           nth_append, nth_type, app_type, length_app]));
   5.476 -by (subgoal_tac "drop(length(xs), zs) \\<in> list(A)" 1);
   5.477 -by (res_inst_tac [("x", "drop(length(xs), zs)")] bexI 1);
   5.478 -by (ALLGOALS(Clarify_tac));
   5.479 -by (asm_simp_tac (simpset() addsimps [length_type, drop_type]) 2);
   5.480 -by (rtac nth_equalityI 1);
   5.481 -by (ALLGOALS (asm_simp_tac (simpset() addsimps 
   5.482 -           [nth_append, app_type, drop_type, length_app, length_drop])));
   5.483 -by (rtac (nat_diff_split RS iffD2) 1);
   5.484 -by (ALLGOALS(Asm_full_simp_tac));
   5.485 -by (Clarify_tac 1);
   5.486 -by (dres_inst_tac [("i", "length(zs)")] leI 1);
   5.487 -by (force_tac (claset(), simpset() addsimps [le_subset_iff]) 1);
   5.488 -by Safe_tac;
   5.489 -by (subgoal_tac "length(xs) #+ (i #- length(xs)) = i" 1);
   5.490 -by (stac nth_drop 1);
   5.491 -by (ALLGOALS(asm_simp_tac (simpset() addsimps [leI] addsplits [nat_diff_split])));
   5.492 -qed "prefix_iff";
   5.493 -
   5.494 -Goal 
   5.495 -"[|xs \\<in> list(A); ys \\<in> list(A); y \\<in> A |] ==> \
   5.496 -\  <xs, ys@[y]> \\<in> prefix(A) <-> (xs = ys@[y] | <xs,ys> \\<in> prefix(A))";
   5.497 -by (simp_tac (simpset() addsimps [prefix_iff]) 1);
   5.498 -by (rtac iffI 1);
   5.499 -by (Clarify_tac 1);
   5.500 -by (eres_inst_tac [("xs", "ysa")] rev_list_elim 1);
   5.501 -by (Asm_full_simp_tac 1);
   5.502 -by (asm_full_simp_tac (simpset() addsimps [app_type, app_assoc RS sym]) 1);
   5.503 -by (auto_tac (claset(), simpset() addsimps [app_assoc, app_type]));
   5.504 -qed "prefix_snoc";
   5.505 -Addsimps [prefix_snoc];
   5.506 -
   5.507 -Goal "zs \\<in> list(A) ==> \\<forall>xs \\<in> list(A). \\<forall>ys \\<in> list(A). \
   5.508 -\  (<xs, ys@zs> \\<in> prefix(A)) <-> \
   5.509 -\ (<xs,ys> \\<in> prefix(A) | (\\<exists>us. xs = ys@us & <us,zs> \\<in> prefix(A)))";
   5.510 -by (etac list_append_induct 1);
   5.511 -by (Clarify_tac 2);
   5.512 -by (rtac iffI 2);
   5.513 -by (asm_full_simp_tac (simpset() addsimps [app_assoc RS sym]) 2);
   5.514 -by (etac disjE 2 THEN etac disjE 3);
   5.515 -by (rtac disjI2 2);
   5.516 -by (res_inst_tac [("x", "y @ [x]")] exI 2);
   5.517 -by (asm_full_simp_tac (simpset() addsimps [app_assoc RS sym]) 2);
   5.518 -by (REPEAT(Force_tac 1));
   5.519 -qed_spec_mp "prefix_append_iff";
   5.520 -
   5.521 -
   5.522 -(*Although the prefix ordering is not linear, the prefixes of a list
   5.523 -  are linearly ordered.*)
   5.524 -Goal "[| zs \\<in> list(A); xs \\<in> list(A); ys \\<in> list(A) |] \
   5.525 -\  ==> <xs, zs> \\<in> prefix(A) --> <ys,zs> \\<in> prefix(A) \
   5.526 -\ --><xs,ys> \\<in> prefix(A) | <ys,xs> \\<in> prefix(A)";
   5.527 -by (etac list_append_induct 1);
   5.528 -by Auto_tac;
   5.529 -qed_spec_mp "common_prefix_linear_lemma";
   5.530 -
   5.531 -Goal "[|<xs, zs> \\<in> prefix(A); <ys,zs> \\<in> prefix(A) |]   \
   5.532 -\     ==> <xs,ys> \\<in> prefix(A) | <ys,xs> \\<in> prefix(A)";
   5.533 -by (cut_facts_tac [prefix_type] 1);
   5.534 -by (blast_tac (claset() delrules [disjCI] addIs [common_prefix_linear_lemma]) 1);
   5.535 -qed "common_prefix_linear";
   5.536 -
   5.537 -
   5.538 -(*** pfixLe, pfixGe \\<in> properties inherited from the translations ***)
   5.539 -
   5.540 -
   5.541 -
   5.542 -(** pfixLe **)
   5.543 -
   5.544 -Goalw [refl_def] "refl(nat,Le)";
   5.545 -by Auto_tac;
   5.546 -qed "refl_Le";
   5.547 -Addsimps [refl_Le];
   5.548 -
   5.549 -Goalw [antisym_def] "antisym(Le)";
   5.550 -by (auto_tac (claset() addIs [le_anti_sym], simpset()));
   5.551 -qed "antisym_Le";
   5.552 -Addsimps [antisym_Le];
   5.553 -
   5.554 -Goalw [trans_on_def] "trans[nat](Le)";
   5.555 -by Auto_tac;
   5.556 -by (blast_tac (claset() addIs [le_trans]) 1);
   5.557 -qed "trans_on_Le";
   5.558 -Addsimps [trans_on_Le];
   5.559 -
   5.560 -Goalw [trans_def] "trans(Le)";
   5.561 -by Auto_tac;
   5.562 -by (blast_tac (claset() addIs [le_trans]) 1);
   5.563 -qed "trans_Le";
   5.564 -Addsimps [trans_Le];
   5.565 -
   5.566 -Goalw [part_order_def] "part_order(nat,Le)";
   5.567 -by Auto_tac;
   5.568 -qed "part_order_Le";
   5.569 -Addsimps [part_order_Le];
   5.570 -
   5.571 -Goal "x \\<in> list(nat) ==> x pfixLe x";
   5.572 -by (blast_tac (claset() addIs [refl_gen_prefix RS reflD, refl_Le]) 1);
   5.573 -qed "pfixLe_refl";
   5.574 -Addsimps[pfixLe_refl];
   5.575 -
   5.576 -Goal "[| x pfixLe y; y pfixLe z |] ==> x pfixLe z";
   5.577 -by (blast_tac (claset() addIs [trans_gen_prefix RS transD, trans_Le]) 1);
   5.578 -qed "pfixLe_trans";
   5.579 -
   5.580 -Goal "[| x pfixLe y; y pfixLe x |] ==> x = y";
   5.581 -by (blast_tac (claset() addIs [antisym_gen_prefix RS antisymE, antisym_Le]) 1);
   5.582 -qed "pfixLe_antisym";
   5.583 -
   5.584 -
   5.585 -Goalw [prefix_def] 
   5.586 -"<xs,ys>:prefix(nat)==> xs pfixLe ys";
   5.587 -by (rtac (gen_prefix_mono RS subsetD) 1);
   5.588 -by Auto_tac;
   5.589 -qed "prefix_imp_pfixLe";
   5.590 -
   5.591 -Goalw [refl_def, Ge_def] "refl(nat, Ge)";
   5.592 -by Auto_tac;
   5.593 -qed "refl_Ge";
   5.594 -AddIffs [refl_Ge];
   5.595 -
   5.596 -Goalw [antisym_def, Ge_def] "antisym(Ge)";
   5.597 -by (auto_tac (claset() addIs [le_anti_sym], simpset()));
   5.598 -qed "antisym_Ge";
   5.599 -AddIffs [antisym_Ge];
   5.600 -
   5.601 -Goalw [trans_def, Ge_def] "trans(Ge)";
   5.602 -by (auto_tac (claset() addIs [le_trans], simpset()));
   5.603 -qed "trans_Ge";
   5.604 -AddIffs [trans_Ge];
   5.605 -
   5.606 -Goal "x \\<in> list(nat) ==> x pfixGe x";
   5.607 -by (blast_tac (claset() addIs [refl_gen_prefix RS reflD]) 1);
   5.608 -qed "pfixGe_refl";
   5.609 -Addsimps[pfixGe_refl];
   5.610 -
   5.611 -Goal "[| x pfixGe y; y pfixGe z |] ==> x pfixGe z";
   5.612 -by (blast_tac (claset() addIs [trans_gen_prefix RS transD]) 1);
   5.613 -qed "pfixGe_trans";
   5.614 -
   5.615 -Goal "[| x pfixGe y; y pfixGe x |] ==> x = y";
   5.616 -by (blast_tac (claset() addIs [antisym_gen_prefix RS antisymE]) 1);
   5.617 -qed "pfixGe_antisym";
   5.618 -
   5.619 -Goalw [prefix_def, Ge_def] 
   5.620 -  "<xs,ys>:prefix(nat) ==> xs pfixGe ys";
   5.621 -by (rtac (gen_prefix_mono RS subsetD) 1);
   5.622 -by Auto_tac;
   5.623 -qed "prefix_imp_pfixGe";
   5.624 -(* Added by Sidi \\<in> prefix and take *)
   5.625 -
   5.626 -Goalw [prefix_def]
   5.627 -"<xs, ys> \\<in> prefix(A) ==> xs = take(length(xs), ys)";
   5.628 -by (etac gen_prefix.induct 1);
   5.629 -by (subgoal_tac "length(xs):nat" 3);
   5.630 -by (auto_tac (claset() addDs [gen_prefix.dom_subset RS subsetD],
   5.631 -              simpset() addsimps [length_type]));
   5.632 -by (forward_tac [gen_prefix.dom_subset RS subsetD] 1);
   5.633 -by (forward_tac [gen_prefix_length_le] 1);
   5.634 -by (auto_tac (claset(), simpset() addsimps [take_append]));
   5.635 -by (subgoal_tac "length(xs) #- length(ys)=0" 1);
   5.636 -by (ALLGOALS(asm_simp_tac (simpset() addsimps [diff_is_0_iff])));
   5.637 -qed "prefix_imp_take";
   5.638 -
   5.639 -Goal "[|<xs,ys> \\<in> prefix(A); length(xs)=length(ys)|] ==> xs = ys";
   5.640 -by (cut_inst_tac [("A","A")] prefix_type 1);
   5.641 -by (dtac subsetD 1);
   5.642 -by Auto_tac;  
   5.643 -by (dtac prefix_imp_take 1); 
   5.644 -by (etac trans 1); 
   5.645 -by (Asm_full_simp_tac 1); 
   5.646 -qed "prefix_length_equal";
   5.647 -
   5.648 -Goal "[|<xs,ys> \\<in> prefix(A); length(ys) \\<le> length(xs)|] ==> xs = ys";
   5.649 -by (blast_tac (claset() addIs [prefix_length_equal, le_anti_sym, prefix_length_le]) 1); 
   5.650 -qed "prefix_length_le_equal";
   5.651 -
   5.652 -Goalw [prefix_def] "xs \\<in> list(A) ==> \\<forall>n \\<in> nat. <take(n, xs), xs> \\<in> prefix(A)";
   5.653 -by (etac list.induct 1);
   5.654 -by (Asm_full_simp_tac 1);
   5.655 -by (Clarify_tac 1); 
   5.656 -by (etac natE 1);
   5.657 -by Auto_tac;
   5.658 -qed_spec_mp "take_prefix";
   5.659 -
   5.660 -Goal "<xs,ys> \\<in> prefix(A) <-> (xs=take(length(xs), ys) & xs \\<in> list(A) & ys \\<in> list(A))";
   5.661 -by (rtac iffI 1);
   5.662 -by (forward_tac [prefix_type RS subsetD] 1);
   5.663 -by (blast_tac (claset() addIs [prefix_imp_take]) 1);
   5.664 -by (Clarify_tac 1);
   5.665 -by (etac ssubst 1);
   5.666 -by (blast_tac (claset() addIs [take_prefix, length_type]) 1);
   5.667 -qed "prefix_take_iff";
   5.668 -
   5.669 -Goal "[| <xs,ys> \\<in> prefix(A); i < length(xs)|] ==> nth(i,xs) = nth(i,ys)";
   5.670 -by (auto_tac (claset() addSDs [gen_prefix_imp_nth],
   5.671 -              simpset() addsimps [prefix_def])); 
   5.672 -qed "prefix_imp_nth";
   5.673 -
   5.674 -val prems = Goal "[|xs \\<in> list(A); ys \\<in> list(A); length(xs) \\<le> length(ys);  \
   5.675 -\       !!i. i < length(xs) ==> nth(i, xs) = nth(i,ys)|]  \
   5.676 -\     ==> <xs,ys> \\<in> prefix(A)";
   5.677 -by (auto_tac (claset(), simpset() addsimps prems@[prefix_def, nth_imp_gen_prefix]));
   5.678 -by (auto_tac (claset() addSIs [nth_imp_gen_prefix], simpset() addsimps prems@[prefix_def]));
   5.679 -by (blast_tac (claset() addIs prems@[nth_type, lt_trans2]) 1); 
   5.680 -qed "nth_imp_prefix";
   5.681 -
   5.682 -
   5.683 -Goal "[|length(xs) \\<le> length(ys); \
   5.684 -\       <xs,zs> \\<in> prefix(A); <ys,zs> \\<in> prefix(A)|] ==> <xs,ys> \\<in> prefix(A)";
   5.685 -by (cut_inst_tac [("A","A")] prefix_type 1); 
   5.686 -by (rtac nth_imp_prefix 1); 
   5.687 -   by (blast_tac (claset() addIs []) 1); 
   5.688 -  by (blast_tac (claset() addIs []) 1); 
   5.689 - by (assume_tac 1); 
   5.690 -by (res_inst_tac [("b","nth(i,zs)")] trans 1); 
   5.691 - by (blast_tac (claset() addIs [prefix_imp_nth]) 1); 
   5.692 -by (blast_tac (claset() addIs [sym, prefix_imp_nth, prefix_length_le, lt_trans2]) 1); 
   5.693 -qed "length_le_prefix_imp_prefix";
   5.694 \ No newline at end of file
     6.1 --- a/src/ZF/UNITY/GenPrefix.thy	Sat Mar 26 18:20:29 2005 +0100
     6.2 +++ b/src/ZF/UNITY/GenPrefix.thy	Mon Mar 28 16:19:56 2005 +0200
     6.3 @@ -1,9 +1,7 @@
     6.4 -(*  Title:      ZF/UNITY/GenPrefix.thy
     6.5 -    ID:         $Id$
     6.6 +(*  ID:         $Id$
     6.7      Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     6.8      Copyright   2001  University of Cambridge
     6.9  
    6.10 -Charpentier's Generalized Prefix Relation
    6.11     <xs,ys>:gen_prefix(r)
    6.12       if ys = xs' @ zs where length(xs) = length(xs')
    6.13       and corresponding elements of xs, xs' are pairwise related by r
    6.14 @@ -11,10 +9,15 @@
    6.15  Based on Lex/Prefix
    6.16  *)
    6.17  
    6.18 -GenPrefix = Main + 
    6.19 +header{*Charpentier's Generalized Prefix Relation*}
    6.20 +
    6.21 +theory GenPrefix
    6.22 +imports Main 
    6.23 +
    6.24 +begin
    6.25  
    6.26  constdefs (*really belongs in ZF/Trancl*)
    6.27 -  part_order :: [i, i] => o
    6.28 +  part_order :: "[i, i] => o"
    6.29    "part_order(A, r) == refl(A,r) & trans[A](r) & antisym(r)"
    6.30  
    6.31  consts
    6.32 @@ -25,31 +28,651 @@
    6.33    
    6.34    domains "gen_prefix(A, r)" <= "list(A)*list(A)"
    6.35    
    6.36 -  intrs
    6.37 -    Nil     "<[],[]>:gen_prefix(A, r)"
    6.38 +  intros
    6.39 +    Nil:     "<[],[]>:gen_prefix(A, r)"
    6.40  
    6.41 -    prepend "[| <xs,ys>:gen_prefix(A, r);  <x,y>:r; x:A; y:A |]
    6.42 +    prepend: "[| <xs,ys>:gen_prefix(A, r);  <x,y>:r; x:A; y:A |]
    6.43  	      ==> <Cons(x,xs), Cons(y,ys)>: gen_prefix(A, r)"
    6.44  
    6.45 -    append  "[| <xs,ys>:gen_prefix(A, r); zs:list(A) |]
    6.46 -	     ==> <xs, ys@zs>:gen_prefix(A, r)"
    6.47 -    type_intrs "list.intrs@[app_type]"
    6.48 +    append:  "[| <xs,ys>:gen_prefix(A, r); zs:list(A) |]
    6.49 +	      ==> <xs, ys@zs>:gen_prefix(A, r)"
    6.50 +    type_intros app_type list.Nil list.Cons
    6.51  
    6.52  constdefs
    6.53 -   prefix :: i=>i
    6.54 +   prefix :: "i=>i"
    6.55    "prefix(A) == gen_prefix(A, id(A))"
    6.56  
    6.57 -   strict_prefix :: i=>i  
    6.58 +   strict_prefix :: "i=>i"
    6.59    "strict_prefix(A) == prefix(A) - id(list(A))"
    6.60  
    6.61  syntax
    6.62    (* less or equal and greater or equal over prefixes *)
    6.63 -  pfixLe :: [i, i] => o               (infixl "pfixLe" 50)
    6.64 -  pfixGe :: [i, i] => o               (infixl "pfixGe" 50)
    6.65 +  pfixLe :: "[i, i] => o"               (infixl "pfixLe" 50)
    6.66 +  pfixGe :: "[i, i] => o"               (infixl "pfixGe" 50)
    6.67  
    6.68  translations
    6.69     "xs pfixLe ys" == "<xs, ys>:gen_prefix(nat, Le)"
    6.70     "xs pfixGe ys" == "<xs, ys>:gen_prefix(nat, Ge)"
    6.71    
    6.72  
    6.73 +lemma reflD: 
    6.74 + "[| refl(A, r); x \<in> A |] ==> <x,x>:r"
    6.75 +apply (unfold refl_def, auto)
    6.76 +done
    6.77 +
    6.78 +(*** preliminary lemmas ***)
    6.79 +
    6.80 +lemma Nil_gen_prefix: "xs \<in> list(A) ==> <[], xs> \<in> gen_prefix(A, r)"
    6.81 +by (drule gen_prefix.append [OF gen_prefix.Nil], simp)
    6.82 +declare Nil_gen_prefix [simp]
    6.83 +
    6.84 +
    6.85 +lemma gen_prefix_length_le: "<xs,ys> \<in> gen_prefix(A, r) ==> length(xs) \<le> length(ys)"
    6.86 +apply (erule gen_prefix.induct)
    6.87 +apply (subgoal_tac [3] "ys \<in> list (A) ")
    6.88 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
    6.89 +            intro: le_trans simp add: length_app)
    6.90 +done
    6.91 +
    6.92 +
    6.93 +lemma Cons_gen_prefix_aux:
    6.94 +  "[| <xs', ys'> \<in> gen_prefix(A, r) |]  
    6.95 +   ==> (\<forall>x xs. x \<in> A --> xs'= Cons(x,xs) -->  
    6.96 +       (\<exists>y ys. y \<in> A & ys' = Cons(y,ys) & 
    6.97 +       <x,y>:r & <xs, ys> \<in> gen_prefix(A, r)))"
    6.98 +apply (erule gen_prefix.induct)
    6.99 +prefer 3 apply (force intro: gen_prefix.append, auto) 
   6.100 +done
   6.101 +
   6.102 +lemma Cons_gen_prefixE:
   6.103 +  "[| <Cons(x,xs), zs> \<in> gen_prefix(A, r);  
   6.104 +    !!y ys. [|zs = Cons(y, ys); y \<in> A; x \<in> A; <x,y>:r;  
   6.105 +      <xs,ys> \<in> gen_prefix(A, r) |] ==> P |] ==> P"
   6.106 +apply (frule gen_prefix.dom_subset [THEN subsetD], auto) 
   6.107 +apply (blast dest: Cons_gen_prefix_aux) 
   6.108 +done
   6.109 +declare Cons_gen_prefixE [elim!]
   6.110 +
   6.111 +lemma Cons_gen_prefix_Cons: 
   6.112 +"(<Cons(x,xs),Cons(y,ys)> \<in> gen_prefix(A, r))  
   6.113 +  <-> (x \<in> A & y \<in> A & <x,y>:r & <xs,ys> \<in> gen_prefix(A, r))"
   6.114 +apply (auto intro: gen_prefix.prepend)
   6.115 +done
   6.116 +declare Cons_gen_prefix_Cons [iff]
   6.117 +
   6.118 +(** Monotonicity of gen_prefix **)
   6.119 +
   6.120 +lemma gen_prefix_mono2: "r<=s ==> gen_prefix(A, r) <= gen_prefix(A, s)"
   6.121 +apply clarify
   6.122 +apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
   6.123 +apply (erule rev_mp)
   6.124 +apply (erule gen_prefix.induct)
   6.125 +apply (auto intro: gen_prefix.append)
   6.126 +done
   6.127 +
   6.128 +lemma gen_prefix_mono1: "A<=B ==>gen_prefix(A, r) <= gen_prefix(B, r)"
   6.129 +apply clarify
   6.130 +apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
   6.131 +apply (erule rev_mp)
   6.132 +apply (erule_tac P = "y \<in> list (A) " in rev_mp)
   6.133 +apply (erule_tac P = "xa \<in> list (A) " in rev_mp)
   6.134 +apply (erule gen_prefix.induct)
   6.135 +apply (simp (no_asm_simp))
   6.136 +apply clarify
   6.137 +apply (erule ConsE)+
   6.138 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
   6.139 +            intro: gen_prefix.append list_mono [THEN subsetD])
   6.140 +done
   6.141 +
   6.142 +lemma gen_prefix_mono: "[| A <= B; r <= s |] ==> gen_prefix(A, r) <= gen_prefix(B, s)"
   6.143 +apply (rule subset_trans)
   6.144 +apply (rule gen_prefix_mono1)
   6.145 +apply (rule_tac [2] gen_prefix_mono2, auto)
   6.146 +done
   6.147 +
   6.148 +(*** gen_prefix order ***)
   6.149 +
   6.150 +(* reflexivity *)
   6.151 +lemma refl_gen_prefix: "refl(A, r) ==> refl(list(A), gen_prefix(A, r))"
   6.152 +apply (unfold refl_def, auto)
   6.153 +apply (induct_tac "x", auto)
   6.154 +done
   6.155 +declare refl_gen_prefix [THEN reflD, simp]
   6.156 +
   6.157 +(* Transitivity *)
   6.158 +(* A lemma for proving gen_prefix_trans_comp *)
   6.159 +
   6.160 +lemma append_gen_prefix [rule_format (no_asm)]: "xs \<in> list(A) ==>  
   6.161 +   \<forall>zs. <xs @ ys, zs> \<in> gen_prefix(A, r) --> <xs, zs>: gen_prefix(A, r)"
   6.162 +apply (erule list.induct)
   6.163 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD])
   6.164 +done
   6.165 +
   6.166 +(* Lemma proving transitivity and more*)
   6.167 +
   6.168 +lemma gen_prefix_trans_comp [rule_format (no_asm)]:
   6.169 +     "<x, y>: gen_prefix(A, r) ==>  
   6.170 +   (\<forall>z \<in> list(A). <y,z> \<in> gen_prefix(A, s)--><x, z> \<in> gen_prefix(A, s O r))"
   6.171 +apply (erule gen_prefix.induct)
   6.172 +apply (auto elim: ConsE simp add: Nil_gen_prefix)
   6.173 +apply (subgoal_tac "ys \<in> list (A) ")
   6.174 +prefer 2 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
   6.175 +apply (drule_tac xs = ys and r = s in append_gen_prefix, auto)
   6.176 +done
   6.177 +
   6.178 +lemma trans_comp_subset: "trans(r) ==> r O r <= r"
   6.179 +by (auto dest: transD)
   6.180 +
   6.181 +lemma trans_gen_prefix: "trans(r) ==> trans(gen_prefix(A,r))"
   6.182 +apply (simp (no_asm) add: trans_def)
   6.183 +apply clarify
   6.184 +apply (rule trans_comp_subset [THEN gen_prefix_mono2, THEN subsetD], assumption)
   6.185 +apply (rule gen_prefix_trans_comp)
   6.186 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD])
   6.187 +done
   6.188 +
   6.189 +lemma trans_on_gen_prefix: 
   6.190 + "trans(r) ==> trans[list(A)](gen_prefix(A, r))"
   6.191 +apply (drule_tac A = A in trans_gen_prefix)
   6.192 +apply (unfold trans_def trans_on_def, blast)
   6.193 +done
   6.194 +
   6.195 +lemma prefix_gen_prefix_trans:
   6.196 +    "[| <x,y> \<in> prefix(A); <y, z> \<in> gen_prefix(A, r); r<=A*A |]  
   6.197 +      ==>  <x, z> \<in> gen_prefix(A, r)"
   6.198 +apply (unfold prefix_def)
   6.199 +apply (rule_tac P = "%r. <x,z> \<in> gen_prefix (A, r) " in right_comp_id [THEN subst])
   6.200 +apply (blast dest: gen_prefix_trans_comp gen_prefix.dom_subset [THEN subsetD])+
   6.201 +done
   6.202 +
   6.203 +
   6.204 +lemma gen_prefix_prefix_trans: 
   6.205 +"[| <x,y> \<in> gen_prefix(A,r); <y, z> \<in> prefix(A); r<=A*A |]  
   6.206 +  ==>  <x, z> \<in> gen_prefix(A, r)"
   6.207 +apply (unfold prefix_def)
   6.208 +apply (rule_tac P = "%r. <x,z> \<in> gen_prefix (A, r) " in left_comp_id [THEN subst])
   6.209 +apply (blast dest: gen_prefix_trans_comp gen_prefix.dom_subset [THEN subsetD])+
   6.210 +done
   6.211 +
   6.212 +(** Antisymmetry **)
   6.213 +
   6.214 +lemma nat_le_lemma [rule_format]: "n \<in> nat ==> \<forall>b \<in> nat. n #+ b \<le> n --> b = 0"
   6.215 +by (induct_tac "n", auto)
   6.216 +
   6.217 +lemma antisym_gen_prefix: "antisym(r) ==> antisym(gen_prefix(A, r))"
   6.218 +apply (simp (no_asm) add: antisym_def)
   6.219 +apply (rule impI [THEN allI, THEN allI])
   6.220 +apply (erule gen_prefix.induct, blast) 
   6.221 +apply (simp add: antisym_def, blast)
   6.222 +txt{*append case is hardest*}
   6.223 +apply clarify
   6.224 +apply (subgoal_tac "length (zs) = 0")
   6.225 +apply (subgoal_tac "ys \<in> list (A) ")
   6.226 +prefer 2 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
   6.227 +apply (drule_tac psi = "<ys @ zs, xs> \<in> gen_prefix (A,r) " in asm_rl)
   6.228 +apply simp
   6.229 +apply (subgoal_tac "length (ys @ zs) = length (ys) #+ length (zs) &ys \<in> list (A) &xs \<in> list (A) ")
   6.230 +prefer 2 apply (blast intro: length_app dest: gen_prefix.dom_subset [THEN subsetD])
   6.231 +apply (drule gen_prefix_length_le)+
   6.232 +apply clarify
   6.233 +apply simp
   6.234 +apply (drule_tac j = "length (xs) " in le_trans)
   6.235 +apply blast
   6.236 +apply (auto intro: nat_le_lemma)
   6.237 +done
   6.238 +
   6.239 +(*** recursion equations ***)
   6.240 +
   6.241 +lemma gen_prefix_Nil: "xs \<in> list(A) ==> <xs, []> \<in> gen_prefix(A,r) <-> (xs = [])"
   6.242 +by (induct_tac "xs", auto)
   6.243 +declare gen_prefix_Nil [simp]
   6.244 +
   6.245 +lemma same_gen_prefix_gen_prefix: 
   6.246 + "[| refl(A, r);  xs \<in> list(A) |] ==>  
   6.247 +    <xs@ys, xs@zs>: gen_prefix(A, r) <-> <ys,zs> \<in> gen_prefix(A, r)"
   6.248 +apply (unfold refl_def)
   6.249 +apply (induct_tac "xs")
   6.250 +apply (simp_all (no_asm_simp))
   6.251 +done
   6.252 +declare same_gen_prefix_gen_prefix [simp]
   6.253 +
   6.254 +lemma gen_prefix_Cons: "[| xs \<in> list(A); ys \<in> list(A); y \<in> A |] ==>  
   6.255 +    <xs, Cons(y,ys)> \<in> gen_prefix(A,r)  <->  
   6.256 +      (xs=[] | (\<exists>z zs. xs=Cons(z,zs) & z \<in> A & <z,y>:r & <zs,ys> \<in> gen_prefix(A,r)))"
   6.257 +apply (induct_tac "xs", auto)
   6.258 +done
   6.259 +
   6.260 +lemma gen_prefix_take_append: "[| refl(A,r);  <xs,ys> \<in> gen_prefix(A, r); zs \<in> list(A) |]  
   6.261 +      ==>  <xs@zs, take(length(xs), ys) @ zs> \<in> gen_prefix(A, r)"
   6.262 +apply (erule gen_prefix.induct)
   6.263 +apply (simp (no_asm_simp))
   6.264 +apply (frule_tac [!] gen_prefix.dom_subset [THEN subsetD], auto)
   6.265 +apply (frule gen_prefix_length_le)
   6.266 +apply (subgoal_tac "take (length (xs), ys) \<in> list (A) ")
   6.267 +apply (simp_all (no_asm_simp) add: diff_is_0_iff [THEN iffD2] take_type)
   6.268 +done
   6.269 +
   6.270 +lemma gen_prefix_append_both: "[| refl(A, r);  <xs,ys> \<in> gen_prefix(A,r);    
   6.271 +         length(xs) = length(ys); zs \<in> list(A) |]  
   6.272 +      ==>  <xs@zs, ys @ zs> \<in> gen_prefix(A, r)"
   6.273 +apply (drule_tac zs = zs in gen_prefix_take_append, assumption+)
   6.274 +apply (subgoal_tac "take (length (xs), ys) =ys")
   6.275 +apply (auto intro!: take_all dest: gen_prefix.dom_subset [THEN subsetD])
   6.276 +done
   6.277 +
   6.278 +(*NOT suitable for rewriting since [y] has the form y#ys*)
   6.279 +lemma append_cons_conv: "xs \<in> list(A) ==> xs @ Cons(y, ys) = (xs @ [y]) @ ys"
   6.280 +by (auto simp add: app_assoc)
   6.281 +
   6.282 +lemma append_one_gen_prefix_lemma [rule_format]:
   6.283 +     "[| <xs,ys> \<in> gen_prefix(A, r);  refl(A, r) |]  
   6.284 +      ==> length(xs) < length(ys) -->  
   6.285 +          <xs @ [nth(length(xs), ys)], ys> \<in> gen_prefix(A, r)"
   6.286 +apply (erule gen_prefix.induct, blast)
   6.287 +apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
   6.288 +apply (simp_all add: length_type)
   6.289 +(* Append case is hardest *)
   6.290 +apply (frule gen_prefix_length_le [THEN le_iff [THEN iffD1]])
   6.291 +apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
   6.292 +apply (subgoal_tac "length (xs) :nat&length (ys) :nat &length (zs) :nat")
   6.293 +prefer 2 apply (blast intro: length_type, clarify)
   6.294 +apply (simp_all add: nth_append length_type length_app)
   6.295 +apply (rule conjI)
   6.296 +apply (blast intro: gen_prefix.append)
   6.297 +apply (erule_tac V = "length (xs) < length (ys) -->?u" in thin_rl)
   6.298 +apply (erule_tac a = zs in list.cases, auto)
   6.299 +apply (rule_tac P1 = "%x. <?u (x), ?v>:?w" in nat_diff_split [THEN iffD2])
   6.300 +apply auto
   6.301 +apply (simplesubst append_cons_conv)
   6.302 +apply (rule_tac [2] gen_prefix.append)
   6.303 +apply (auto elim: ConsE simp add: gen_prefix_append_both)
   6.304 +done 
   6.305 +
   6.306 +lemma append_one_gen_prefix: "[| <xs,ys>: gen_prefix(A, r);  length(xs) < length(ys);  refl(A, r) |]  
   6.307 +      ==> <xs @ [nth(length(xs), ys)], ys> \<in> gen_prefix(A, r)"
   6.308 +apply (blast intro: append_one_gen_prefix_lemma)
   6.309 +done
   6.310 +
   6.311 +
   6.312 +(** Proving the equivalence with Charpentier's definition **)
   6.313 +
   6.314 +lemma gen_prefix_imp_nth_lemma [rule_format]: "xs \<in> list(A) ==>   
   6.315 +  \<forall>ys \<in> list(A). \<forall>i \<in> nat. i < length(xs)  
   6.316 +          --> <xs, ys>: gen_prefix(A, r) --> <nth(i, xs), nth(i, ys)>:r"
   6.317 +apply (induct_tac "xs", simp, clarify) 
   6.318 +apply simp 
   6.319 +apply (erule natE, auto) 
   6.320 +done
   6.321 +
   6.322 +lemma gen_prefix_imp_nth: "[| <xs,ys> \<in> gen_prefix(A,r); i < length(xs)|]  
   6.323 +      ==> <nth(i, xs), nth(i, ys)>:r"
   6.324 +apply (cut_tac A = A in gen_prefix.dom_subset)
   6.325 +apply (rule gen_prefix_imp_nth_lemma)
   6.326 +apply (auto simp add: lt_nat_in_nat)
   6.327 +done
   6.328 +
   6.329 +lemma nth_imp_gen_prefix [rule_format]: "xs \<in> list(A) ==>  
   6.330 +  \<forall>ys \<in> list(A). length(xs) \<le> length(ys)   
   6.331 +      --> (\<forall>i. i < length(xs) --> <nth(i, xs), nth(i,ys)>:r)   
   6.332 +      --> <xs, ys> \<in> gen_prefix(A, r)"
   6.333 +apply (induct_tac "xs")
   6.334 +apply (simp_all (no_asm_simp))
   6.335 +apply clarify
   6.336 +apply (erule_tac a = ys in list.cases, simp)
   6.337 +apply (force intro!: nat_0_le simp add: lt_nat_in_nat)
   6.338 +done
   6.339 +
   6.340 +lemma gen_prefix_iff_nth: "(<xs,ys> \<in> gen_prefix(A,r)) <->  
   6.341 +      (xs \<in> list(A) & ys \<in> list(A) & length(xs) \<le> length(ys) &  
   6.342 +      (\<forall>i. i < length(xs) --> <nth(i,xs), nth(i, ys)>: r))"
   6.343 +apply (rule iffI)
   6.344 +apply (frule gen_prefix.dom_subset [THEN subsetD])
   6.345 +apply (frule gen_prefix_length_le, auto) 
   6.346 +apply (rule_tac [2] nth_imp_gen_prefix)
   6.347 +apply (drule gen_prefix_imp_nth)
   6.348 +apply (auto simp add: lt_nat_in_nat)
   6.349 +done
   6.350 +
   6.351 +(** prefix is a partial order: **)
   6.352 +
   6.353 +lemma refl_prefix: "refl(list(A), prefix(A))"
   6.354 +apply (unfold prefix_def)
   6.355 +apply (rule refl_gen_prefix)
   6.356 +apply (auto simp add: refl_def)
   6.357 +done
   6.358 +declare refl_prefix [THEN reflD, simp]
   6.359 +
   6.360 +lemma trans_prefix: "trans(prefix(A))"
   6.361 +apply (unfold prefix_def)
   6.362 +apply (rule trans_gen_prefix)
   6.363 +apply (auto simp add: trans_def)
   6.364 +done
   6.365 +
   6.366 +lemmas prefix_trans = trans_prefix [THEN transD, standard]
   6.367 +
   6.368 +lemma trans_on_prefix: "trans[list(A)](prefix(A))"
   6.369 +apply (unfold prefix_def)
   6.370 +apply (rule trans_on_gen_prefix)
   6.371 +apply (auto simp add: trans_def)
   6.372 +done
   6.373 +
   6.374 +lemmas prefix_trans_on = trans_on_prefix [THEN trans_onD, standard]
   6.375 +
   6.376 +(* Monotonicity of "set" operator WRT prefix *)
   6.377 +
   6.378 +lemma set_of_list_prefix_mono: 
   6.379 +"<xs,ys> \<in> prefix(A) ==> set_of_list(xs) <= set_of_list(ys)"
   6.380 +
   6.381 +apply (unfold prefix_def)
   6.382 +apply (erule gen_prefix.induct)
   6.383 +apply (subgoal_tac [3] "xs \<in> list (A) &ys \<in> list (A) ")
   6.384 +prefer 4 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
   6.385 +apply (auto simp add: set_of_list_append)
   6.386 +done
   6.387 +
   6.388 +(** recursion equations **)
   6.389 +
   6.390 +lemma Nil_prefix: "xs \<in> list(A) ==> <[],xs> \<in> prefix(A)"
   6.391 +
   6.392 +apply (unfold prefix_def)
   6.393 +apply (simp (no_asm_simp) add: Nil_gen_prefix)
   6.394 +done
   6.395 +declare Nil_prefix [simp]
   6.396 +
   6.397 +
   6.398 +lemma prefix_Nil: "<xs, []> \<in> prefix(A) <-> (xs = [])"
   6.399 +
   6.400 +apply (unfold prefix_def, auto)
   6.401 +apply (frule gen_prefix.dom_subset [THEN subsetD])
   6.402 +apply (drule_tac psi = "<xs, []> \<in> gen_prefix (A, id (A))" in asm_rl)
   6.403 +apply (simp add: gen_prefix_Nil)
   6.404 +done
   6.405 +declare prefix_Nil [iff]
   6.406 +
   6.407 +lemma Cons_prefix_Cons: 
   6.408 +"<Cons(x,xs), Cons(y,ys)> \<in> prefix(A) <-> (x=y & <xs,ys> \<in> prefix(A) & y \<in> A)"
   6.409 +apply (unfold prefix_def, auto)
   6.410 +done
   6.411 +declare Cons_prefix_Cons [iff]
   6.412 +
   6.413 +lemma same_prefix_prefix: 
   6.414 +"xs \<in> list(A)==> <xs@ys,xs@zs> \<in> prefix(A) <-> (<ys,zs> \<in> prefix(A))"
   6.415 +apply (unfold prefix_def)
   6.416 +apply (subgoal_tac "refl (A,id (A))")
   6.417 +apply (simp (no_asm_simp))
   6.418 +apply (auto simp add: refl_def)
   6.419 +done
   6.420 +declare same_prefix_prefix [simp]
   6.421 +
   6.422 +lemma same_prefix_prefix_Nil: "xs \<in> list(A) ==> <xs@ys,xs> \<in> prefix(A) <-> (<ys,[]> \<in> prefix(A))"
   6.423 +apply (rule_tac P = "%x. <?u, x>:?v <-> ?w (x) " in app_right_Nil [THEN subst])
   6.424 +apply (rule_tac [2] same_prefix_prefix, auto)
   6.425 +done
   6.426 +declare same_prefix_prefix_Nil [simp]
   6.427 +
   6.428 +lemma prefix_appendI: 
   6.429 +"[| <xs,ys> \<in> prefix(A); zs \<in> list(A) |] ==> <xs,ys@zs> \<in> prefix(A)"
   6.430 +apply (unfold prefix_def)
   6.431 +apply (erule gen_prefix.append, assumption)
   6.432 +done
   6.433 +declare prefix_appendI [simp]
   6.434 +
   6.435 +lemma prefix_Cons: 
   6.436 +"[| xs \<in> list(A); ys \<in> list(A); y \<in> A |] ==>  
   6.437 +  <xs,Cons(y,ys)> \<in> prefix(A) <->  
   6.438 +  (xs=[] | (\<exists>zs. xs=Cons(y,zs) & <zs,ys> \<in> prefix(A)))"
   6.439 +apply (unfold prefix_def)
   6.440 +apply (auto simp add: gen_prefix_Cons)
   6.441 +done
   6.442 +
   6.443 +lemma append_one_prefix: 
   6.444 +  "[| <xs,ys> \<in> prefix(A); length(xs) < length(ys) |]  
   6.445 +  ==> <xs @ [nth(length(xs),ys)], ys> \<in> prefix(A)"
   6.446 +apply (unfold prefix_def)
   6.447 +apply (subgoal_tac "refl (A, id (A))")
   6.448 +apply (simp (no_asm_simp) add: append_one_gen_prefix)
   6.449 +apply (auto simp add: refl_def)
   6.450 +done
   6.451 +
   6.452 +lemma prefix_length_le: 
   6.453 +"<xs,ys> \<in> prefix(A) ==> length(xs) \<le> length(ys)"
   6.454 +apply (unfold prefix_def)
   6.455 +apply (blast dest: gen_prefix_length_le)
   6.456 +done
   6.457 +
   6.458 +lemma prefix_type: "prefix(A)<=list(A)*list(A)"
   6.459 +apply (unfold prefix_def)
   6.460 +apply (blast intro!: gen_prefix.dom_subset)
   6.461 +done
   6.462 +
   6.463 +lemma strict_prefix_type: 
   6.464 +"strict_prefix(A) <= list(A)*list(A)"
   6.465 +apply (unfold strict_prefix_def)
   6.466 +apply (blast intro!: prefix_type [THEN subsetD])
   6.467 +done
   6.468 +
   6.469 +lemma strict_prefix_length_lt_aux: 
   6.470 +     "<xs,ys> \<in> prefix(A) ==> xs\<noteq>ys --> length(xs) < length(ys)"
   6.471 +apply (unfold prefix_def)
   6.472 +apply (erule gen_prefix.induct, clarify)
   6.473 +apply (subgoal_tac [!] "ys \<in> list(A) & xs \<in> list(A)")
   6.474 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
   6.475 +            simp add: length_type)
   6.476 +apply (subgoal_tac "length (zs) =0")
   6.477 +apply (drule_tac [2] not_lt_imp_le)
   6.478 +apply (rule_tac [5] j = "length (ys) " in lt_trans2)
   6.479 +apply auto
   6.480 +done
   6.481 +
   6.482 +lemma strict_prefix_length_lt: 
   6.483 +     "<xs,ys>:strict_prefix(A) ==> length(xs) < length(ys)"
   6.484 +apply (unfold strict_prefix_def)
   6.485 +apply (rule strict_prefix_length_lt_aux [THEN mp])
   6.486 +apply (auto dest: prefix_type [THEN subsetD])
   6.487 +done
   6.488 +
   6.489 +(*Equivalence to the definition used in Lex/Prefix.thy*)
   6.490 +lemma prefix_iff: 
   6.491 +    "<xs,zs> \<in> prefix(A) <-> (\<exists>ys \<in> list(A). zs = xs@ys) & xs \<in> list(A)"
   6.492 +apply (unfold prefix_def)
   6.493 +apply (auto simp add: gen_prefix_iff_nth lt_nat_in_nat nth_append nth_type app_type length_app)
   6.494 +apply (subgoal_tac "drop (length (xs), zs) \<in> list (A) ")
   6.495 +apply (rule_tac x = "drop (length (xs), zs) " in bexI)
   6.496 +apply safe
   6.497 + prefer 2 apply (simp add: length_type drop_type)
   6.498 +apply (rule nth_equalityI)
   6.499 +apply (simp_all (no_asm_simp) add: nth_append app_type drop_type length_app length_drop)
   6.500 +apply (rule nat_diff_split [THEN iffD2], simp_all, clarify)
   6.501 +apply (drule_tac i = "length (zs) " in leI)
   6.502 +apply (force simp add: le_subset_iff, safe)
   6.503 +apply (subgoal_tac "length (xs) #+ (i #- length (xs)) = i")
   6.504 +apply (subst nth_drop)
   6.505 +apply (simp_all (no_asm_simp) add: leI split add: nat_diff_split)
   6.506 +done
   6.507 +
   6.508 +lemma prefix_snoc: 
   6.509 +"[|xs \<in> list(A); ys \<in> list(A); y \<in> A |] ==>  
   6.510 +   <xs, ys@[y]> \<in> prefix(A) <-> (xs = ys@[y] | <xs,ys> \<in> prefix(A))"
   6.511 +apply (simp (no_asm) add: prefix_iff)
   6.512 +apply (rule iffI, clarify)
   6.513 +apply (erule_tac xs = ysa in rev_list_elim, simp)
   6.514 +apply (simp add: app_type app_assoc [symmetric])
   6.515 +apply (auto simp add: app_assoc app_type)
   6.516 +done
   6.517 +declare prefix_snoc [simp]
   6.518 +
   6.519 +lemma prefix_append_iff [rule_format]: "zs \<in> list(A) ==> \<forall>xs \<in> list(A). \<forall>ys \<in> list(A).  
   6.520 +   (<xs, ys@zs> \<in> prefix(A)) <->  
   6.521 +  (<xs,ys> \<in> prefix(A) | (\<exists>us. xs = ys@us & <us,zs> \<in> prefix(A)))"
   6.522 +apply (erule list_append_induct, force, clarify) 
   6.523 +apply (rule iffI) 
   6.524 +apply (simp add: add: app_assoc [symmetric])
   6.525 +apply (erule disjE)  
   6.526 +apply (rule disjI2) 
   6.527 +apply (rule_tac x = "y @ [x]" in exI) 
   6.528 +apply (simp add: add: app_assoc [symmetric], force+)
   6.529 +done
   6.530 +
   6.531 +
   6.532 +(*Although the prefix ordering is not linear, the prefixes of a list
   6.533 +  are linearly ordered.*)
   6.534 +lemma common_prefix_linear_lemma [rule_format]: "[| zs \<in> list(A); xs \<in> list(A); ys \<in> list(A) |]  
   6.535 +   ==> <xs, zs> \<in> prefix(A) --> <ys,zs> \<in> prefix(A)  
   6.536 +  --><xs,ys> \<in> prefix(A) | <ys,xs> \<in> prefix(A)"
   6.537 +apply (erule list_append_induct, auto)
   6.538 +done
   6.539 +
   6.540 +lemma common_prefix_linear: "[|<xs, zs> \<in> prefix(A); <ys,zs> \<in> prefix(A) |]    
   6.541 +      ==> <xs,ys> \<in> prefix(A) | <ys,xs> \<in> prefix(A)"
   6.542 +apply (cut_tac prefix_type)
   6.543 +apply (blast del: disjCI intro: common_prefix_linear_lemma)
   6.544 +done
   6.545 +
   6.546 +
   6.547 +(*** pfixLe, pfixGe \<in> properties inherited from the translations ***)
   6.548 +
   6.549 +
   6.550 +
   6.551 +(** pfixLe **)
   6.552 +
   6.553 +lemma refl_Le: "refl(nat,Le)"
   6.554 +
   6.555 +apply (unfold refl_def, auto)
   6.556 +done
   6.557 +declare refl_Le [simp]
   6.558 +
   6.559 +lemma antisym_Le: "antisym(Le)"
   6.560 +apply (unfold antisym_def)
   6.561 +apply (auto intro: le_anti_sym)
   6.562 +done
   6.563 +declare antisym_Le [simp]
   6.564 +
   6.565 +lemma trans_on_Le: "trans[nat](Le)"
   6.566 +apply (unfold trans_on_def, auto)
   6.567 +apply (blast intro: le_trans)
   6.568 +done
   6.569 +declare trans_on_Le [simp]
   6.570 +
   6.571 +lemma trans_Le: "trans(Le)"
   6.572 +apply (unfold trans_def, auto)
   6.573 +apply (blast intro: le_trans)
   6.574 +done
   6.575 +declare trans_Le [simp]
   6.576 +
   6.577 +lemma part_order_Le: "part_order(nat,Le)"
   6.578 +by (unfold part_order_def, auto)
   6.579 +declare part_order_Le [simp]
   6.580 +
   6.581 +lemma pfixLe_refl: "x \<in> list(nat) ==> x pfixLe x"
   6.582 +by (blast intro: refl_gen_prefix [THEN reflD] refl_Le)
   6.583 +declare pfixLe_refl [simp]
   6.584 +
   6.585 +lemma pfixLe_trans: "[| x pfixLe y; y pfixLe z |] ==> x pfixLe z"
   6.586 +by (blast intro: trans_gen_prefix [THEN transD] trans_Le)
   6.587 +
   6.588 +lemma pfixLe_antisym: "[| x pfixLe y; y pfixLe x |] ==> x = y"
   6.589 +by (blast intro: antisym_gen_prefix [THEN antisymE] antisym_Le)
   6.590 +
   6.591 +
   6.592 +lemma prefix_imp_pfixLe: 
   6.593 +"<xs,ys>:prefix(nat)==> xs pfixLe ys"
   6.594 +
   6.595 +apply (unfold prefix_def)
   6.596 +apply (rule gen_prefix_mono [THEN subsetD], auto)
   6.597 +done
   6.598 +
   6.599 +lemma refl_Ge: "refl(nat, Ge)"
   6.600 +by (unfold refl_def Ge_def, auto)
   6.601 +declare refl_Ge [iff]
   6.602 +
   6.603 +lemma antisym_Ge: "antisym(Ge)"
   6.604 +apply (unfold antisym_def Ge_def)
   6.605 +apply (auto intro: le_anti_sym)
   6.606 +done
   6.607 +declare antisym_Ge [iff]
   6.608 +
   6.609 +lemma trans_Ge: "trans(Ge)"
   6.610 +apply (unfold trans_def Ge_def)
   6.611 +apply (auto intro: le_trans)
   6.612 +done
   6.613 +declare trans_Ge [iff]
   6.614 +
   6.615 +lemma pfixGe_refl: "x \<in> list(nat) ==> x pfixGe x"
   6.616 +by (blast intro: refl_gen_prefix [THEN reflD])
   6.617 +declare pfixGe_refl [simp]
   6.618 +
   6.619 +lemma pfixGe_trans: "[| x pfixGe y; y pfixGe z |] ==> x pfixGe z"
   6.620 +by (blast intro: trans_gen_prefix [THEN transD])
   6.621 +
   6.622 +lemma pfixGe_antisym: "[| x pfixGe y; y pfixGe x |] ==> x = y"
   6.623 +by (blast intro: antisym_gen_prefix [THEN antisymE])
   6.624 +
   6.625 +lemma prefix_imp_pfixGe: 
   6.626 +  "<xs,ys>:prefix(nat) ==> xs pfixGe ys"
   6.627 +apply (unfold prefix_def Ge_def)
   6.628 +apply (rule gen_prefix_mono [THEN subsetD], auto)
   6.629 +done
   6.630 +(* Added by Sidi \<in> prefix and take *)
   6.631 +
   6.632 +lemma prefix_imp_take: 
   6.633 +"<xs, ys> \<in> prefix(A) ==> xs = take(length(xs), ys)"
   6.634 +
   6.635 +apply (unfold prefix_def)
   6.636 +apply (erule gen_prefix.induct)
   6.637 +apply (subgoal_tac [3] "length (xs) :nat")
   6.638 +apply (auto dest: gen_prefix.dom_subset [THEN subsetD] simp add: length_type)
   6.639 +apply (frule gen_prefix.dom_subset [THEN subsetD])
   6.640 +apply (frule gen_prefix_length_le)
   6.641 +apply (auto simp add: take_append)
   6.642 +apply (subgoal_tac "length (xs) #- length (ys) =0")
   6.643 +apply (simp_all (no_asm_simp) add: diff_is_0_iff)
   6.644 +done
   6.645 +
   6.646 +lemma prefix_length_equal: "[|<xs,ys> \<in> prefix(A); length(xs)=length(ys)|] ==> xs = ys"
   6.647 +apply (cut_tac A = A in prefix_type)
   6.648 +apply (drule subsetD, auto)
   6.649 +apply (drule prefix_imp_take)
   6.650 +apply (erule trans, simp)
   6.651 +done
   6.652 +
   6.653 +lemma prefix_length_le_equal: "[|<xs,ys> \<in> prefix(A); length(ys) \<le> length(xs)|] ==> xs = ys"
   6.654 +by (blast intro: prefix_length_equal le_anti_sym prefix_length_le)
   6.655 +
   6.656 +lemma take_prefix [rule_format]: "xs \<in> list(A) ==> \<forall>n \<in> nat. <take(n, xs), xs> \<in> prefix(A)"
   6.657 +apply (unfold prefix_def)
   6.658 +apply (erule list.induct, simp, clarify)
   6.659 +apply (erule natE, auto)
   6.660 +done
   6.661 +
   6.662 +lemma prefix_take_iff: "<xs,ys> \<in> prefix(A) <-> (xs=take(length(xs), ys) & xs \<in> list(A) & ys \<in> list(A))"
   6.663 +apply (rule iffI)
   6.664 +apply (frule prefix_type [THEN subsetD])
   6.665 +apply (blast intro: prefix_imp_take, clarify)
   6.666 +apply (erule ssubst)
   6.667 +apply (blast intro: take_prefix length_type)
   6.668 +done
   6.669 +
   6.670 +lemma prefix_imp_nth: "[| <xs,ys> \<in> prefix(A); i < length(xs)|] ==> nth(i,xs) = nth(i,ys)"
   6.671 +by (auto dest!: gen_prefix_imp_nth simp add: prefix_def)
   6.672 +
   6.673 +lemma nth_imp_prefix: 
   6.674 +     "[|xs \<in> list(A); ys \<in> list(A); length(xs) \<le> length(ys);   
   6.675 +        !!i. i < length(xs) ==> nth(i, xs) = nth(i,ys)|]   
   6.676 +      ==> <xs,ys> \<in> prefix(A)"
   6.677 +apply (auto simp add: prefix_def nth_imp_gen_prefix)
   6.678 +apply (auto intro!: nth_imp_gen_prefix simp add: prefix_def)
   6.679 +apply (blast intro: nth_type lt_trans2)
   6.680 +done
   6.681 +
   6.682 +
   6.683 +lemma length_le_prefix_imp_prefix: "[|length(xs) \<le> length(ys);  
   6.684 +        <xs,zs> \<in> prefix(A); <ys,zs> \<in> prefix(A)|] ==> <xs,ys> \<in> prefix(A)"
   6.685 +apply (cut_tac A = A in prefix_type)
   6.686 +apply (rule nth_imp_prefix, blast, blast)
   6.687 + apply assumption
   6.688 +apply (rule_tac b = "nth (i,zs)" in trans)
   6.689 + apply (blast intro: prefix_imp_nth)
   6.690 +apply (blast intro: sym prefix_imp_nth prefix_length_le lt_trans2)
   6.691 +done
   6.692 +
   6.693  end
     7.1 --- a/src/ZF/UNITY/Mutex.ML	Sat Mar 26 18:20:29 2005 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,243 +0,0 @@
     7.4 -(*  Title:      ZF/UNITY/Mutex.ML
     7.5 -    ID:         $Id \\<in> Mutex.ML,v 1.4 2003/05/27 09:39:05 paulson Exp $
     7.6 -    Author:     Sidi O Ehmety, Computer Laboratory
     7.7 -    Copyright   2001  University of Cambridge
     7.8 -
     7.9 -Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
    7.10 -
    7.11 -Variables' types are introduced globally so that type verification
    7.12 -reduces to the usual ZF typechecking \\<in> an ill-tyed expression will
    7.13 -reduce to the empty set.
    7.14 -
    7.15 -*)
    7.16 -
    7.17 -(** Variables' types **)
    7.18 -
    7.19 -Addsimps  [p_type, u_type, v_type, m_type, n_type];
    7.20 -
    7.21 -Goalw [state_def] "s \\<in> state ==>s`u \\<in> bool";
    7.22 -by (dres_inst_tac [("a", "u")] apply_type 1);
    7.23 -by Auto_tac;
    7.24 -qed "u_value_type";
    7.25 -
    7.26 -Goalw [state_def] "s \\<in> state ==> s`v \\<in> bool";
    7.27 -by (dres_inst_tac [("a", "v")] apply_type 1);
    7.28 -by Auto_tac;
    7.29 -qed "v_value_type";
    7.30 -
    7.31 -Goalw [state_def] "s \\<in> state ==> s`p \\<in> bool";
    7.32 -by (dres_inst_tac [("a", "p")] apply_type 1);
    7.33 -by Auto_tac;
    7.34 -qed "p_value_type";
    7.35 -
    7.36 -Goalw [state_def] "s \\<in> state ==> s`m \\<in> int";
    7.37 -by (dres_inst_tac [("a", "m")] apply_type 1);
    7.38 -by Auto_tac;
    7.39 -qed "m_value_type";
    7.40 -
    7.41 -Goalw [state_def] "s \\<in> state ==>s`n \\<in> int";
    7.42 -by (dres_inst_tac [("a", "n")] apply_type 1);
    7.43 -by Auto_tac;
    7.44 -qed "n_value_type";
    7.45 -
    7.46 -Addsimps [p_value_type, u_value_type, v_value_type,
    7.47 -          m_value_type, n_value_type];
    7.48 -AddTCs [p_value_type, u_value_type, v_value_type,
    7.49 -          m_value_type, n_value_type];
    7.50 -(** Mutex is a program **)
    7.51 -
    7.52 -Goalw [Mutex_def] "Mutex \\<in> program";
    7.53 -by Auto_tac;
    7.54 -qed "Mutex_in_program";
    7.55 -Addsimps [Mutex_in_program];
    7.56 -AddTCs [Mutex_in_program];
    7.57 -
    7.58 -Addsimps [Mutex_def RS def_prg_Init];
    7.59 -program_defs_ref := [Mutex_def];
    7.60 -
    7.61 -Addsimps (map simp_of_act
    7.62 -          [U0_def, U1_def, U2_def, U3_def, U4_def, 
    7.63 -           V0_def, V1_def, V2_def, V3_def, V4_def]);
    7.64 -
    7.65 -Addsimps (map simp_of_set [U0_def, U1_def, U2_def, U3_def, U4_def, 
    7.66 -           V0_def, V1_def, V2_def, V3_def, V4_def]);
    7.67 -
    7.68 -Addsimps (map simp_of_set [IU_def, IV_def, bad_IU_def]);
    7.69 -
    7.70 -Goal "Mutex \\<in> Always(IU)";
    7.71 -by (always_tac 1);
    7.72 -by Auto_tac;
    7.73 -qed "IU";
    7.74 -
    7.75 -Goal "Mutex \\<in> Always(IV)";
    7.76 -by (always_tac 1);
    7.77 -qed "IV";
    7.78 -
    7.79 -(*The safety property \\<in> mutual exclusion*)
    7.80 -Goal "Mutex \\<in> Always({s \\<in> state. ~(s`m = #3 & s`n = #3)})";
    7.81 -by (rtac ([IU, IV] MRS Always_Int_I RS Always_weaken) 1);
    7.82 -by Auto_tac;
    7.83 -qed "mutual_exclusion";
    7.84 -
    7.85 -(*The bad invariant FAILS in V1*)
    7.86 -
    7.87 -Goal "[| x$<#1; #3 $<= x |] ==> P";
    7.88 -by (dres_inst_tac [("j", "#1"), ("k", "#3")]  zless_zle_trans 1);
    7.89 -by (dres_inst_tac [("j", "x")]  zle_zless_trans 2);
    7.90 -by Auto_tac;
    7.91 -qed "less_lemma";
    7.92 -
    7.93 -Goal "Mutex \\<in> Always(bad_IU)";
    7.94 -by (always_tac 1);
    7.95 -by (auto_tac (claset(), simpset() addsimps [not_zle_iff_zless]));
    7.96 -by (auto_tac (claset(), simpset() addsimps [bool_def]));
    7.97 -by (subgoal_tac "#1 $<= #3" 1);
    7.98 -by (dres_inst_tac [("x", "#1"), ("y", "#3")] zle_trans 1);
    7.99 -by Auto_tac;
   7.100 -by (simp_tac (simpset() addsimps [not_zless_iff_zle RS iff_sym]) 1);
   7.101 -by Auto_tac;
   7.102 -(*Resulting state \\<in> n=1, p=false, m=4, u=false.  
   7.103 -  Execution of V1 (the command of process v guarded by n=1) sets p:=true,
   7.104 -  violating the invariant!*)
   7.105 -(*Check that subgoals remain: proof failed.*)
   7.106 -getgoal 1;
   7.107 -
   7.108 -
   7.109 -(*** Progress for U ***)
   7.110 -
   7.111 -Goalw [Unless_def] 
   7.112 -"Mutex \\<in> {s \\<in> state. s`m=#2} Unless {s \\<in> state. s`m=#3}";
   7.113 -by (constrains_tac 1);
   7.114 -qed "U_F0";
   7.115 -
   7.116 -Goal "Mutex \\<in> {s \\<in> state. s`m=#1} LeadsTo {s \\<in> state. s`p = s`v & s`m = #2}";
   7.117 -by (ensures_tac "U1" 1);
   7.118 -qed "U_F1";
   7.119 -
   7.120 -Goal "Mutex \\<in> {s \\<in> state. s`p =0 & s`m = #2} LeadsTo {s \\<in> state. s`m = #3}";
   7.121 -by (cut_facts_tac [IU] 1);
   7.122 -by (ensures_tac "U2" 1);
   7.123 -qed "U_F2";
   7.124 -
   7.125 -Goal "Mutex \\<in> {s \\<in> state. s`m = #3} LeadsTo {s \\<in> state. s`p=1}";
   7.126 -by (res_inst_tac [("B", "{s \\<in> state. s`m = #4}")] LeadsTo_Trans 1);
   7.127 -by (ensures_tac "U4" 2);
   7.128 -by (ensures_tac "U3" 1);
   7.129 -qed "U_F3";
   7.130 -
   7.131 -
   7.132 -Goal "Mutex \\<in> {s \\<in> state. s`m = #2} LeadsTo {s \\<in> state. s`p=1}";
   7.133 -by (rtac ([LeadsTo_weaken_L, Int_lower2 RS subset_imp_LeadsTo] 
   7.134 -          MRS LeadsTo_Diff) 1);
   7.135 -by (rtac ([U_F2, U_F3] MRS LeadsTo_Trans) 1);
   7.136 -by Auto_tac;
   7.137 -by (auto_tac (claset() addSDs [p_value_type], simpset() addsimps [bool_def]));
   7.138 -val U_lemma2 = result();
   7.139 -
   7.140 -Goal "Mutex \\<in> {s \\<in> state. s`m = #1} LeadsTo {s \\<in> state. s`p =1}";
   7.141 -by (rtac ([U_F1 RS LeadsTo_weaken_R, U_lemma2] MRS LeadsTo_Trans) 1);
   7.142 -by Auto_tac;
   7.143 -val U_lemma1 = result();
   7.144 -
   7.145 -Goal "i \\<in> int ==> (#1 $<= i & i $<= #3) <-> (i=#1 | i=#2 | i=#3)";
   7.146 -by Auto_tac;
   7.147 -by (auto_tac (claset(), simpset() addsimps [neq_iff_zless]));
   7.148 -by (dres_inst_tac [("j", "#3"), ("i", "i")] zle_zless_trans 4);
   7.149 -by (dres_inst_tac [("j", "i"), ("i", "#1")] zle_zless_trans 2);
   7.150 -by (dres_inst_tac [("j", "i"), ("i", "#1")] zle_zless_trans 1);
   7.151 -by Auto_tac;
   7.152 -by (rtac zle_anti_sym 1);
   7.153 -by (ALLGOALS(asm_simp_tac (simpset()
   7.154 -      addsimps [zless_add1_iff_zle RS iff_sym])));
   7.155 -qed "eq_123";
   7.156 -
   7.157 -
   7.158 -Goal "Mutex \\<in> {s \\<in> state. #1 $<= s`m & s`m $<= #3} LeadsTo {s \\<in> state. s`p=1}";
   7.159 -by (simp_tac (simpset() addsimps [m_value_type RS eq_123, Collect_disj_eq,
   7.160 -                                  LeadsTo_Un_distrib,
   7.161 -                                  U_lemma1, U_lemma2, U_F3] ) 1);
   7.162 -val U_lemma123 = result();
   7.163 -
   7.164 -
   7.165 -(*Misra's F4*)
   7.166 -Goal "Mutex \\<in> {s \\<in> state. s`u = 1} LeadsTo {s \\<in> state. s`p=1}";
   7.167 -by (rtac ([IU, U_lemma123] MRS Always_LeadsTo_weaken) 1);
   7.168 -by Auto_tac;
   7.169 -qed "u_Leadsto_p";
   7.170 -
   7.171 -
   7.172 -(*** Progress for V ***)
   7.173 -
   7.174 -Goalw [Unless_def] 
   7.175 -"Mutex \\<in> {s \\<in> state. s`n=#2} Unless {s \\<in> state. s`n=#3}";
   7.176 -by (constrains_tac 1);
   7.177 -qed "V_F0";
   7.178 -
   7.179 -Goal "Mutex \\<in> {s \\<in> state. s`n=#1} LeadsTo {s \\<in> state. s`p = not(s`u) & s`n = #2}";
   7.180 -by (ensures_tac "V1" 1);
   7.181 -qed "V_F1";
   7.182 -
   7.183 -Goal "Mutex \\<in> {s \\<in> state. s`p=1 & s`n = #2} LeadsTo {s \\<in> state. s`n = #3}";
   7.184 -by (cut_facts_tac [IV] 1);
   7.185 -by (ensures_tac "V2" 1);
   7.186 -qed "V_F2";
   7.187 -
   7.188 -Goal "Mutex \\<in> {s \\<in> state. s`n = #3} LeadsTo {s \\<in> state. s`p=0}";
   7.189 -by (res_inst_tac [("B", "{s \\<in> state. s`n = #4}")] LeadsTo_Trans 1);
   7.190 -by (ensures_tac "V4" 2);
   7.191 -by (ensures_tac "V3" 1);
   7.192 -qed "V_F3";
   7.193 -
   7.194 -Goal "Mutex \\<in> {s \\<in> state. s`n = #2} LeadsTo {s \\<in> state. s`p=0}";
   7.195 -by (rtac ([LeadsTo_weaken_L, Int_lower2 RS subset_imp_LeadsTo] 
   7.196 -          MRS LeadsTo_Diff) 1);
   7.197 -by (rtac ([V_F2, V_F3] MRS LeadsTo_Trans) 1);
   7.198 -by Auto_tac;
   7.199 -by (auto_tac (claset() addSDs [p_value_type], simpset() addsimps [bool_def]));
   7.200 -val V_lemma2 = result();
   7.201 -
   7.202 -Goal "Mutex \\<in> {s \\<in> state. s`n = #1} LeadsTo {s \\<in> state. s`p = 0}";
   7.203 -by (rtac ([V_F1 RS LeadsTo_weaken_R, V_lemma2] MRS LeadsTo_Trans) 1);
   7.204 -by Auto_tac;
   7.205 -val V_lemma1 = result();
   7.206 -
   7.207 -Goal "Mutex \\<in> {s \\<in> state. #1 $<= s`n & s`n $<= #3} LeadsTo {s \\<in> state. s`p = 0}";
   7.208 -by (simp_tac (simpset() addsimps 
   7.209 -     [n_value_type RS eq_123, Collect_disj_eq, LeadsTo_Un_distrib,
   7.210 -                  V_lemma1, V_lemma2, V_F3] ) 1);
   7.211 -val V_lemma123 = result();
   7.212 -
   7.213 -(*Misra's F4*)
   7.214 -Goal "Mutex \\<in> {s \\<in> state. s`v = 1} LeadsTo {s \\<in> state. s`p = 0}";
   7.215 -by (rtac ([IV, V_lemma123] MRS Always_LeadsTo_weaken) 1);
   7.216 -by Auto_tac;
   7.217 -qed "v_Leadsto_not_p";
   7.218 -
   7.219 -(** Absence of starvation **)
   7.220 -
   7.221 -(*Misra's F6*)
   7.222 -Goal "Mutex \\<in> {s \\<in> state. s`m = #1} LeadsTo {s \\<in> state. s`m = #3}";
   7.223 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
   7.224 -by (rtac U_F2 2);
   7.225 -by (simp_tac (simpset() addsimps [Collect_conj_eq] ) 1);
   7.226 -by (stac Un_commute 1);
   7.227 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
   7.228 -by (rtac ([v_Leadsto_not_p, U_F0] MRS PSP_Unless) 2);
   7.229 -by (rtac (U_F1 RS LeadsTo_weaken_R) 1);
   7.230 -by Auto_tac;
   7.231 -by (auto_tac (claset() addSDs [v_value_type], simpset() addsimps [bool_def]));
   7.232 -qed "m1_Leadsto_3";
   7.233 -
   7.234 -
   7.235 -(*The same for V*)
   7.236 -Goal "Mutex \\<in> {s \\<in> state. s`n = #1} LeadsTo {s \\<in> state. s`n = #3}";
   7.237 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
   7.238 -by (rtac V_F2 2);
   7.239 -by (simp_tac (simpset() addsimps [Collect_conj_eq] ) 1);
   7.240 -by (stac Un_commute 1);
   7.241 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
   7.242 -by (rtac ([u_Leadsto_p, V_F0] MRS PSP_Unless) 2);
   7.243 -by (rtac (V_F1 RS LeadsTo_weaken_R) 1);
   7.244 -by Auto_tac;
   7.245 -by (auto_tac (claset() addSDs [u_value_type], simpset() addsimps [bool_def]));
   7.246 -qed "n1_Leadsto_3";
     8.1 --- a/src/ZF/UNITY/Mutex.thy	Sat Mar 26 18:20:29 2005 +0100
     8.2 +++ b/src/ZF/UNITY/Mutex.thy	Mon Mar 28 16:19:56 2005 +0200
     8.3 @@ -1,17 +1,26 @@
     8.4 -(*  Title:      ZF/UNITY/Mutex.thy
     8.5 -    ID:         $Id$
     8.6 +(*  ID:         $Id$
     8.7      Author:     Sidi O Ehmety, Computer Laboratory
     8.8      Copyright   2001  University of Cambridge
     8.9 -
    8.10 -Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
    8.11 -
    8.12 -Variables' types are introduced globally so that type verification
    8.13 -reduces to the usual ZF typechecking: an ill-tyed expressions reduce to the empty set.
    8.14  *)
    8.15  
    8.16 -Mutex = SubstAx + 
    8.17 +header{*Mutual Exclusion*}
    8.18 +
    8.19 +theory Mutex
    8.20 +imports SubstAx
    8.21 +begin
    8.22 +
    8.23 +text{*Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
    8.24 +
    8.25 +Variables' types are introduced globally so that type verification reduces to
    8.26 +the usual ZF typechecking: an ill-tyed expressions reduce to the empty set.
    8.27 +*}
    8.28 +
    8.29  consts
    8.30 -  p, m, n, u, v :: i
    8.31 +  p :: i
    8.32 +  m :: i
    8.33 +  n :: i
    8.34 +  u :: i
    8.35 +  v :: i
    8.36    
    8.37  translations
    8.38    "p" == "Var([0])"
    8.39 @@ -20,12 +29,12 @@
    8.40    "u" == "Var([0,1])"
    8.41    "v" == "Var([1,0])"
    8.42    
    8.43 -rules (** Type declarations  **)
    8.44 -  p_type  "type_of(p)=bool & default_val(p)=0"
    8.45 -  m_type  "type_of(m)=int  & default_val(m)=#0"
    8.46 -  n_type  "type_of(n)=int  & default_val(n)=#0"
    8.47 -  u_type  "type_of(u)=bool & default_val(u)=0"
    8.48 -  v_type  "type_of(v)=bool & default_val(v)=0"
    8.49 +axioms --{** Type declarations  **}
    8.50 +  p_type:  "type_of(p)=bool & default_val(p)=0"
    8.51 +  m_type:  "type_of(m)=int  & default_val(m)=#0"
    8.52 +  n_type:  "type_of(n)=int  & default_val(n)=#0"
    8.53 +  u_type:  "type_of(u)=bool & default_val(u)=0"
    8.54 +  v_type:  "type_of(v)=bool & default_val(v)=0"
    8.55    
    8.56  constdefs
    8.57    (** The program for process U **)
    8.58 @@ -82,4 +91,256 @@
    8.59      "bad_IU == {s:state. (s`u = 1 <-> (#1 $<= s`m & s`m  $<= #3))&
    8.60                     (#3 $<= s`m & s`m $<= #4 --> s`p=0)}"
    8.61  
    8.62 +
    8.63 +(*  Title:      ZF/UNITY/Mutex.ML
    8.64 +    ID:         $Id \<in> Mutex.ML,v 1.4 2003/05/27 09:39:05 paulson Exp $
    8.65 +    Author:     Sidi O Ehmety, Computer Laboratory
    8.66 +    Copyright   2001  University of Cambridge
    8.67 +
    8.68 +Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
    8.69 +
    8.70 +Variables' types are introduced globally so that type verification
    8.71 +reduces to the usual ZF typechecking \<in> an ill-tyed expression will
    8.72 +reduce to the empty set.
    8.73 +
    8.74 +*)
    8.75 +
    8.76 +(** Variables' types **)
    8.77 +
    8.78 +declare p_type [simp] u_type [simp] v_type [simp] m_type [simp] n_type [simp]
    8.79 +
    8.80 +lemma u_value_type: "s \<in> state ==>s`u \<in> bool"
    8.81 +apply (unfold state_def)
    8.82 +apply (drule_tac a = u in apply_type, auto)
    8.83 +done
    8.84 +
    8.85 +lemma v_value_type: "s \<in> state ==> s`v \<in> bool"
    8.86 +apply (unfold state_def)
    8.87 +apply (drule_tac a = v in apply_type, auto)
    8.88 +done
    8.89 +
    8.90 +lemma p_value_type: "s \<in> state ==> s`p \<in> bool"
    8.91 +apply (unfold state_def)
    8.92 +apply (drule_tac a = p in apply_type, auto)
    8.93 +done
    8.94 +
    8.95 +lemma m_value_type: "s \<in> state ==> s`m \<in> int"
    8.96 +apply (unfold state_def)
    8.97 +apply (drule_tac a = m in apply_type, auto)
    8.98 +done
    8.99 +
   8.100 +lemma n_value_type: "s \<in> state ==>s`n \<in> int"
   8.101 +apply (unfold state_def)
   8.102 +apply (drule_tac a = n in apply_type, auto)
   8.103 +done
   8.104 +
   8.105 +declare p_value_type [simp] u_value_type [simp] v_value_type [simp]
   8.106 +        m_value_type [simp] n_value_type [simp]
   8.107 +
   8.108 +declare p_value_type [TC] u_value_type [TC] v_value_type [TC]
   8.109 +        m_value_type [TC] n_value_type [TC]
   8.110 +
   8.111 +
   8.112 +
   8.113 +text{*Mutex is a program*}
   8.114 +
   8.115 +lemma Mutex_in_program [simp,TC]: "Mutex \<in> program"
   8.116 +by (simp add: Mutex_def)
   8.117 +
   8.118 +
   8.119 +method_setup constrains = {*
   8.120 +    Method.ctxt_args (fn ctxt =>
   8.121 +        Method.METHOD (fn facts => 
   8.122 +            gen_constrains_tac (local_clasimpset_of ctxt) 1)) *}
   8.123 +    "for proving safety properties"
   8.124 +
   8.125 +
   8.126 +declare Mutex_def [THEN def_prg_Init, simp]
   8.127 +ML
   8.128 +{*
   8.129 +program_defs_ref := [thm"Mutex_def"]
   8.130 +*}
   8.131 +
   8.132 +declare  U0_def [THEN def_act_simp, simp]
   8.133 +declare  U1_def [THEN def_act_simp, simp]
   8.134 +declare  U2_def [THEN def_act_simp, simp]
   8.135 +declare  U3_def [THEN def_act_simp, simp]
   8.136 +declare  U4_def [THEN def_act_simp, simp]
   8.137 +
   8.138 +declare  V0_def [THEN def_act_simp, simp]
   8.139 +declare  V1_def [THEN def_act_simp, simp]
   8.140 +declare  V2_def [THEN def_act_simp, simp]
   8.141 +declare  V3_def [THEN def_act_simp, simp]
   8.142 +declare  V4_def [THEN def_act_simp, simp]
   8.143 +
   8.144 +declare  U0_def [THEN def_set_simp, simp]
   8.145 +declare  U1_def [THEN def_set_simp, simp]
   8.146 +declare  U2_def [THEN def_set_simp, simp]
   8.147 +declare  U3_def [THEN def_set_simp, simp]
   8.148 +declare  U4_def [THEN def_set_simp, simp]
   8.149 +
   8.150 +declare  V0_def [THEN def_set_simp, simp]
   8.151 +declare  V1_def [THEN def_set_simp, simp]
   8.152 +declare  V2_def [THEN def_set_simp, simp]
   8.153 +declare  V3_def [THEN def_set_simp, simp]
   8.154 +declare  V4_def [THEN def_set_simp, simp]
   8.155 +
   8.156 +declare  IU_def [THEN def_set_simp, simp]
   8.157 +declare  IV_def [THEN def_set_simp, simp]
   8.158 +declare  bad_IU_def [THEN def_set_simp, simp]
   8.159 +
   8.160 +lemma IU: "Mutex \<in> Always(IU)"
   8.161 +apply (rule AlwaysI, force) 
   8.162 +apply (unfold Mutex_def, constrains, auto) 
   8.163 +done
   8.164 +
   8.165 +lemma IV: "Mutex \<in> Always(IV)"
   8.166 +apply (rule AlwaysI, force) 
   8.167 +apply (unfold Mutex_def, constrains) 
   8.168 +done
   8.169 +
   8.170 +(*The safety property: mutual exclusion*)
   8.171 +lemma mutual_exclusion: "Mutex \<in> Always({s \<in> state. ~(s`m = #3 & s`n = #3)})"
   8.172 +apply (rule Always_weaken) 
   8.173 +apply (rule Always_Int_I [OF IU IV], auto)
   8.174 +done
   8.175 +
   8.176 +(*The bad invariant FAILS in V1*)
   8.177 +
   8.178 +lemma less_lemma: "[| x$<#1; #3 $<= x |] ==> P"
   8.179 +apply (drule_tac j = "#1" and k = "#3" in zless_zle_trans)
   8.180 +apply (drule_tac [2] j = x in zle_zless_trans, auto)
   8.181 +done
   8.182 +
   8.183 +lemma "Mutex \<in> Always(bad_IU)"
   8.184 +apply (rule AlwaysI, force) 
   8.185 +apply (unfold Mutex_def, constrains, auto)
   8.186 +apply (subgoal_tac "#1 $<= #3")
   8.187 +apply (drule_tac x = "#1" and y = "#3" in zle_trans, auto)
   8.188 +apply (simp (no_asm) add: not_zless_iff_zle [THEN iff_sym])
   8.189 +apply auto
   8.190 +(*Resulting state: n=1, p=false, m=4, u=false.  
   8.191 +  Execution of V1 (the command of process v guarded by n=1) sets p:=true,
   8.192 +  violating the invariant!*)
   8.193 +oops
   8.194 +
   8.195 +
   8.196 +
   8.197 +(*** Progress for U ***)
   8.198 +
   8.199 +lemma U_F0: "Mutex \<in> {s \<in> state. s`m=#2} Unless {s \<in> state. s`m=#3}"
   8.200 +by (unfold Unless_def Mutex_def, constrains)
   8.201 +
   8.202 +lemma U_F1:
   8.203 +     "Mutex \<in> {s \<in> state. s`m=#1} LeadsTo {s \<in> state. s`p = s`v & s`m = #2}"
   8.204 +by (unfold Mutex_def, ensures_tac U1)
   8.205 +
   8.206 +lemma U_F2: "Mutex \<in> {s \<in> state. s`p =0 & s`m = #2} LeadsTo {s \<in> state. s`m = #3}"
   8.207 +apply (cut_tac IU)
   8.208 +apply (unfold Mutex_def, ensures_tac U2)
   8.209 +done
   8.210 +
   8.211 +lemma U_F3: "Mutex \<in> {s \<in> state. s`m = #3} LeadsTo {s \<in> state. s`p=1}"
   8.212 +apply (rule_tac B = "{s \<in> state. s`m = #4}" in LeadsTo_Trans)
   8.213 + apply (unfold Mutex_def)
   8.214 + apply (ensures_tac U3)
   8.215 +apply (ensures_tac U4)
   8.216 +done
   8.217 +
   8.218 +
   8.219 +lemma U_lemma2: "Mutex \<in> {s \<in> state. s`m = #2} LeadsTo {s \<in> state. s`p=1}"
   8.220 +apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
   8.221 +                             Int_lower2 [THEN subset_imp_LeadsTo]])
   8.222 +apply (rule LeadsTo_Trans [OF U_F2 U_F3], auto)
   8.223 +apply (auto dest!: p_value_type simp add: bool_def)
   8.224 +done
   8.225 +
   8.226 +lemma U_lemma1: "Mutex \<in> {s \<in> state. s`m = #1} LeadsTo {s \<in> state. s`p =1}"
   8.227 +by (rule LeadsTo_Trans [OF U_F1 [THEN LeadsTo_weaken_R] U_lemma2], blast)
   8.228 +
   8.229 +lemma eq_123: "i \<in> int ==> (#1 $<= i & i $<= #3) <-> (i=#1 | i=#2 | i=#3)"
   8.230 +apply auto
   8.231 +apply (auto simp add: neq_iff_zless)
   8.232 +apply (drule_tac [4] j = "#3" and i = i in zle_zless_trans)
   8.233 +apply (drule_tac [2] j = i and i = "#1" in zle_zless_trans)
   8.234 +apply (drule_tac j = i and i = "#1" in zle_zless_trans, auto)
   8.235 +apply (rule zle_anti_sym)
   8.236 +apply (simp_all (no_asm_simp) add: zless_add1_iff_zle [THEN iff_sym])
   8.237 +done
   8.238 +
   8.239 +
   8.240 +lemma U_lemma123: "Mutex \<in> {s \<in> state. #1 $<= s`m & s`m $<= #3} LeadsTo {s \<in> state. s`p=1}"
   8.241 +by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib U_lemma1 U_lemma2 U_F3)
   8.242 +
   8.243 +
   8.244 +(*Misra's F4*)
   8.245 +lemma u_Leadsto_p: "Mutex \<in> {s \<in> state. s`u = 1} LeadsTo {s \<in> state. s`p=1}"
   8.246 +by (rule Always_LeadsTo_weaken [OF IU U_lemma123], auto)
   8.247 +
   8.248 +
   8.249 +(*** Progress for V ***)
   8.250 +
   8.251 +lemma V_F0: "Mutex \<in> {s \<in> state. s`n=#2} Unless {s \<in> state. s`n=#3}"
   8.252 +by (unfold Unless_def Mutex_def, constrains)
   8.253 +
   8.254 +lemma V_F1: "Mutex \<in> {s \<in> state. s`n=#1} LeadsTo {s \<in> state. s`p = not(s`u) & s`n = #2}"
   8.255 +by (unfold Mutex_def, ensures_tac "V1")
   8.256 +
   8.257 +lemma V_F2: "Mutex \<in> {s \<in> state. s`p=1 & s`n = #2} LeadsTo {s \<in> state. s`n = #3}"
   8.258 +apply (cut_tac IV)
   8.259 +apply (unfold Mutex_def, ensures_tac "V2")
   8.260 +done
   8.261 +
   8.262 +lemma V_F3: "Mutex \<in> {s \<in> state. s`n = #3} LeadsTo {s \<in> state. s`p=0}"
   8.263 +apply (rule_tac B = "{s \<in> state. s`n = #4}" in LeadsTo_Trans)
   8.264 + apply (unfold Mutex_def)
   8.265 + apply (ensures_tac V3)
   8.266 +apply (ensures_tac V4)
   8.267 +done
   8.268 +
   8.269 +lemma V_lemma2: "Mutex \<in> {s \<in> state. s`n = #2} LeadsTo {s \<in> state. s`p=0}"
   8.270 +apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
   8.271 +                             Int_lower2 [THEN subset_imp_LeadsTo]])
   8.272 +apply (rule LeadsTo_Trans [OF V_F2 V_F3], auto) 
   8.273 +apply (auto dest!: p_value_type simp add: bool_def)
   8.274 +done
   8.275 +
   8.276 +lemma V_lemma1: "Mutex \<in> {s \<in> state. s`n = #1} LeadsTo {s \<in> state. s`p = 0}"
   8.277 +by (rule LeadsTo_Trans [OF V_F1 [THEN LeadsTo_weaken_R] V_lemma2], blast)
   8.278 +
   8.279 +lemma V_lemma123: "Mutex \<in> {s \<in> state. #1 $<= s`n & s`n $<= #3} LeadsTo {s \<in> state. s`p = 0}"
   8.280 +by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib V_lemma1 V_lemma2 V_F3)
   8.281 +
   8.282 +(*Misra's F4*)
   8.283 +lemma v_Leadsto_not_p: "Mutex \<in> {s \<in> state. s`v = 1} LeadsTo {s \<in> state. s`p = 0}"
   8.284 +by (rule Always_LeadsTo_weaken [OF IV V_lemma123], auto)
   8.285 +
   8.286 +
   8.287 +(** Absence of starvation **)
   8.288 +
   8.289 +(*Misra's F6*)
   8.290 +lemma m1_Leadsto_3: "Mutex \<in> {s \<in> state. s`m = #1} LeadsTo {s \<in> state. s`m = #3}"
   8.291 +apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
   8.292 +apply (rule_tac [2] U_F2)
   8.293 +apply (simp add: Collect_conj_eq)
   8.294 +apply (subst Un_commute)
   8.295 +apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
   8.296 + apply (rule_tac [2] PSP_Unless [OF v_Leadsto_not_p U_F0])
   8.297 +apply (rule U_F1 [THEN LeadsTo_weaken_R], auto)
   8.298 +apply (auto dest!: v_value_type simp add: bool_def)
   8.299 +done
   8.300 +
   8.301 +
   8.302 +(*The same for V*)
   8.303 +lemma n1_Leadsto_3: "Mutex \<in> {s \<in> state. s`n = #1} LeadsTo {s \<in> state. s`n = #3}"
   8.304 +apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
   8.305 +apply (rule_tac [2] V_F2)
   8.306 +apply (simp add: Collect_conj_eq)
   8.307 +apply (subst Un_commute)
   8.308 +apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
   8.309 + apply (rule_tac [2] PSP_Unless [OF u_Leadsto_p V_F0])
   8.310 +apply (rule V_F1 [THEN LeadsTo_weaken_R], auto)
   8.311 +apply (auto dest!: u_value_type simp add: bool_def)
   8.312 +done
   8.313 +
   8.314  end
   8.315 \ No newline at end of file
     9.1 --- a/src/ZF/UNITY/SubstAx.ML	Sat Mar 26 18:20:29 2005 +0100
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,416 +0,0 @@
     9.4 -(*  Title:      ZF/UNITY/SubstAx.ML
     9.5 -    ID:         $Id \\<in> SubstAx.ML,v 1.8 2003/05/27 09:39:06 paulson Exp $
     9.6 -    Author:     Sidi O Ehmety, Computer Laboratory
     9.7 -    Copyright   2001  University of Cambridge
     9.8 -
     9.9 -LeadsTo relation, restricted to the set of reachable states.
    9.10 -
    9.11 -*)
    9.12 -
    9.13 -
    9.14 -(*Resembles the previous definition of LeadsTo*)
    9.15 -
    9.16 -(* Equivalence with the HOL-like definition *)
    9.17 -Goalw [LeadsTo_def]
    9.18 -"st_set(B)==> A LeadsTo B = {F \\<in> program. F:(reachable(F) Int A) leadsTo B}";
    9.19 -by (blast_tac (claset() addDs [psp_stable2, leadsToD2, constrainsD2] 
    9.20 -                        addIs [leadsTo_weaken]) 1);
    9.21 -qed "LeadsTo_eq";
    9.22 -
    9.23 -Goalw [LeadsTo_def] "A LeadsTo B <=program";
    9.24 -by Auto_tac;
    9.25 -qed "LeadsTo_type";
    9.26 -
    9.27 -(*** Specialized laws for handling invariants ***)
    9.28 -
    9.29 -(** Conjoining an Always property **)
    9.30 -Goal "F \\<in> Always(I) ==> (F:(I Int A) LeadsTo A') <-> (F \\<in> A LeadsTo A')";
    9.31 -by (asm_full_simp_tac
    9.32 -    (simpset() addsimps [LeadsTo_def, Always_eq_includes_reachable,
    9.33 -              Int_absorb2, Int_assoc RS sym, leadsToD2]) 1);
    9.34 -qed "Always_LeadsTo_pre";
    9.35 -
    9.36 -Goalw [LeadsTo_def] "F \\<in> Always(I) ==> (F \\<in> A LeadsTo (I Int A')) <-> (F \\<in> A LeadsTo A')";
    9.37 -by (asm_full_simp_tac (simpset() addsimps [Always_eq_includes_reachable, 
    9.38 -          Int_absorb2, Int_assoc RS sym,leadsToD2]) 1);
    9.39 -qed "Always_LeadsTo_post";
    9.40 -
    9.41 -(* Like 'Always_LeadsTo_pre RS iffD1', but with premises in the good order *)
    9.42 -Goal "[| F \\<in> Always(C); F \\<in> (C Int A) LeadsTo A' |] ==> F \\<in> A LeadsTo A'";
    9.43 -by (blast_tac (claset() addIs [Always_LeadsTo_pre RS iffD1]) 1);
    9.44 -qed "Always_LeadsToI";
    9.45 -
    9.46 -(* Like 'Always_LeadsTo_post RS iffD2', but with premises in the good order *)
    9.47 -Goal "[| F \\<in> Always(C);  F \\<in> A LeadsTo A' |] ==> F \\<in> A LeadsTo (C Int A')";
    9.48 -by (blast_tac (claset() addIs [Always_LeadsTo_post RS iffD2]) 1);
    9.49 -qed "Always_LeadsToD";
    9.50 -
    9.51 -(*** Introduction rules \\<in> Basis, Trans, Union ***)
    9.52 -
    9.53 -Goal "F \\<in> A Ensures B ==> F \\<in> A LeadsTo B";
    9.54 -by (auto_tac (claset(), simpset() addsimps 
    9.55 -                   [Ensures_def, LeadsTo_def]));
    9.56 -qed "LeadsTo_Basis";
    9.57 -
    9.58 -Goal "[| F \\<in> A LeadsTo B;  F \\<in> B LeadsTo C |] ==> F \\<in> A LeadsTo C";
    9.59 -by (full_simp_tac (simpset() addsimps [LeadsTo_def]) 1);
    9.60 -by (blast_tac (claset() addIs [leadsTo_Trans]) 1);
    9.61 -qed "LeadsTo_Trans";
    9.62 -
    9.63 -val [major, program] = Goalw [LeadsTo_def]
    9.64 -"[|(!!A. A \\<in> S ==> F \\<in> A LeadsTo B); F \\<in> program|]==>F \\<in> Union(S) LeadsTo B";
    9.65 -by (cut_facts_tac [program] 1);
    9.66 -by Auto_tac;
    9.67 -by (stac Int_Union_Union2 1);
    9.68 -by (rtac leadsTo_UN 1);
    9.69 -by (dtac major 1);
    9.70 -by Auto_tac;
    9.71 -qed "LeadsTo_Union";
    9.72 -
    9.73 -(*** Derived rules ***)
    9.74 -
    9.75 -Goal "F \\<in> A leadsTo B ==> F \\<in> A LeadsTo B";
    9.76 -by (ftac leadsToD2 1);
    9.77 -by (Clarify_tac 1);
    9.78 -by (asm_simp_tac (simpset() addsimps [LeadsTo_eq]) 1);
    9.79 -by (blast_tac (claset() addIs [leadsTo_weaken_L]) 1);
    9.80 -qed "leadsTo_imp_LeadsTo";
    9.81 -
    9.82 -(*Useful with cancellation, disjunction*)
    9.83 -Goal "F \\<in> A LeadsTo (A' Un A') ==> F \\<in> A LeadsTo A'";
    9.84 -by (asm_full_simp_tac (simpset() addsimps Un_ac) 1);
    9.85 -qed "LeadsTo_Un_duplicate";
    9.86 -
    9.87 -Goal "F \\<in> A LeadsTo (A' Un C Un C) ==> F \\<in> A LeadsTo (A' Un C)";
    9.88 -by (asm_full_simp_tac (simpset() addsimps Un_ac) 1);
    9.89 -qed "LeadsTo_Un_duplicate2";
    9.90 -
    9.91 -val [major, program] = Goalw [LeadsTo_def] 
    9.92 -"[|(!!i. i \\<in> I ==> F \\<in> A(i) LeadsTo B); F \\<in> program|]==>F:(\\<Union>i \\<in> I. A(i)) LeadsTo B";
    9.93 -by (cut_facts_tac [program] 1);
    9.94 -by (asm_simp_tac (simpset() delsimps UN_simps addsimps [Int_UN_distrib]) 1);
    9.95 -by (rtac leadsTo_UN 1);
    9.96 -by (dtac major 1);
    9.97 -by Auto_tac;
    9.98 -qed "LeadsTo_UN";
    9.99 -
   9.100 -(*Binary union introduction rule*)
   9.101 -Goal "[| F \\<in> A LeadsTo C; F \\<in> B LeadsTo C |] ==> F \\<in> (A Un B) LeadsTo C";
   9.102 -by (stac Un_eq_Union 1);
   9.103 -by (rtac LeadsTo_Union 1);
   9.104 -by (auto_tac (claset() addDs [LeadsTo_type RS subsetD], simpset()));
   9.105 -qed "LeadsTo_Un";
   9.106 -
   9.107 -(*Lets us look at the starting state*)
   9.108 -val [major, program] = Goal 
   9.109 -"[|(!!s. s \\<in> A ==> F:{s} LeadsTo B); F \\<in> program|]==>F \\<in> A LeadsTo B";
   9.110 -by (cut_facts_tac [program] 1);
   9.111 -by (stac (UN_singleton RS sym) 1 THEN rtac LeadsTo_UN 1);
   9.112 -by (ftac major 1);
   9.113 -by Auto_tac;
   9.114 -qed "single_LeadsTo_I";
   9.115 -
   9.116 -Goal "[| A <= B; F \\<in> program |] ==> F \\<in> A LeadsTo B";
   9.117 -by (asm_simp_tac (simpset() addsimps [LeadsTo_def]) 1);
   9.118 -by (blast_tac (claset() addIs [subset_imp_leadsTo]) 1);
   9.119 -qed "subset_imp_LeadsTo";
   9.120 -
   9.121 -Goal "F:0 LeadsTo A <-> F \\<in> program";
   9.122 -by (auto_tac (claset() addDs [LeadsTo_type RS subsetD]
   9.123 -                       addIs [empty_subsetI RS subset_imp_LeadsTo], simpset()));
   9.124 -qed "empty_LeadsTo";
   9.125 -AddIffs [empty_LeadsTo];
   9.126 -
   9.127 -Goal "F \\<in> A LeadsTo state <-> F \\<in> program";
   9.128 -by (auto_tac (claset() addDs [LeadsTo_type RS subsetD], 
   9.129 -              simpset() addsimps [LeadsTo_eq]));
   9.130 -qed "LeadsTo_state";
   9.131 -AddIffs [LeadsTo_state];
   9.132 -
   9.133 -Goalw [LeadsTo_def]
   9.134 - "[| F \\<in> A LeadsTo A';  A'<=B'|] ==> F \\<in> A LeadsTo B'";
   9.135 -by (auto_tac (claset() addIs[leadsTo_weaken_R], simpset()));
   9.136 -qed_spec_mp "LeadsTo_weaken_R";
   9.137 -
   9.138 -Goalw [LeadsTo_def] "[| F \\<in> A LeadsTo A'; B <= A |] ==> F \\<in> B LeadsTo A'";
   9.139 -by (auto_tac (claset() addIs[leadsTo_weaken_L], simpset()));
   9.140 -qed_spec_mp "LeadsTo_weaken_L";
   9.141 -
   9.142 -Goal "[| F \\<in> A LeadsTo A'; B<=A; A'<=B' |] ==> F \\<in> B LeadsTo B'";
   9.143 -by (blast_tac (claset() addIs [LeadsTo_weaken_R, 
   9.144 -                    LeadsTo_weaken_L, LeadsTo_Trans]) 1);
   9.145 -qed "LeadsTo_weaken";
   9.146 -
   9.147 -Goal 
   9.148 -"[| F \\<in> Always(C);  F \\<in> A LeadsTo A'; C Int B <= A;   C Int A' <= B' |] \
   9.149 -\     ==> F \\<in> B LeadsTo B'";
   9.150 -by (blast_tac (claset() addDs [Always_LeadsToI]
   9.151 -                        addIs [LeadsTo_weaken, Always_LeadsToD]) 1);
   9.152 -qed "Always_LeadsTo_weaken";
   9.153 -
   9.154 -(** Two theorems for "proof lattices" **)
   9.155 -
   9.156 -Goal "F \\<in> A LeadsTo B ==> F:(A Un B) LeadsTo B";
   9.157 -by (blast_tac (claset() addDs [LeadsTo_type RS subsetD]
   9.158 -                         addIs [LeadsTo_Un, subset_imp_LeadsTo]) 1);
   9.159 -qed "LeadsTo_Un_post";
   9.160 -
   9.161 -Goal "[| F \\<in> A LeadsTo B;  F \\<in> B LeadsTo C |] \
   9.162 -\     ==> F \\<in> (A Un B) LeadsTo C";
   9.163 -by (blast_tac (claset() addIs [LeadsTo_Un, subset_imp_LeadsTo, 
   9.164 -                               LeadsTo_weaken_L, LeadsTo_Trans]
   9.165 -                        addDs [LeadsTo_type RS subsetD]) 1);
   9.166 -qed "LeadsTo_Trans_Un";
   9.167 -
   9.168 -(** Distributive laws **)
   9.169 -Goal "(F \\<in> (A Un B) LeadsTo C)  <-> (F \\<in> A LeadsTo C & F \\<in> B LeadsTo C)";
   9.170 -by (blast_tac (claset() addIs [LeadsTo_Un, LeadsTo_weaken_L]) 1);
   9.171 -qed "LeadsTo_Un_distrib";
   9.172 -
   9.173 -Goal "(F \\<in> (\\<Union>i \\<in> I. A(i)) LeadsTo B) <->  (\\<forall>i \\<in> I. F \\<in> A(i) LeadsTo B) & F \\<in> program";
   9.174 -by (blast_tac (claset() addDs [LeadsTo_type RS subsetD]
   9.175 -                        addIs [LeadsTo_UN, LeadsTo_weaken_L]) 1);
   9.176 -qed "LeadsTo_UN_distrib";
   9.177 -
   9.178 -Goal "(F \\<in> Union(S) LeadsTo B)  <->  (\\<forall>A \\<in> S. F \\<in> A LeadsTo B) & F \\<in> program";
   9.179 -by (blast_tac (claset() addDs [LeadsTo_type RS subsetD] 
   9.180 -                        addIs [LeadsTo_Union, LeadsTo_weaken_L]) 1);
   9.181 -qed "LeadsTo_Union_distrib";
   9.182 -
   9.183 -(** More rules using the premise "Always(I)" **)
   9.184 -
   9.185 -Goal "[| F:(A-B) Co (A Un B);  F \\<in> transient (A-B) |] ==> F \\<in> A Ensures B";
   9.186 -by (asm_full_simp_tac
   9.187 -    (simpset() addsimps [Ensures_def, Constrains_eq_constrains]) 1);
   9.188 -by (blast_tac (claset() addIs [ensuresI, constrains_weaken, 
   9.189 -                               transient_strengthen]
   9.190 -                        addDs [constrainsD2]) 1);
   9.191 -qed "EnsuresI";
   9.192 -
   9.193 -Goal "[| F \\<in> Always(I); F \\<in> (I Int (A-A')) Co (A Un A'); \
   9.194 -\        F \\<in> transient (I Int (A-A')) |]   \
   9.195 -\ ==> F \\<in> A LeadsTo A'";
   9.196 -by (rtac Always_LeadsToI 1);
   9.197 -by (assume_tac 1);
   9.198 -by (blast_tac (claset() addIs [EnsuresI, LeadsTo_Basis,
   9.199 -                               Always_ConstrainsD RS Constrains_weaken, 
   9.200 -                               transient_strengthen]) 1);
   9.201 -qed "Always_LeadsTo_Basis";
   9.202 -
   9.203 -(*Set difference \\<in> maybe combine with leadsTo_weaken_L??
   9.204 -  This is the most useful form of the "disjunction" rule*)
   9.205 -Goal "[| F \\<in> (A-B) LeadsTo C;  F \\<in> (A Int B) LeadsTo C |] ==> F \\<in> A LeadsTo C";
   9.206 -by (blast_tac (claset() addIs [LeadsTo_Un, LeadsTo_weaken]) 1);
   9.207 -qed "LeadsTo_Diff";
   9.208 -
   9.209 -val [major, minor] = Goal 
   9.210 -"[|(!!i. i \\<in> I ==> F \\<in> A(i) LeadsTo A'(i)); F \\<in> program |] \
   9.211 -\     ==> F \\<in> (\\<Union>i \\<in> I. A(i)) LeadsTo (\\<Union>i \\<in> I. A'(i))";
   9.212 -by (cut_facts_tac [minor] 1);
   9.213 -by (rtac LeadsTo_Union 1);
   9.214 -by (ALLGOALS(Clarify_tac));
   9.215 -by (ftac major 1);
   9.216 -by (blast_tac (claset()  addIs [LeadsTo_weaken_R]) 1);
   9.217 -qed "LeadsTo_UN_UN";
   9.218 -
   9.219 -(*Binary union version*)
   9.220 -Goal "[| F \\<in> A LeadsTo A'; F \\<in> B LeadsTo B' |] ==> F:(A Un B) LeadsTo (A' Un B')";
   9.221 -by (blast_tac (claset() addIs [LeadsTo_Un, LeadsTo_weaken_R]) 1);
   9.222 -qed "LeadsTo_Un_Un";
   9.223 -
   9.224 -(** The cancellation law **)
   9.225 -
   9.226 -Goal "[| F \\<in> A LeadsTo(A' Un B); F \\<in> B LeadsTo B' |] ==> F \\<in> A LeadsTo (A' Un B')";
   9.227 -by (blast_tac (claset() addIs [LeadsTo_Un_Un, subset_imp_LeadsTo, LeadsTo_Trans]
   9.228 -                        addDs [LeadsTo_type RS subsetD]) 1);
   9.229 -qed "LeadsTo_cancel2";
   9.230 -
   9.231 -Goal "A Un (B - A) = A Un B";
   9.232 -by Auto_tac;
   9.233 -qed "Un_Diff";
   9.234 -
   9.235 -Goal "[| F \\<in> A LeadsTo (A' Un B); F \\<in> (B-A') LeadsTo B' |] ==> F \\<in> A LeadsTo (A' Un B')";
   9.236 -by (rtac LeadsTo_cancel2 1);
   9.237 -by (assume_tac 2);
   9.238 -by (asm_simp_tac (simpset() addsimps [Un_Diff]) 1);
   9.239 -qed "LeadsTo_cancel_Diff2";
   9.240 -
   9.241 -Goal "[| F \\<in> A LeadsTo (B Un A'); F \\<in> B LeadsTo B' |] ==> F \\<in> A LeadsTo (B' Un A')";
   9.242 -by (asm_full_simp_tac (simpset() addsimps [Un_commute]) 1);
   9.243 -by (blast_tac (claset() addSIs [LeadsTo_cancel2]) 1);
   9.244 -qed "LeadsTo_cancel1";
   9.245 -
   9.246 -Goal "(B - A) Un A = B Un A";
   9.247 -by Auto_tac;
   9.248 -qed "Diff_Un2";
   9.249 -
   9.250 -Goal "[| F \\<in> A LeadsTo (B Un A'); F \\<in> (B-A') LeadsTo B' |] ==> F \\<in> A LeadsTo (B' Un A')";
   9.251 -by (rtac LeadsTo_cancel1 1);
   9.252 -by (assume_tac 2);
   9.253 -by (asm_simp_tac (simpset() addsimps [Diff_Un2]) 1);
   9.254 -qed "LeadsTo_cancel_Diff1";
   9.255 -
   9.256 -(** The impossibility law **)
   9.257 -
   9.258 -(*The set "A" may be non-empty, but it contains no reachable states*)
   9.259 -Goal "F \\<in> A LeadsTo 0 ==> F \\<in> Always (state -A)";
   9.260 -by (full_simp_tac (simpset() 
   9.261 -           addsimps [LeadsTo_def,Always_eq_includes_reachable]) 1);
   9.262 -by (cut_facts_tac [reachable_type] 1);
   9.263 -by (auto_tac (claset() addSDs [leadsTo_empty], simpset()));
   9.264 -qed "LeadsTo_empty";
   9.265 -
   9.266 -(** PSP \\<in> Progress-Safety-Progress **)
   9.267 -
   9.268 -(*Special case of PSP \\<in> Misra's "stable conjunction"*)
   9.269 -Goal "[| F \\<in> A LeadsTo A';  F \\<in> Stable(B) |]==> F:(A Int B) LeadsTo (A' Int B)";
   9.270 -by (asm_full_simp_tac (simpset() addsimps [LeadsTo_def, Stable_eq_stable]) 1);
   9.271 -by (Clarify_tac 1);
   9.272 -by (dtac psp_stable 1);
   9.273 -by (REPEAT(asm_full_simp_tac (simpset() addsimps (Int_absorb::Int_ac)) 1));
   9.274 -qed "PSP_Stable";
   9.275 -
   9.276 -Goal "[| F \\<in> A LeadsTo A'; F \\<in> Stable(B) |] ==> F \\<in> (B Int A) LeadsTo (B Int A')";
   9.277 -by (asm_simp_tac (simpset() addsimps PSP_Stable::Int_ac) 1);
   9.278 -qed "PSP_Stable2";
   9.279 -
   9.280 -Goal "[| F \\<in> A LeadsTo A'; F \\<in> B Co B'|]==> F \\<in> (A Int B') LeadsTo ((A' Int B) Un (B' - B))";
   9.281 -by (full_simp_tac (simpset() addsimps [LeadsTo_def, Constrains_eq_constrains]) 1);
   9.282 -by (blast_tac (claset() addDs [psp] addIs [leadsTo_weaken]) 1);
   9.283 -qed "PSP";
   9.284 -
   9.285 -Goal "[| F \\<in> A LeadsTo A'; F \\<in> B Co B' |]==> F:(B' Int A) LeadsTo ((B Int A') Un (B' - B))";
   9.286 -by (asm_simp_tac (simpset() addsimps PSP::Int_ac) 1);
   9.287 -qed "PSP2";
   9.288 -
   9.289 -Goal
   9.290 -"[| F \\<in> A LeadsTo A'; F \\<in> B Unless B'|]==> F:(A Int B) LeadsTo ((A' Int B) Un B')";
   9.291 -by (rewtac Unless_def);
   9.292 -by (dtac PSP 1);
   9.293 -by (assume_tac 1);
   9.294 -by (blast_tac (claset() addIs [LeadsTo_Diff, LeadsTo_weaken, subset_imp_LeadsTo]) 1);
   9.295 -qed "PSP_Unless";
   9.296 -
   9.297 -(*** Induction rules ***)
   9.298 -
   9.299 -(** Meta or object quantifier ????? **)
   9.300 -Goal "[| wf(r);     \
   9.301 -\        \\<forall>m \\<in> I. F \\<in> (A Int f-``{m}) LeadsTo                     \
   9.302 -\                           ((A Int f-``(converse(r) `` {m})) Un B); \
   9.303 -\        field(r)<=I; A<=f-``I; F \\<in> program |] \
   9.304 -\     ==> F \\<in> A LeadsTo B";
   9.305 -by (full_simp_tac (simpset() addsimps [LeadsTo_def]) 1);
   9.306 -by Auto_tac; 
   9.307 -by (eres_inst_tac [("I", "I"), ("f", "f")] leadsTo_wf_induct 1);
   9.308 -by (ALLGOALS(Clarify_tac));
   9.309 -by (dres_inst_tac [("x", "m")] bspec 2);
   9.310 -by Safe_tac;
   9.311 -by (res_inst_tac [("A'", 
   9.312 -                   "reachable(F) Int (A Int f -``(converse(r)``{m}) Un B)")]
   9.313 -    leadsTo_weaken_R 2);
   9.314 -by (asm_simp_tac (simpset() addsimps [Int_assoc]) 2);
   9.315 -by (asm_simp_tac (simpset() addsimps [Int_assoc]) 3);
   9.316 -by (REPEAT(Blast_tac 1));
   9.317 -qed "LeadsTo_wf_induct";
   9.318 -
   9.319 -
   9.320 -Goal "[| \\<forall>m \\<in> nat. F:(A Int f-``{m}) LeadsTo ((A Int f-``m) Un B); \
   9.321 -\     A<=f-``nat; F \\<in> program |] ==> F \\<in> A LeadsTo B";
   9.322 -by (res_inst_tac [("A1", "nat"),("f1", "%x. x")]
   9.323 -        (wf_measure RS LeadsTo_wf_induct) 1);
   9.324 -by (ALLGOALS(asm_full_simp_tac 
   9.325 -          (simpset() addsimps [nat_measure_field])));
   9.326 -by (asm_simp_tac (simpset() addsimps [ltI, Image_inverse_lessThan, symmetric vimage_def]) 1);
   9.327 -qed "LessThan_induct";
   9.328 -
   9.329 -
   9.330 -(****** 
   9.331 - To be ported ??? I am not sure.
   9.332 -
   9.333 -  integ_0_le_induct
   9.334 -  LessThan_bounded_induct
   9.335 -  GreaterThan_bounded_induct
   9.336 -
   9.337 -*****)
   9.338 -
   9.339 -(*** Completion \\<in> Binary and General Finite versions ***)
   9.340 -
   9.341 -Goal "[| F \\<in> A LeadsTo (A' Un C);  F \\<in> A' Co (A' Un C); \
   9.342 -\        F \\<in> B LeadsTo (B' Un C);  F \\<in> B' Co (B' Un C) |] \
   9.343 -\     ==> F \\<in> (A Int B) LeadsTo ((A' Int B') Un C)";
   9.344 -by (full_simp_tac
   9.345 -    (simpset() addsimps [LeadsTo_def, Constrains_eq_constrains, 
   9.346 -                         Int_Un_distrib]) 1);
   9.347 -by Safe_tac;
   9.348 -by (REPEAT(Blast_tac 2));
   9.349 -by (blast_tac (claset() addIs [completion, leadsTo_weaken]) 1);
   9.350 -qed "Completion";
   9.351 -
   9.352 -Goal "[| I \\<in> Fin(X);F \\<in> program |] \
   9.353 -\     ==> (\\<forall>i \\<in> I. F \\<in> (A(i)) LeadsTo (A'(i) Un C)) -->  \
   9.354 -\         (\\<forall>i \\<in> I. F \\<in> (A'(i)) Co (A'(i) Un C)) --> \
   9.355 -\         F \\<in> (\\<Inter>i \\<in> I. A(i)) LeadsTo ((\\<Inter>i \\<in> I. A'(i)) Un C)";
   9.356 -by (etac Fin_induct 1);
   9.357 -by (auto_tac (claset(), simpset() delsimps INT_simps
   9.358 -                                  addsimps [Inter_0]));
   9.359 -by (rtac Completion 1);
   9.360 -by (asm_simp_tac (simpset() delsimps INT_simps addsimps INT_extend_simps) 4);
   9.361 -by (rtac Constrains_INT 4);
   9.362 -by (REPEAT(Blast_tac 1));
   9.363 -val lemma = result();
   9.364 -
   9.365 -val prems = Goal
   9.366 -     "[| I \\<in> Fin(X); !!i. i \\<in> I ==> F \\<in> A(i) LeadsTo (A'(i) Un C); \
   9.367 -\        !!i. i \\<in> I ==> F \\<in> A'(i) Co (A'(i) Un C); \
   9.368 -\        F \\<in> program |]   \
   9.369 -\     ==> F \\<in> (\\<Inter>i \\<in> I. A(i)) LeadsTo ((\\<Inter>i \\<in> I. A'(i)) Un C)";
   9.370 -by (blast_tac (claset() addIs (lemma RS mp RS mp)::prems) 1);
   9.371 -qed "Finite_completion";
   9.372 -
   9.373 -Goalw [Stable_def]
   9.374 -     "[| F \\<in> A LeadsTo A';  F \\<in> Stable(A');   \
   9.375 -\        F \\<in> B LeadsTo B';  F \\<in> Stable(B') |] \
   9.376 -\   ==> F \\<in> (A Int B) LeadsTo (A' Int B')";
   9.377 -by (res_inst_tac [("C1", "0")] (Completion RS LeadsTo_weaken_R) 1);
   9.378 -by (Asm_full_simp_tac 5);
   9.379 -by (rtac subset_refl 5);
   9.380 -by Auto_tac;
   9.381 -qed "Stable_completion";
   9.382 -
   9.383 -val prems = Goalw [Stable_def]
   9.384 -     "[| I \\<in> Fin(X); \
   9.385 -\        (!!i. i \\<in> I ==> F \\<in> A(i) LeadsTo A'(i)); \
   9.386 -\        (!!i. i \\<in> I ==>F \\<in> Stable(A'(i)));   F \\<in> program  |] \
   9.387 -\     ==> F \\<in> (\\<Inter>i \\<in> I. A(i)) LeadsTo (\\<Inter>i \\<in> I. A'(i))";
   9.388 -by (res_inst_tac [("C1", "0")] (Finite_completion RS LeadsTo_weaken_R) 1);
   9.389 -by (ALLGOALS(Simp_tac));
   9.390 -by (rtac subset_refl 5);
   9.391 -by (REPEAT(blast_tac (claset() addIs prems) 1));
   9.392 -qed "Finite_stable_completion";
   9.393 -
   9.394 -
   9.395 -(*proves "ensures/leadsTo" properties when the program is specified*)
   9.396 -fun ensures_tac sact = 
   9.397 -    SELECT_GOAL
   9.398 -      (EVERY [REPEAT (Always_Int_tac 1),
   9.399 -              etac Always_LeadsTo_Basis 1 
   9.400 -                  ORELSE   (*subgoal may involve LeadsTo, leadsTo or ensures*)
   9.401 -                  REPEAT (ares_tac [LeadsTo_Basis, leadsTo_Basis,
   9.402 -                                    EnsuresI, ensuresI] 1),
   9.403 -              (*now there are two subgoals \\<in> co & transient*)
   9.404 -              simp_tac (simpset() addsimps !program_defs_ref) 2,
   9.405 -              res_inst_tac [("act", sact)] transientI 2,
   9.406 -                 (*simplify the command's domain*)
   9.407 -              simp_tac (simpset() addsimps [domain_def]) 3, 
   9.408 -              (* proving the domain part *)
   9.409 -             Clarify_tac 3, dtac swap 3, Force_tac 4,
   9.410 -             rtac ReplaceI 3, Force_tac 3, Force_tac 4,
   9.411 -             Asm_full_simp_tac 3, rtac conjI 3, Simp_tac 4,
   9.412 -             REPEAT (rtac state_update_type 3),
   9.413 -             constrains_tac 1,
   9.414 -             ALLGOALS Clarify_tac,
   9.415 -             ALLGOALS (asm_full_simp_tac 
   9.416 -            (simpset() addsimps [st_set_def])),
   9.417 -                        ALLGOALS Clarify_tac,
   9.418 -            ALLGOALS (Asm_full_simp_tac)]);
   9.419 -
    10.1 --- a/src/ZF/UNITY/SubstAx.thy	Sat Mar 26 18:20:29 2005 +0100
    10.2 +++ b/src/ZF/UNITY/SubstAx.thy	Mon Mar 28 16:19:56 2005 +0200
    10.3 @@ -1,24 +1,441 @@
    10.4 -(*  Title:      ZF/UNITY/SubstAx.thy
    10.5 -    ID:         $Id$
    10.6 +(*  ID:         $Id$
    10.7      Author:     Sidi O Ehmety, Computer Laboratory
    10.8      Copyright   2001  University of Cambridge
    10.9  
   10.10 -Weak LeadsTo relation (restricted to the set of reachable states)
   10.11 -
   10.12  Theory ported from HOL.
   10.13  *)
   10.14  
   10.15 -SubstAx = WFair + Constrains + 
   10.16 +header{*Weak LeadsTo relation (restricted to the set of reachable states)*}
   10.17 +
   10.18 +theory SubstAx
   10.19 +imports WFair Constrains 
   10.20 +
   10.21 +begin
   10.22  
   10.23  constdefs
   10.24    (* The definitions below are not `conventional', but yields simpler rules *)
   10.25 -   Ensures :: "[i,i] => i"            (infixl 60)
   10.26 +   Ensures :: "[i,i] => i"            (infixl "Ensures" 60)
   10.27      "A Ensures B == {F:program. F : (reachable(F) Int A) ensures (reachable(F) Int B) }"
   10.28  
   10.29 -  LeadsTo :: "[i, i] => i"            (infixl 60)
   10.30 +  LeadsTo :: "[i, i] => i"            (infixl "LeadsTo" 60)
   10.31      "A LeadsTo B == {F:program. F:(reachable(F) Int A) leadsTo (reachable(F) Int B)}"
   10.32  
   10.33  syntax (xsymbols)
   10.34 -  "op LeadsTo" :: "[i, i] => i" (infixl " \\<longmapsto>w " 60)
   10.35 +  "LeadsTo" :: "[i, i] => i" (infixl " \<longmapsto>w " 60)
   10.36 +
   10.37 +
   10.38 +
   10.39 +(*Resembles the previous definition of LeadsTo*)
   10.40 +
   10.41 +(* Equivalence with the HOL-like definition *)
   10.42 +lemma LeadsTo_eq: 
   10.43 +"st_set(B)==> A LeadsTo B = {F \<in> program. F:(reachable(F) Int A) leadsTo B}"
   10.44 +apply (unfold LeadsTo_def)
   10.45 +apply (blast dest: psp_stable2 leadsToD2 constrainsD2 intro: leadsTo_weaken)
   10.46 +done
   10.47 +
   10.48 +lemma LeadsTo_type: "A LeadsTo B <=program"
   10.49 +by (unfold LeadsTo_def, auto)
   10.50 +
   10.51 +(*** Specialized laws for handling invariants ***)
   10.52 +
   10.53 +(** Conjoining an Always property **)
   10.54 +lemma Always_LeadsTo_pre: "F \<in> Always(I) ==> (F:(I Int A) LeadsTo A') <-> (F \<in> A LeadsTo A')"
   10.55 +by (simp add: LeadsTo_def Always_eq_includes_reachable Int_absorb2 Int_assoc [symmetric] leadsToD2)
   10.56 +
   10.57 +lemma Always_LeadsTo_post: "F \<in> Always(I) ==> (F \<in> A LeadsTo (I Int A')) <-> (F \<in> A LeadsTo A')"
   10.58 +apply (unfold LeadsTo_def)
   10.59 +apply (simp add: Always_eq_includes_reachable Int_absorb2 Int_assoc [symmetric] leadsToD2)
   10.60 +done
   10.61 +
   10.62 +(* Like 'Always_LeadsTo_pre RS iffD1', but with premises in the good order *)
   10.63 +lemma Always_LeadsToI: "[| F \<in> Always(C); F \<in> (C Int A) LeadsTo A' |] ==> F \<in> A LeadsTo A'"
   10.64 +by (blast intro: Always_LeadsTo_pre [THEN iffD1])
   10.65 +
   10.66 +(* Like 'Always_LeadsTo_post RS iffD2', but with premises in the good order *)
   10.67 +lemma Always_LeadsToD: "[| F \<in> Always(C);  F \<in> A LeadsTo A' |] ==> F \<in> A LeadsTo (C Int A')"
   10.68 +by (blast intro: Always_LeadsTo_post [THEN iffD2])
   10.69 +
   10.70 +(*** Introduction rules \<in> Basis, Trans, Union ***)
   10.71 +
   10.72 +lemma LeadsTo_Basis: "F \<in> A Ensures B ==> F \<in> A LeadsTo B"
   10.73 +by (auto simp add: Ensures_def LeadsTo_def)
   10.74 +
   10.75 +lemma LeadsTo_Trans:
   10.76 +     "[| F \<in> A LeadsTo B;  F \<in> B LeadsTo C |] ==> F \<in> A LeadsTo C"
   10.77 +apply (simp (no_asm_use) add: LeadsTo_def)
   10.78 +apply (blast intro: leadsTo_Trans)
   10.79 +done
   10.80 +
   10.81 +lemma LeadsTo_Union:
   10.82 +"[|(!!A. A \<in> S ==> F \<in> A LeadsTo B); F \<in> program|]==>F \<in> Union(S) LeadsTo B"
   10.83 +apply (simp add: LeadsTo_def)
   10.84 +apply (subst Int_Union_Union2)
   10.85 +apply (rule leadsTo_UN, auto)
   10.86 +done
   10.87 +
   10.88 +(*** Derived rules ***)
   10.89 +
   10.90 +lemma leadsTo_imp_LeadsTo: "F \<in> A leadsTo B ==> F \<in> A LeadsTo B"
   10.91 +apply (frule leadsToD2, clarify)
   10.92 +apply (simp (no_asm_simp) add: LeadsTo_eq)
   10.93 +apply (blast intro: leadsTo_weaken_L)
   10.94 +done
   10.95 +
   10.96 +(*Useful with cancellation, disjunction*)
   10.97 +lemma LeadsTo_Un_duplicate: "F \<in> A LeadsTo (A' Un A') ==> F \<in> A LeadsTo A'"
   10.98 +by (simp add: Un_ac)
   10.99 +
  10.100 +lemma LeadsTo_Un_duplicate2:
  10.101 +     "F \<in> A LeadsTo (A' Un C Un C) ==> F \<in> A LeadsTo (A' Un C)"
  10.102 +by (simp add: Un_ac)
  10.103 +
  10.104 +lemma LeadsTo_UN:
  10.105 +    "[|(!!i. i \<in> I ==> F \<in> A(i) LeadsTo B); F \<in> program|]
  10.106 +     ==>F:(\<Union>i \<in> I. A(i)) LeadsTo B"
  10.107 +apply (simp add: LeadsTo_def)
  10.108 +apply (simp (no_asm_simp) del: UN_simps add: Int_UN_distrib)
  10.109 +apply (rule leadsTo_UN, auto)
  10.110 +done
  10.111 +
  10.112 +(*Binary union introduction rule*)
  10.113 +lemma LeadsTo_Un:
  10.114 +     "[| F \<in> A LeadsTo C; F \<in> B LeadsTo C |] ==> F \<in> (A Un B) LeadsTo C"
  10.115 +apply (subst Un_eq_Union)
  10.116 +apply (rule LeadsTo_Union)
  10.117 +apply (auto dest: LeadsTo_type [THEN subsetD])
  10.118 +done
  10.119 +
  10.120 +(*Lets us look at the starting state*)
  10.121 +lemma single_LeadsTo_I: 
  10.122 +    "[|(!!s. s \<in> A ==> F:{s} LeadsTo B); F \<in> program|]==>F \<in> A LeadsTo B"
  10.123 +apply (subst UN_singleton [symmetric], rule LeadsTo_UN, auto)
  10.124 +done
  10.125 +
  10.126 +lemma subset_imp_LeadsTo: "[| A <= B; F \<in> program |] ==> F \<in> A LeadsTo B"
  10.127 +apply (simp (no_asm_simp) add: LeadsTo_def)
  10.128 +apply (blast intro: subset_imp_leadsTo)
  10.129 +done
  10.130 +
  10.131 +lemma empty_LeadsTo: "F:0 LeadsTo A <-> F \<in> program"
  10.132 +by (auto dest: LeadsTo_type [THEN subsetD]
  10.133 +            intro: empty_subsetI [THEN subset_imp_LeadsTo])
  10.134 +declare empty_LeadsTo [iff]
  10.135 +
  10.136 +lemma LeadsTo_state: "F \<in> A LeadsTo state <-> F \<in> program"
  10.137 +by (auto dest: LeadsTo_type [THEN subsetD] simp add: LeadsTo_eq)
  10.138 +declare LeadsTo_state [iff]
  10.139 +
  10.140 +lemma LeadsTo_weaken_R: "[| F \<in> A LeadsTo A';  A'<=B'|] ==> F \<in> A LeadsTo B'"
  10.141 +apply (unfold LeadsTo_def)
  10.142 +apply (auto intro: leadsTo_weaken_R)
  10.143 +done
  10.144 +
  10.145 +lemma LeadsTo_weaken_L: "[| F \<in> A LeadsTo A'; B <= A |] ==> F \<in> B LeadsTo A'"
  10.146 +apply (unfold LeadsTo_def)
  10.147 +apply (auto intro: leadsTo_weaken_L)
  10.148 +done
  10.149 +
  10.150 +lemma LeadsTo_weaken: "[| F \<in> A LeadsTo A'; B<=A; A'<=B' |] ==> F \<in> B LeadsTo B'"
  10.151 +by (blast intro: LeadsTo_weaken_R LeadsTo_weaken_L LeadsTo_Trans)
  10.152 +
  10.153 +lemma Always_LeadsTo_weaken: 
  10.154 +"[| F \<in> Always(C);  F \<in> A LeadsTo A'; C Int B <= A;   C Int A' <= B' |]  
  10.155 +      ==> F \<in> B LeadsTo B'"
  10.156 +apply (blast dest: Always_LeadsToI intro: LeadsTo_weaken Always_LeadsToD)
  10.157 +done
  10.158 +
  10.159 +(** Two theorems for "proof lattices" **)
  10.160 +
  10.161 +lemma LeadsTo_Un_post: "F \<in> A LeadsTo B ==> F:(A Un B) LeadsTo B"
  10.162 +by (blast dest: LeadsTo_type [THEN subsetD]
  10.163 +             intro: LeadsTo_Un subset_imp_LeadsTo)
  10.164 +
  10.165 +lemma LeadsTo_Trans_Un: "[| F \<in> A LeadsTo B;  F \<in> B LeadsTo C |]  
  10.166 +      ==> F \<in> (A Un B) LeadsTo C"
  10.167 +apply (blast intro: LeadsTo_Un subset_imp_LeadsTo LeadsTo_weaken_L LeadsTo_Trans dest: LeadsTo_type [THEN subsetD])
  10.168 +done
  10.169 +
  10.170 +(** Distributive laws **)
  10.171 +lemma LeadsTo_Un_distrib: "(F \<in> (A Un B) LeadsTo C)  <-> (F \<in> A LeadsTo C & F \<in> B LeadsTo C)"
  10.172 +by (blast intro: LeadsTo_Un LeadsTo_weaken_L)
  10.173 +
  10.174 +lemma LeadsTo_UN_distrib: "(F \<in> (\<Union>i \<in> I. A(i)) LeadsTo B) <->  (\<forall>i \<in> I. F \<in> A(i) LeadsTo B) & F \<in> program"
  10.175 +by (blast dest: LeadsTo_type [THEN subsetD]
  10.176 +             intro: LeadsTo_UN LeadsTo_weaken_L)
  10.177 +
  10.178 +lemma LeadsTo_Union_distrib: "(F \<in> Union(S) LeadsTo B)  <->  (\<forall>A \<in> S. F \<in> A LeadsTo B) & F \<in> program"
  10.179 +by (blast dest: LeadsTo_type [THEN subsetD]
  10.180 +             intro: LeadsTo_Union LeadsTo_weaken_L)
  10.181 +
  10.182 +(** More rules using the premise "Always(I)" **)
  10.183 +
  10.184 +lemma EnsuresI: "[| F:(A-B) Co (A Un B);  F \<in> transient (A-B) |] ==> F \<in> A Ensures B"
  10.185 +apply (simp add: Ensures_def Constrains_eq_constrains)
  10.186 +apply (blast intro: ensuresI constrains_weaken transient_strengthen dest: constrainsD2)
  10.187 +done
  10.188 +
  10.189 +lemma Always_LeadsTo_Basis: "[| F \<in> Always(I); F \<in> (I Int (A-A')) Co (A Un A');  
  10.190 +         F \<in> transient (I Int (A-A')) |]    
  10.191 +  ==> F \<in> A LeadsTo A'"
  10.192 +apply (rule Always_LeadsToI, assumption)
  10.193 +apply (blast intro: EnsuresI LeadsTo_Basis Always_ConstrainsD [THEN Constrains_weaken] transient_strengthen)
  10.194 +done
  10.195 +
  10.196 +(*Set difference: maybe combine with leadsTo_weaken_L??
  10.197 +  This is the most useful form of the "disjunction" rule*)
  10.198 +lemma LeadsTo_Diff:
  10.199 +     "[| F \<in> (A-B) LeadsTo C;  F \<in> (A Int B) LeadsTo C |] ==> F \<in> A LeadsTo C"
  10.200 +by (blast intro: LeadsTo_Un LeadsTo_weaken)
  10.201 +
  10.202 +lemma LeadsTo_UN_UN:  
  10.203 +     "[|(!!i. i \<in> I ==> F \<in> A(i) LeadsTo A'(i)); F \<in> program |]  
  10.204 +      ==> F \<in> (\<Union>i \<in> I. A(i)) LeadsTo (\<Union>i \<in> I. A'(i))"
  10.205 +apply (rule LeadsTo_Union, auto) 
  10.206 +apply (blast intro: LeadsTo_weaken_R)
  10.207 +done
  10.208 +
  10.209 +(*Binary union version*)
  10.210 +lemma LeadsTo_Un_Un:
  10.211 +  "[| F \<in> A LeadsTo A'; F \<in> B LeadsTo B' |] ==> F:(A Un B) LeadsTo (A' Un B')"
  10.212 +by (blast intro: LeadsTo_Un LeadsTo_weaken_R)
  10.213 +
  10.214 +(** The cancellation law **)
  10.215 +
  10.216 +lemma LeadsTo_cancel2: "[| F \<in> A LeadsTo(A' Un B); F \<in> B LeadsTo B' |] ==> F \<in> A LeadsTo (A' Un B')"
  10.217 +by (blast intro: LeadsTo_Un_Un subset_imp_LeadsTo LeadsTo_Trans dest: LeadsTo_type [THEN subsetD])
  10.218 +
  10.219 +lemma Un_Diff: "A Un (B - A) = A Un B"
  10.220 +by auto
  10.221 +
  10.222 +lemma LeadsTo_cancel_Diff2: "[| F \<in> A LeadsTo (A' Un B); F \<in> (B-A') LeadsTo B' |] ==> F \<in> A LeadsTo (A' Un B')"
  10.223 +apply (rule LeadsTo_cancel2)
  10.224 +prefer 2 apply assumption
  10.225 +apply (simp (no_asm_simp) add: Un_Diff)
  10.226 +done
  10.227 +
  10.228 +lemma LeadsTo_cancel1: "[| F \<in> A LeadsTo (B Un A'); F \<in> B LeadsTo B' |] ==> F \<in> A LeadsTo (B' Un A')"
  10.229 +apply (simp add: Un_commute)
  10.230 +apply (blast intro!: LeadsTo_cancel2)
  10.231 +done
  10.232 +
  10.233 +lemma Diff_Un2: "(B - A) Un A = B Un A"
  10.234 +by auto
  10.235 +
  10.236 +lemma LeadsTo_cancel_Diff1: "[| F \<in> A LeadsTo (B Un A'); F \<in> (B-A') LeadsTo B' |] ==> F \<in> A LeadsTo (B' Un A')"
  10.237 +apply (rule LeadsTo_cancel1)
  10.238 +prefer 2 apply assumption
  10.239 +apply (simp (no_asm_simp) add: Diff_Un2)
  10.240 +done
  10.241 +
  10.242 +(** The impossibility law **)
  10.243 +
  10.244 +(*The set "A" may be non-empty, but it contains no reachable states*)
  10.245 +lemma LeadsTo_empty: "F \<in> A LeadsTo 0 ==> F \<in> Always (state -A)"
  10.246 +apply (simp (no_asm_use) add: LeadsTo_def Always_eq_includes_reachable)
  10.247 +apply (cut_tac reachable_type)
  10.248 +apply (auto dest!: leadsTo_empty)
  10.249 +done
  10.250 +
  10.251 +(** PSP \<in> Progress-Safety-Progress **)
  10.252 +
  10.253 +(*Special case of PSP \<in> Misra's "stable conjunction"*)
  10.254 +lemma PSP_Stable: "[| F \<in> A LeadsTo A';  F \<in> Stable(B) |]==> F:(A Int B) LeadsTo (A' Int B)"
  10.255 +apply (simp add: LeadsTo_def Stable_eq_stable, clarify)
  10.256 +apply (drule psp_stable, assumption)
  10.257 +apply (simp add: Int_ac)
  10.258 +done
  10.259 +
  10.260 +lemma PSP_Stable2: "[| F \<in> A LeadsTo A'; F \<in> Stable(B) |] ==> F \<in> (B Int A) LeadsTo (B Int A')"
  10.261 +apply (simp (no_asm_simp) add: PSP_Stable Int_ac)
  10.262 +done
  10.263 +
  10.264 +lemma PSP: "[| F \<in> A LeadsTo A'; F \<in> B Co B'|]==> F \<in> (A Int B') LeadsTo ((A' Int B) Un (B' - B))"
  10.265 +apply (simp (no_asm_use) add: LeadsTo_def Constrains_eq_constrains)
  10.266 +apply (blast dest: psp intro: leadsTo_weaken)
  10.267 +done
  10.268 +
  10.269 +lemma PSP2: "[| F \<in> A LeadsTo A'; F \<in> B Co B' |]==> F:(B' Int A) LeadsTo ((B Int A') Un (B' - B))"
  10.270 +by (simp (no_asm_simp) add: PSP Int_ac)
  10.271 +
  10.272 +lemma PSP_Unless: 
  10.273 +"[| F \<in> A LeadsTo A'; F \<in> B Unless B'|]==> F:(A Int B) LeadsTo ((A' Int B) Un B')"
  10.274 +apply (unfold Unless_def)
  10.275 +apply (drule PSP, assumption)
  10.276 +apply (blast intro: LeadsTo_Diff LeadsTo_weaken subset_imp_LeadsTo)
  10.277 +done
  10.278 +
  10.279 +(*** Induction rules ***)
  10.280 +
  10.281 +(** Meta or object quantifier ????? **)
  10.282 +lemma LeadsTo_wf_induct: "[| wf(r);      
  10.283 +         \<forall>m \<in> I. F \<in> (A Int f-``{m}) LeadsTo                      
  10.284 +                            ((A Int f-``(converse(r) `` {m})) Un B);  
  10.285 +         field(r)<=I; A<=f-``I; F \<in> program |]  
  10.286 +      ==> F \<in> A LeadsTo B"
  10.287 +apply (simp (no_asm_use) add: LeadsTo_def)
  10.288 +apply auto
  10.289 +apply (erule_tac I = I and f = f in leadsTo_wf_induct, safe)
  10.290 +apply (drule_tac [2] x = m in bspec, safe)
  10.291 +apply (rule_tac [2] A' = "reachable (F) Int (A Int f -`` (converse (r) ``{m}) Un B) " in leadsTo_weaken_R)
  10.292 +apply (auto simp add: Int_assoc) 
  10.293 +done
  10.294 +
  10.295 +
  10.296 +lemma LessThan_induct: "[| \<forall>m \<in> nat. F:(A Int f-``{m}) LeadsTo ((A Int f-``m) Un B);  
  10.297 +      A<=f-``nat; F \<in> program |] ==> F \<in> A LeadsTo B"
  10.298 +apply (rule_tac A1 = nat and f1 = "%x. x" in wf_measure [THEN LeadsTo_wf_induct])
  10.299 +apply (simp_all add: nat_measure_field)
  10.300 +apply (simp add: ltI Image_inverse_lessThan vimage_def [symmetric])
  10.301 +done
  10.302 +
  10.303 +
  10.304 +(****** 
  10.305 + To be ported ??? I am not sure.
  10.306 +
  10.307 +  integ_0_le_induct
  10.308 +  LessThan_bounded_induct
  10.309 +  GreaterThan_bounded_induct
  10.310 +
  10.311 +*****)
  10.312 +
  10.313 +(*** Completion \<in> Binary and General Finite versions ***)
  10.314 +
  10.315 +lemma Completion: "[| F \<in> A LeadsTo (A' Un C);  F \<in> A' Co (A' Un C);  
  10.316 +         F \<in> B LeadsTo (B' Un C);  F \<in> B' Co (B' Un C) |]  
  10.317 +      ==> F \<in> (A Int B) LeadsTo ((A' Int B') Un C)"
  10.318 +apply (simp (no_asm_use) add: LeadsTo_def Constrains_eq_constrains Int_Un_distrib)
  10.319 +apply (blast intro: completion leadsTo_weaken)
  10.320 +done
  10.321 +
  10.322 +lemma Finite_completion_aux:
  10.323 +     "[| I \<in> Fin(X);F \<in> program |]  
  10.324 +      ==> (\<forall>i \<in> I. F \<in> (A(i)) LeadsTo (A'(i) Un C)) -->   
  10.325 +          (\<forall>i \<in> I. F \<in> (A'(i)) Co (A'(i) Un C)) -->  
  10.326 +          F \<in> (\<Inter>i \<in> I. A(i)) LeadsTo ((\<Inter>i \<in> I. A'(i)) Un C)"
  10.327 +apply (erule Fin_induct)
  10.328 +apply (auto simp del: INT_simps simp add: Inter_0)
  10.329 +apply (rule Completion, auto) 
  10.330 +apply (simp del: INT_simps add: INT_extend_simps)
  10.331 +apply (blast intro: Constrains_INT)
  10.332 +done
  10.333 +
  10.334 +lemma Finite_completion: 
  10.335 +     "[| I \<in> Fin(X); !!i. i \<in> I ==> F \<in> A(i) LeadsTo (A'(i) Un C);  
  10.336 +         !!i. i \<in> I ==> F \<in> A'(i) Co (A'(i) Un C);  
  10.337 +         F \<in> program |]    
  10.338 +      ==> F \<in> (\<Inter>i \<in> I. A(i)) LeadsTo ((\<Inter>i \<in> I. A'(i)) Un C)"
  10.339 +by (blast intro: Finite_completion_aux [THEN mp, THEN mp])
  10.340 +
  10.341 +lemma Stable_completion: 
  10.342 +     "[| F \<in> A LeadsTo A';  F \<in> Stable(A');    
  10.343 +         F \<in> B LeadsTo B';  F \<in> Stable(B') |]  
  10.344 +    ==> F \<in> (A Int B) LeadsTo (A' Int B')"
  10.345 +apply (unfold Stable_def)
  10.346 +apply (rule_tac C1 = 0 in Completion [THEN LeadsTo_weaken_R])
  10.347 +    prefer 5
  10.348 +    apply blast 
  10.349 +apply auto 
  10.350 +done
  10.351 +
  10.352 +lemma Finite_stable_completion: 
  10.353 +     "[| I \<in> Fin(X);  
  10.354 +         (!!i. i \<in> I ==> F \<in> A(i) LeadsTo A'(i));  
  10.355 +         (!!i. i \<in> I ==>F \<in> Stable(A'(i)));   F \<in> program  |]  
  10.356 +      ==> F \<in> (\<Inter>i \<in> I. A(i)) LeadsTo (\<Inter>i \<in> I. A'(i))"
  10.357 +apply (unfold Stable_def)
  10.358 +apply (rule_tac C1 = 0 in Finite_completion [THEN LeadsTo_weaken_R], simp_all)
  10.359 +apply (rule_tac [3] subset_refl, auto) 
  10.360 +done
  10.361 +
  10.362 +ML
  10.363 +{*
  10.364 +val LeadsTo_eq = thm "LeadsTo_eq";
  10.365 +val LeadsTo_type = thm "LeadsTo_type";
  10.366 +val Always_LeadsTo_pre = thm "Always_LeadsTo_pre";
  10.367 +val Always_LeadsTo_post = thm "Always_LeadsTo_post";
  10.368 +val Always_LeadsToI = thm "Always_LeadsToI";
  10.369 +val Always_LeadsToD = thm "Always_LeadsToD";
  10.370 +val LeadsTo_Basis = thm "LeadsTo_Basis";
  10.371 +val LeadsTo_Trans = thm "LeadsTo_Trans";
  10.372 +val LeadsTo_Union = thm "LeadsTo_Union";
  10.373 +val leadsTo_imp_LeadsTo = thm "leadsTo_imp_LeadsTo";
  10.374 +val LeadsTo_Un_duplicate = thm "LeadsTo_Un_duplicate";
  10.375 +val LeadsTo_Un_duplicate2 = thm "LeadsTo_Un_duplicate2";
  10.376 +val LeadsTo_UN = thm "LeadsTo_UN";
  10.377 +val LeadsTo_Un = thm "LeadsTo_Un";
  10.378 +val single_LeadsTo_I = thm "single_LeadsTo_I";
  10.379 +val subset_imp_LeadsTo = thm "subset_imp_LeadsTo";
  10.380 +val empty_LeadsTo = thm "empty_LeadsTo";
  10.381 +val LeadsTo_state = thm "LeadsTo_state";
  10.382 +val LeadsTo_weaken_R = thm "LeadsTo_weaken_R";
  10.383 +val LeadsTo_weaken_L = thm "LeadsTo_weaken_L";
  10.384 +val LeadsTo_weaken = thm "LeadsTo_weaken";
  10.385 +val Always_LeadsTo_weaken = thm "Always_LeadsTo_weaken";
  10.386 +val LeadsTo_Un_post = thm "LeadsTo_Un_post";
  10.387 +val LeadsTo_Trans_Un = thm "LeadsTo_Trans_Un";
  10.388 +val LeadsTo_Un_distrib = thm "LeadsTo_Un_distrib";
  10.389 +val LeadsTo_UN_distrib = thm "LeadsTo_UN_distrib";
  10.390 +val LeadsTo_Union_distrib = thm "LeadsTo_Union_distrib";
  10.391 +val EnsuresI = thm "EnsuresI";
  10.392 +val Always_LeadsTo_Basis = thm "Always_LeadsTo_Basis";
  10.393 +val LeadsTo_Diff = thm "LeadsTo_Diff";
  10.394 +val LeadsTo_UN_UN = thm "LeadsTo_UN_UN";
  10.395 +val LeadsTo_Un_Un = thm "LeadsTo_Un_Un";
  10.396 +val LeadsTo_cancel2 = thm "LeadsTo_cancel2";
  10.397 +val Un_Diff = thm "Un_Diff";
  10.398 +val LeadsTo_cancel_Diff2 = thm "LeadsTo_cancel_Diff2";
  10.399 +val LeadsTo_cancel1 = thm "LeadsTo_cancel1";
  10.400 +val Diff_Un2 = thm "Diff_Un2";
  10.401 +val LeadsTo_cancel_Diff1 = thm "LeadsTo_cancel_Diff1";
  10.402 +val LeadsTo_empty = thm "LeadsTo_empty";
  10.403 +val PSP_Stable = thm "PSP_Stable";
  10.404 +val PSP_Stable2 = thm "PSP_Stable2";
  10.405 +val PSP = thm "PSP";
  10.406 +val PSP2 = thm "PSP2";
  10.407 +val PSP_Unless = thm "PSP_Unless";
  10.408 +val LeadsTo_wf_induct = thm "LeadsTo_wf_induct";
  10.409 +val LessThan_induct = thm "LessThan_induct";
  10.410 +val Completion = thm "Completion";
  10.411 +val Finite_completion = thm "Finite_completion";
  10.412 +val Stable_completion = thm "Stable_completion";
  10.413 +val Finite_stable_completion = thm "Finite_stable_completion";
  10.414 +
  10.415 +
  10.416 +(*proves "ensures/leadsTo" properties when the program is specified*)
  10.417 +fun gen_ensures_tac(cs,ss) sact = 
  10.418 +    SELECT_GOAL
  10.419 +      (EVERY [REPEAT (Always_Int_tac 1),
  10.420 +              etac Always_LeadsTo_Basis 1 
  10.421 +                  ORELSE   (*subgoal may involve LeadsTo, leadsTo or ensures*)
  10.422 +                  REPEAT (ares_tac [LeadsTo_Basis, leadsTo_Basis,
  10.423 +                                    EnsuresI, ensuresI] 1),
  10.424 +              (*now there are two subgoals: co & transient*)
  10.425 +              simp_tac (ss addsimps !program_defs_ref) 2,
  10.426 +              res_inst_tac [("act", sact)] transientI 2,
  10.427 +                 (*simplify the command's domain*)
  10.428 +              simp_tac (ss addsimps [domain_def]) 3, 
  10.429 +              (* proving the domain part *)
  10.430 +             clarify_tac cs 3, dtac swap 3, force_tac (cs,ss) 4,
  10.431 +             rtac ReplaceI 3, force_tac (cs,ss) 3, force_tac (cs,ss) 4,
  10.432 +             asm_full_simp_tac ss 3, rtac conjI 3, simp_tac ss 4,
  10.433 +             REPEAT (rtac state_update_type 3),
  10.434 +             gen_constrains_tac (cs,ss) 1,
  10.435 +             ALLGOALS (clarify_tac cs),
  10.436 +             ALLGOALS (asm_full_simp_tac (ss addsimps [st_set_def])),
  10.437 +                        ALLGOALS (clarify_tac cs),
  10.438 +            ALLGOALS (asm_lr_simp_tac ss)]);
  10.439 +
  10.440 +fun ensures_tac sact = gen_ensures_tac (claset(), simpset()) sact;
  10.441 +*}
  10.442 +
  10.443 +
  10.444 +method_setup ensures_tac = {*
  10.445 +    fn args => fn ctxt =>
  10.446 +        Method.goal_args' (Scan.lift Args.name) 
  10.447 +           (gen_ensures_tac (local_clasimpset_of ctxt))
  10.448 +           args ctxt *}
  10.449 +    "for proving progress properties"
  10.450 +
  10.451  
  10.452  end
    11.1 --- a/src/ZF/UNITY/WFair.ML	Sat Mar 26 18:20:29 2005 +0100
    11.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.3 @@ -1,755 +0,0 @@
    11.4 -(*  Title:      HOL/UNITY/WFair.ML
    11.5 -    ID:         $Id \\<in> WFair.ML,v 1.13 2003/06/30 16:15:52 paulson Exp $
    11.6 -    Author:     Sidi O Ehmety, Computer Laboratory
    11.7 -    Copyright   2001  University of Cambridge
    11.8 -
    11.9 -Weak Fairness versions of transient, ensures, leadsTo.
   11.10 -
   11.11 -From Misra, "A Logic for Concurrent Programming", 1994
   11.12 -*)
   11.13 -
   11.14 -(** Ad-hoc set-theory rules **)
   11.15 -
   11.16 -Goal "Union(B) Int A = (\\<Union>b \\<in> B. b Int A)";
   11.17 -by Auto_tac;
   11.18 -qed "Int_Union_Union";
   11.19 -
   11.20 -Goal "A Int Union(B) = (\\<Union>b \\<in> B. A Int b)";
   11.21 -by Auto_tac;
   11.22 -qed "Int_Union_Union2";
   11.23 -
   11.24 -(*** transient ***)
   11.25 -
   11.26 -Goalw [transient_def] "transient(A)<=program";
   11.27 -by Auto_tac;
   11.28 -qed "transient_type";
   11.29 -
   11.30 -Goalw [transient_def] 
   11.31 -"F \\<in> transient(A) ==> F \\<in> program & st_set(A)";
   11.32 -by Auto_tac;
   11.33 -qed "transientD2";
   11.34 -
   11.35 -Goal "[| F \\<in> stable(A); F \\<in> transient(A) |] ==> A = 0";
   11.36 -by (asm_full_simp_tac (simpset() addsimps [stable_def, constrains_def, transient_def]) 1); 
   11.37 -by (Fast_tac 1); 
   11.38 -qed "stable_transient_empty";
   11.39 -
   11.40 -Goalw [transient_def, st_set_def] "[|F \\<in> transient(A); B<=A|] ==> F \\<in> transient(B)";
   11.41 -by Safe_tac;
   11.42 -by (res_inst_tac [("x", "act")] bexI 1);
   11.43 -by (ALLGOALS(Asm_full_simp_tac));
   11.44 -by (Blast_tac 1);
   11.45 -by Auto_tac;
   11.46 -qed "transient_strengthen";
   11.47 -
   11.48 -Goalw [transient_def] 
   11.49 -"[|act \\<in> Acts(F); A <= domain(act); act``A <= state-A; \
   11.50 -\   F \\<in> program; st_set(A)|] ==> F \\<in> transient(A)";
   11.51 -by (Blast_tac 1);
   11.52 -qed "transientI";
   11.53 -
   11.54 -val major::prems = 
   11.55 -Goalw [transient_def] "[| F \\<in> transient(A); \
   11.56 -\  !!act. [| act \\<in> Acts(F);  A <= domain(act); act``A <= state-A|]==>P|]==>P";
   11.57 -by (rtac (major RS CollectE) 1);
   11.58 -by (blast_tac (claset() addIs prems) 1);
   11.59 -qed "transientE";
   11.60 -
   11.61 -Goalw [transient_def] "transient(state) = 0";
   11.62 -by (rtac equalityI 1);
   11.63 -by (ALLGOALS(Clarify_tac));
   11.64 -by (cut_inst_tac [("F", "x")] Acts_type 1);
   11.65 -by (asm_full_simp_tac (simpset() addsimps [Diff_cancel]) 1);
   11.66 -by (auto_tac (claset() addIs [st0_in_state], simpset()));
   11.67 -qed "transient_state";
   11.68 -
   11.69 -Goalw [transient_def,st_set_def] "state<=B ==> transient(B) = 0";
   11.70 -by (rtac equalityI 1);
   11.71 -by (ALLGOALS(Clarify_tac));
   11.72 -by (cut_inst_tac [("F", "x")] Acts_type 1);
   11.73 -by (asm_full_simp_tac (simpset() addsimps [Diff_cancel]) 1);
   11.74 -by (subgoal_tac "B=state" 1);
   11.75 -by (auto_tac (claset() addIs [st0_in_state], simpset()));
   11.76 -qed "transient_state2";
   11.77 -
   11.78 -Goalw [transient_def] "transient(0) = program";
   11.79 -by (rtac equalityI 1);
   11.80 -by Auto_tac;
   11.81 -qed "transient_empty";
   11.82 -
   11.83 -Addsimps [transient_empty, transient_state, transient_state2];
   11.84 -
   11.85 -(*** ensures ***)
   11.86 -
   11.87 -Goalw [ensures_def, constrains_def] "A ensures B <=program";
   11.88 -by Auto_tac;
   11.89 -qed "ensures_type";
   11.90 -
   11.91 -Goalw [ensures_def]
   11.92 -"[|F:(A-B) co (A Un B); F \\<in> transient(A-B)|]==>F \\<in> A ensures B";
   11.93 -by (auto_tac (claset(), simpset() addsimps [transient_type RS subsetD]));
   11.94 -qed "ensuresI";
   11.95 -
   11.96 -(* Added by Sidi, from Misra's notes, Progress chapter, exercise 4 *)
   11.97 -Goal "[| F \\<in> A co A Un B; F \\<in> transient(A) |] ==> F \\<in> A ensures B";
   11.98 -by (dres_inst_tac [("B", "A-B")] constrains_weaken_L 1);
   11.99 -by (dres_inst_tac [("B", "A-B")] transient_strengthen 2);
  11.100 -by (auto_tac (claset(), simpset() addsimps [ensures_def, transient_type RS subsetD]));
  11.101 -qed "ensuresI2";
  11.102 -
  11.103 -Goalw [ensures_def] "F \\<in> A ensures B ==> F:(A-B) co (A Un B) & F \\<in> transient (A-B)";
  11.104 -by Auto_tac;
  11.105 -qed "ensuresD";
  11.106 -
  11.107 -Goalw [ensures_def] "[|F \\<in> A ensures A'; A'<=B' |] ==> F \\<in> A ensures B'";
  11.108 -by (blast_tac (claset()  
  11.109 -          addIs [transient_strengthen, constrains_weaken]) 1);
  11.110 -qed "ensures_weaken_R";
  11.111 -
  11.112 -(*The L-version (precondition strengthening) fails, but we have this*) 
  11.113 -Goalw [ensures_def]
  11.114 -     "[| F \\<in> stable(C);  F \\<in> A ensures B |] ==> F:(C Int A) ensures (C Int B)";
  11.115 -by (simp_tac (simpset() addsimps [Int_Un_distrib RS sym,
  11.116 -                                  Diff_Int_distrib RS sym]) 1);
  11.117 -by (blast_tac (claset() 
  11.118 -        addIs [transient_strengthen, 
  11.119 -               stable_constrains_Int, constrains_weaken]) 1); 
  11.120 -qed "stable_ensures_Int"; 
  11.121 -
  11.122 -Goal "[|F \\<in> stable(A);  F \\<in> transient(C); A<=B Un C|] ==> F \\<in> A ensures B";
  11.123 -by (forward_tac [stable_type RS subsetD] 1);
  11.124 -by (asm_full_simp_tac (simpset() addsimps [ensures_def, stable_def]) 1);
  11.125 -by (Clarify_tac 1);
  11.126 -by (blast_tac (claset()  addIs [transient_strengthen, 
  11.127 -                                constrains_weaken]) 1);
  11.128 -qed "stable_transient_ensures";
  11.129 -
  11.130 -Goal "(A ensures B) = (A unless B) Int transient (A-B)";
  11.131 -by (auto_tac (claset(), simpset() addsimps [ensures_def, unless_def]));
  11.132 -qed "ensures_eq";
  11.133 -
  11.134 -Goal "[| F \\<in> program; A<=B  |] ==> F \\<in> A ensures B";
  11.135 -by (rewrite_goal_tac [ensures_def,constrains_def,transient_def, st_set_def] 1);
  11.136 -by Auto_tac;
  11.137 -qed "subset_imp_ensures";
  11.138 -
  11.139 -(*** leadsTo ***)
  11.140 -val leads_left = leads.dom_subset RS subsetD RS SigmaD1;
  11.141 -val leads_right = leads.dom_subset RS subsetD RS SigmaD2;
  11.142 -
  11.143 -Goalw [leadsTo_def]  "A leadsTo B <= program";
  11.144 -by Auto_tac;
  11.145 -qed "leadsTo_type";
  11.146 -
  11.147 -Goalw [leadsTo_def, st_set_def] 
  11.148 -"F \\<in> A leadsTo B ==> F \\<in> program & st_set(A) & st_set(B)";
  11.149 -by (blast_tac (claset() addDs [leads_left, leads_right]) 1);
  11.150 -qed "leadsToD2";
  11.151 -
  11.152 -Goalw [leadsTo_def, st_set_def] 
  11.153 -    "[|F \\<in> A ensures B; st_set(A); st_set(B)|] ==> F \\<in> A leadsTo B";
  11.154 -by (cut_facts_tac [ensures_type] 1);
  11.155 -by (auto_tac (claset() addIs [leads.Basis], simpset()));
  11.156 -qed "leadsTo_Basis";                       
  11.157 -AddIs [leadsTo_Basis];
  11.158 -
  11.159 -(* Added by Sidi, from Misra's notes, Progress chapter, exercise number 4 *)
  11.160 -(* [| F \\<in> program; A<=B;  st_set(A); st_set(B) |] ==> A leadsTo B *)
  11.161 -bind_thm ("subset_imp_leadsTo", subset_imp_ensures RS leadsTo_Basis);
  11.162 -
  11.163 -Goalw [leadsTo_def] "[|F \\<in> A leadsTo B;  F \\<in> B leadsTo C |]==>F \\<in> A leadsTo C";
  11.164 -by (auto_tac (claset() addIs [leads.Trans], simpset()));
  11.165 -qed "leadsTo_Trans";
  11.166 -
  11.167 -(* Better when used in association with leadsTo_weaken_R *)
  11.168 -Goalw [transient_def] "F \\<in> transient(A) ==> F \\<in> A leadsTo (state-A )";
  11.169 -by (rtac (ensuresI RS leadsTo_Basis) 1);
  11.170 -by (ALLGOALS(Clarify_tac));
  11.171 -by (blast_tac (claset() addIs [transientI]) 2);
  11.172 -by (rtac constrains_weaken 1);
  11.173 -by Auto_tac;
  11.174 -qed "transient_imp_leadsTo";
  11.175 -
  11.176 -(*Useful with cancellation, disjunction*)
  11.177 -Goal "F \\<in> A leadsTo (A' Un A') ==> F \\<in> A leadsTo A'";
  11.178 -by (Asm_full_simp_tac 1);
  11.179 -qed "leadsTo_Un_duplicate";
  11.180 -
  11.181 -Goal "F \\<in> A leadsTo (A' Un C Un C) ==> F \\<in> A leadsTo (A' Un C)";
  11.182 -by (asm_full_simp_tac (simpset() addsimps Un_ac) 1);
  11.183 -qed "leadsTo_Un_duplicate2";
  11.184 -
  11.185 -(*The Union introduction rule as we should have liked to state it*)
  11.186 -val [major, program,B]= Goalw [leadsTo_def, st_set_def]
  11.187 -"[|(!!A. A \\<in> S ==> F \\<in> A leadsTo B); F \\<in> program; st_set(B)|]==>F \\<in> Union(S) leadsTo B";
  11.188 -by (cut_facts_tac [program, B] 1);
  11.189 -by Auto_tac;
  11.190 -by (rtac leads.Union 1);
  11.191 -by Auto_tac;
  11.192 -by (ALLGOALS(dtac major));
  11.193 -by (auto_tac (claset() addDs [leads_left], simpset()));
  11.194 -qed "leadsTo_Union";
  11.195 -
  11.196 -val [major,program,B] = Goalw [leadsTo_def, st_set_def] 
  11.197 -"[|(!!A. A \\<in> S ==>F:(A Int C) leadsTo B); F \\<in> program; st_set(B)|] \
  11.198 -\  ==>F:(Union(S)Int C)leadsTo B";
  11.199 -by (cut_facts_tac [program, B] 1);
  11.200 -by (asm_simp_tac (simpset() delsimps UN_simps  addsimps [Int_Union_Union]) 1);
  11.201 -by (resolve_tac [leads.Union] 1);
  11.202 -by Auto_tac;
  11.203 -by (ALLGOALS(dtac major));
  11.204 -by (auto_tac (claset() addDs [leads_left], simpset()));
  11.205 -qed "leadsTo_Union_Int";
  11.206 -
  11.207 -val [major,program,B] = Goalw [leadsTo_def, st_set_def]
  11.208 -"[|(!!i. i \\<in> I ==> F \\<in> A(i) leadsTo B); F \\<in> program; st_set(B)|]==>F:(\\<Union>i \\<in> I. A(i)) leadsTo B";
  11.209 -by (cut_facts_tac [program, B] 1);
  11.210 -by (asm_simp_tac (simpset()  addsimps [Int_Union_Union]) 1);
  11.211 -by (rtac leads.Union 1);
  11.212 -by Auto_tac;
  11.213 -by (ALLGOALS(dtac major));
  11.214 -by (auto_tac (claset() addDs [leads_left], simpset()));
  11.215 -qed "leadsTo_UN";
  11.216 -
  11.217 -(* Binary union introduction rule *)
  11.218 -Goal "[| F \\<in> A leadsTo C; F \\<in> B leadsTo C |] ==> F \\<in> (A Un B) leadsTo C";
  11.219 -by (stac Un_eq_Union 1);
  11.220 -by (blast_tac (claset() addIs [leadsTo_Union] addDs [leadsToD2]) 1);
  11.221 -qed "leadsTo_Un";
  11.222 -
  11.223 -val [major, program, B] = Goal 
  11.224 -"[|(!!x. x \\<in> A==> F:{x} leadsTo B); F \\<in> program; st_set(B) |] ==> F \\<in> A leadsTo B";
  11.225 -by (res_inst_tac [("b", "A")] (UN_singleton RS subst) 1);
  11.226 -by (rtac leadsTo_UN 1);
  11.227 -by (auto_tac (claset() addDs prems, simpset() addsimps [major, program, B]));
  11.228 -qed "single_leadsTo_I";
  11.229 -
  11.230 -Goal "[| F \\<in> program; st_set(A) |] ==> F \\<in> A leadsTo A"; 
  11.231 -by (blast_tac (claset() addIs [subset_imp_leadsTo]) 1);
  11.232 -qed "leadsTo_refl";
  11.233 -
  11.234 -Goal "F \\<in> A leadsTo A <-> F \\<in> program & st_set(A)";
  11.235 -by (auto_tac (claset() addIs [leadsTo_refl]
  11.236 -                       addDs [leadsToD2], simpset()));
  11.237 -qed "leadsTo_refl_iff";
  11.238 -
  11.239 -Goal "F \\<in> 0 leadsTo B <-> (F \\<in> program & st_set(B))";
  11.240 -by (auto_tac (claset() addIs [subset_imp_leadsTo]
  11.241 -                       addDs [leadsToD2], simpset()));
  11.242 -qed "empty_leadsTo";
  11.243 -AddIffs [empty_leadsTo];
  11.244 -
  11.245 -Goal  "F \\<in> A leadsTo state <-> (F \\<in> program & st_set(A))";
  11.246 -by (auto_tac (claset() addIs [subset_imp_leadsTo]
  11.247 -                       addDs [leadsToD2, st_setD], simpset()));
  11.248 -qed "leadsTo_state";
  11.249 -AddIffs [leadsTo_state];
  11.250 -
  11.251 -Goal "[| F \\<in> A leadsTo A'; A'<=B'; st_set(B') |] ==> F \\<in> A leadsTo B'";
  11.252 -by (blast_tac (claset() addDs [leadsToD2]
  11.253 -                        addIs [subset_imp_leadsTo,leadsTo_Trans]) 1);
  11.254 -qed "leadsTo_weaken_R";
  11.255 -
  11.256 -Goal "[| F \\<in> A leadsTo A'; B<=A |] ==> F \\<in> B leadsTo A'";
  11.257 -by (ftac leadsToD2 1);
  11.258 -by (blast_tac (claset() addIs [leadsTo_Trans,subset_imp_leadsTo, st_set_subset]) 1);
  11.259 -qed_spec_mp "leadsTo_weaken_L";
  11.260 -
  11.261 -Goal "[| F \\<in> A leadsTo A'; B<=A; A'<=B'; st_set(B')|]==> F \\<in> B leadsTo B'";
  11.262 -by (ftac leadsToD2 1);
  11.263 -by (blast_tac (claset() addIs [leadsTo_weaken_R, leadsTo_weaken_L, 
  11.264 -                               leadsTo_Trans, leadsTo_refl]) 1);
  11.265 -qed "leadsTo_weaken";
  11.266 -
  11.267 -(* This rule has a nicer conclusion *)
  11.268 -Goal "[| F \\<in> transient(A); state-A<=B; st_set(B)|] ==> F \\<in> A leadsTo B";
  11.269 -by (ftac transientD2 1);
  11.270 -by (rtac leadsTo_weaken_R 1);
  11.271 -by (auto_tac (claset(), simpset() addsimps [transient_imp_leadsTo]));
  11.272 -qed "transient_imp_leadsTo2";
  11.273 -
  11.274 -(*Distributes over binary unions*)
  11.275 -Goal "F:(A Un B) leadsTo C  <->  (F \\<in> A leadsTo C & F \\<in> B leadsTo C)";
  11.276 -by (blast_tac (claset() addIs [leadsTo_Un, leadsTo_weaken_L]) 1);
  11.277 -qed "leadsTo_Un_distrib";
  11.278 -
  11.279 -Goal 
  11.280 -"(F:(\\<Union>i \\<in> I. A(i)) leadsTo B)<-> ((\\<forall>i \\<in> I. F \\<in> A(i) leadsTo B) & F \\<in> program & st_set(B))";
  11.281 -by (blast_tac (claset() addDs [leadsToD2] 
  11.282 -                        addIs [leadsTo_UN, leadsTo_weaken_L]) 1);
  11.283 -qed "leadsTo_UN_distrib";
  11.284 -
  11.285 -Goal "(F \\<in> Union(S) leadsTo B) <->  (\\<forall>A \\<in> S. F \\<in> A leadsTo B) & F \\<in> program & st_set(B)";
  11.286 -by (blast_tac (claset() addDs [leadsToD2] 
  11.287 -                        addIs [leadsTo_Union, leadsTo_weaken_L]) 1);
  11.288 -qed "leadsTo_Union_distrib";
  11.289 -
  11.290 -(*Set difference \\<in> maybe combine with leadsTo_weaken_L?*)
  11.291 -Goal "[| F: (A-B) leadsTo C; F \\<in> B leadsTo C; st_set(C) |] ==> F \\<in> A leadsTo C";
  11.292 -by (blast_tac (claset() addIs [leadsTo_Un, leadsTo_weaken]
  11.293 -                        addDs [leadsToD2]) 1);
  11.294 -qed "leadsTo_Diff";
  11.295 -
  11.296 -val [major,minor] = Goal 
  11.297 -"[|(!!i. i \\<in> I ==> F \\<in> A(i) leadsTo A'(i)); F \\<in> program |] \
  11.298 -\  ==> F: (\\<Union>i \\<in> I. A(i)) leadsTo (\\<Union>i \\<in> I. A'(i))";
  11.299 -by (rtac leadsTo_Union 1);
  11.300 -by (ALLGOALS(Asm_simp_tac));
  11.301 -by Safe_tac;
  11.302 -by (simp_tac (simpset() addsimps [minor]) 2);
  11.303 -by (blast_tac (claset() addDs [leadsToD2, major])2);
  11.304 -by (blast_tac (claset() addIs [leadsTo_weaken_R] addDs [major, leadsToD2]) 1);
  11.305 -qed "leadsTo_UN_UN";
  11.306 -
  11.307 -(*Binary union version*)
  11.308 -Goal "[| F \\<in> A leadsTo A'; F \\<in> B leadsTo B' |] ==> F \\<in> (A Un B) leadsTo (A' Un B')";
  11.309 -by (subgoal_tac "st_set(A) & st_set(A') & st_set(B) & st_set(B')" 1);
  11.310 -by (blast_tac (claset() addDs [leadsToD2]) 2);
  11.311 -by (blast_tac (claset() addIs [leadsTo_Un, leadsTo_weaken_R]) 1);
  11.312 -qed "leadsTo_Un_Un";
  11.313 -
  11.314 -(** The cancellation law **)
  11.315 -Goal "[|F \\<in> A leadsTo (A' Un B); F \\<in> B leadsTo B'|] ==> F \\<in> A leadsTo (A' Un B')";
  11.316 -by (subgoal_tac "st_set(A) & st_set(A') & st_set(B) & st_set(B') &F \\<in> program" 1);
  11.317 -by (blast_tac (claset() addDs [leadsToD2]) 2);
  11.318 -by (blast_tac (claset() addIs [leadsTo_Trans, leadsTo_Un_Un, leadsTo_refl]) 1);
  11.319 -qed "leadsTo_cancel2";
  11.320 -
  11.321 -Goal "[|F \\<in> A leadsTo (A' Un B); F \\<in> (B-A') leadsTo B'|]==> F \\<in> A leadsTo (A' Un B')";
  11.322 -by (rtac leadsTo_cancel2 1);
  11.323 -by (assume_tac 2);
  11.324 -by (blast_tac (claset() addDs [leadsToD2] addIs [leadsTo_weaken_R]) 1);
  11.325 -qed "leadsTo_cancel_Diff2";
  11.326 -
  11.327 -
  11.328 -Goal "[| F \\<in> A leadsTo (B Un A'); F \\<in> B leadsTo B' |] ==> F \\<in> A leadsTo (B' Un A')";
  11.329 -by (asm_full_simp_tac (simpset() addsimps [Un_commute]) 1);
  11.330 -by (blast_tac (claset() addSIs [leadsTo_cancel2]) 1);
  11.331 -qed "leadsTo_cancel1";
  11.332 -
  11.333 -Goal "[|F \\<in> A leadsTo (B Un A'); F: (B-A') leadsTo B'|]==> F \\<in> A leadsTo (B' Un A')";
  11.334 -by (rtac leadsTo_cancel1 1);
  11.335 -by (assume_tac 2);
  11.336 -by (blast_tac (claset() addIs [leadsTo_weaken_R] addDs [leadsToD2]) 1);
  11.337 -qed "leadsTo_cancel_Diff1";
  11.338 -
  11.339 -(*The INDUCTION rule as we should have liked to state it*)
  11.340 -val [major, basis_prem, trans_prem, union_prem] = Goalw [leadsTo_def, st_set_def]
  11.341 -  "[| F \\<in> za leadsTo zb; \
  11.342 -\     !!A B. [| F \\<in> A ensures B; st_set(A); st_set(B) |] ==> P(A, B); \
  11.343 -\     !!A B C. [| F \\<in> A leadsTo B; P(A, B); \
  11.344 -\                 F \\<in> B leadsTo C; P(B, C) |] \
  11.345 -\              ==> P(A, C); \
  11.346 -\     !!B S. [| \\<forall>A \\<in> S. F \\<in> A leadsTo B; \\<forall>A \\<in> S. P(A, B); st_set(B); \\<forall>A \\<in> S. st_set(A)|] \
  11.347 -\        ==> P(Union(S), B) \
  11.348 -\  |] ==> P(za, zb)";
  11.349 -by (cut_facts_tac [major] 1);
  11.350 -by (rtac (major RS CollectD2 RS leads.induct) 1);
  11.351 -by (rtac union_prem 3);
  11.352 -by (rtac trans_prem 2);
  11.353 -by (rtac basis_prem 1);
  11.354 -by Auto_tac;
  11.355 -qed "leadsTo_induct";
  11.356 -
  11.357 -(* Added by Sidi, an induction rule without ensures *)
  11.358 -val [major,imp_prem,basis_prem,trans_prem,union_prem] = Goal
  11.359 -  "[| F \\<in> za leadsTo zb; \
  11.360 -\     !!A B. [| A<=B; st_set(B) |] ==> P(A, B); \
  11.361 -\     !!A B. [| F \\<in> A co A Un B; F \\<in> transient(A); st_set(B) |] ==> P(A, B); \
  11.362 -\     !!A B C. [| F \\<in> A leadsTo B; P(A, B); \
  11.363 -\                 F \\<in> B leadsTo C; P(B, C) |] \
  11.364 -\              ==> P(A, C); \
  11.365 -\     !!B S. [| \\<forall>A \\<in> S. F \\<in> A leadsTo B; \\<forall>A \\<in> S. P(A, B); st_set(B); \\<forall>A \\<in> S. st_set(A) |] \
  11.366 -\        ==> P(Union(S), B) \
  11.367 -\  |] ==> P(za, zb)";
  11.368 -by (cut_facts_tac [major] 1);
  11.369 -by (etac leadsTo_induct 1);
  11.370 -by (auto_tac (claset() addIs [trans_prem,union_prem], simpset()));
  11.371 -by (rewrite_goal_tac [ensures_def] 1);
  11.372 -by (Clarify_tac 1);
  11.373 -by (ftac constrainsD2 1);
  11.374 -by (dres_inst_tac [("B'", "(A-B) Un B")] constrains_weaken_R 1);
  11.375 -by (Blast_tac 1);
  11.376 -by (forward_tac [ensuresI2 RS leadsTo_Basis] 1);
  11.377 -by (dtac basis_prem 4);
  11.378 -by (ALLGOALS(Asm_full_simp_tac));
  11.379 -by (forw_inst_tac [("A1", "A"), ("B", "B")] (Int_lower2 RS imp_prem) 1);
  11.380 -by (subgoal_tac "A=Union({A - B, A Int B})" 1);
  11.381 -by (Blast_tac 2);
  11.382 -by (etac ssubst 1);
  11.383 -by (rtac union_prem 1);
  11.384 -by (auto_tac (claset() addIs [subset_imp_leadsTo], simpset()));
  11.385 -qed "leadsTo_induct2";
  11.386 -
  11.387 -(** Variant induction rule \\<in> on the preconditions for B **)
  11.388 -(*Lemma is the weak version \\<in> can't see how to do it in one step*)
  11.389 -val major::prems = Goal
  11.390 -  "[| F \\<in> za leadsTo zb;  \
  11.391 -\     P(zb); \
  11.392 -\     !!A B. [| F \\<in> A ensures B;  P(B); st_set(A); st_set(B) |] ==> P(A); \
  11.393 -\     !!S. [| \\<forall>A \\<in> S. P(A); \\<forall>A \\<in> S. st_set(A) |] ==> P(Union(S)) \
  11.394 -\  |] ==> P(za)";
  11.395 -(*by induction on this formula*)
  11.396 -by (subgoal_tac "P(zb) --> P(za)" 1);
  11.397 -(*now solve first subgoal \\<in> this formula is sufficient*)
  11.398 -by (blast_tac (claset() addIs leadsTo_refl::prems) 1);
  11.399 -by (rtac (major RS leadsTo_induct) 1);
  11.400 -by (REPEAT (blast_tac (claset() addIs prems) 1));
  11.401 -qed "leadsTo_induct_pre_aux";
  11.402 -
  11.403 -
  11.404 -val [major, zb_prem, basis_prem, union_prem] = Goal
  11.405 -  "[| F \\<in> za leadsTo zb;  \
  11.406 -\     P(zb); \
  11.407 -\     !!A B. [| F \\<in> A ensures B;  F \\<in> B leadsTo zb;  P(B); st_set(A) |] ==> P(A); \
  11.408 -\     !!S. \\<forall>A \\<in> S. F \\<in> A leadsTo zb & P(A) & st_set(A) ==> P(Union(S)) \
  11.409 -\  |] ==> P(za)";
  11.410 -by (cut_facts_tac [major] 1);
  11.411 -by (subgoal_tac "(F \\<in> za leadsTo zb) & P(za)" 1);
  11.412 -by (etac conjunct2 1);
  11.413 -by (rtac (major RS leadsTo_induct_pre_aux) 1);
  11.414 -by (blast_tac (claset() addDs [leadsToD2]
  11.415 -                        addIs [leadsTo_Union,union_prem]) 3);
  11.416 -by (blast_tac (claset() addIs [leadsTo_Trans,basis_prem, leadsTo_Basis]) 2);
  11.417 -by (blast_tac (claset() addIs [leadsTo_refl,zb_prem] 
  11.418 -                        addDs [leadsToD2]) 1);
  11.419 -qed "leadsTo_induct_pre";
  11.420 -
  11.421 -(** The impossibility law **)
  11.422 -Goal
  11.423 -   "F \\<in> A leadsTo 0 ==> A=0";
  11.424 -by (etac leadsTo_induct_pre 1);
  11.425 -by (auto_tac (claset(), simpset() addsimps
  11.426 -        [ensures_def, constrains_def, transient_def, st_set_def]));
  11.427 -by (dtac bspec 1);
  11.428 -by (REPEAT(Blast_tac 1));
  11.429 -qed "leadsTo_empty";
  11.430 -Addsimps [leadsTo_empty];
  11.431 -
  11.432 -(** PSP \\<in> Progress-Safety-Progress **)
  11.433 -
  11.434 -(*Special case of PSP \\<in> Misra's "stable conjunction"*)
  11.435 -Goalw [stable_def]
  11.436 -   "[| F \\<in> A leadsTo A'; F \\<in> stable(B) |] ==> F:(A Int B) leadsTo (A' Int B)";
  11.437 -by (etac leadsTo_induct 1);
  11.438 -by (rtac leadsTo_Union_Int 3);
  11.439 -by (ALLGOALS(Asm_simp_tac));
  11.440 -by (REPEAT(blast_tac (claset() addDs [constrainsD2]) 3));
  11.441 -by (blast_tac (claset() addIs [leadsTo_Trans]) 2);
  11.442 -by (rtac leadsTo_Basis 1);
  11.443 -by (asm_full_simp_tac (simpset() 
  11.444 -         addsimps [ensures_def, Diff_Int_distrib RS sym, 
  11.445 -                   Diff_Int_distrib2 RS sym, Int_Un_distrib2 RS sym]) 1);
  11.446 -by (REPEAT(blast_tac (claset() 
  11.447 -               addIs [transient_strengthen,constrains_Int]
  11.448 -               addDs [constrainsD2]) 1));
  11.449 -qed "psp_stable";
  11.450 -
  11.451 -
  11.452 -Goal "[|F \\<in> A leadsTo A'; F \\<in> stable(B) |]==>F: (B Int A) leadsTo (B Int A')";
  11.453 -by (asm_simp_tac (simpset() 
  11.454 -             addsimps psp_stable::Int_ac) 1);
  11.455 -qed "psp_stable2";
  11.456 -
  11.457 -Goalw [ensures_def, constrains_def, st_set_def]
  11.458 -"[| F \\<in> A ensures A'; F \\<in> B co B' |]==> F: (A Int B') ensures ((A' Int B) Un (B' - B))";
  11.459 -(*speeds up the proof*)
  11.460 -by (Clarify_tac 1);  
  11.461 -by (blast_tac (claset() addIs [transient_strengthen]) 1);
  11.462 -qed "psp_ensures";
  11.463 -
  11.464 -Goal 
  11.465 -"[|F \\<in> A leadsTo A'; F \\<in> B co B'; st_set(B')|]==> F:(A Int B') leadsTo ((A' Int B) Un (B' - B))";
  11.466 -by (subgoal_tac "F \\<in> program & st_set(A) & st_set(A')& st_set(B)" 1);
  11.467 -by (blast_tac (claset() addSDs [constrainsD2, leadsToD2]) 2);
  11.468 -by (etac leadsTo_induct 1);
  11.469 -by (blast_tac (claset() addIs [leadsTo_Union_Int]) 3);
  11.470 -(*Transitivity case has a delicate argument involving "cancellation"*)
  11.471 -by (rtac leadsTo_Un_duplicate2 2);
  11.472 -by (etac leadsTo_cancel_Diff1 2);
  11.473 -by (asm_full_simp_tac (simpset() addsimps [Int_Diff, Diff_triv]) 2);
  11.474 -by (blast_tac (claset() addIs [leadsTo_weaken_L] 
  11.475 -                        addDs [constrains_imp_subset]) 2);
  11.476 -(*Basis case*)
  11.477 -by (blast_tac (claset() addIs [psp_ensures, leadsTo_Basis]) 1);
  11.478 -qed "psp";
  11.479 -
  11.480 -
  11.481 -Goal "[| F \\<in> A leadsTo A'; F \\<in> B co B'; st_set(B') |] \
  11.482 -\   ==> F \\<in> (B' Int A) leadsTo ((B Int A') Un (B' - B))";
  11.483 -by (asm_simp_tac (simpset() addsimps psp::Int_ac) 1);
  11.484 -qed "psp2";
  11.485 -
  11.486 -Goalw [unless_def]
  11.487 -   "[| F \\<in> A leadsTo A';  F \\<in> B unless B'; st_set(B); st_set(B') |] \
  11.488 -\   ==> F \\<in> (A Int B) leadsTo ((A' Int B) Un B')";
  11.489 -by (subgoal_tac "st_set(A)&st_set(A')" 1);
  11.490 -by (blast_tac (claset() addDs [leadsToD2]) 2);
  11.491 -by (dtac psp 1);
  11.492 -by (assume_tac 1);
  11.493 -by (Blast_tac 1);
  11.494 -by (REPEAT(blast_tac (claset() addIs [leadsTo_weaken]) 1));
  11.495 -qed "psp_unless";
  11.496 -
  11.497 -(*** Proving the wf induction rules ***)
  11.498 -(** The most general rule \\<in> r is any wf relation; f is any variant function **)
  11.499 -Goal "[| wf(r); \
  11.500 -\        m \\<in> I; \
  11.501 -\        field(r)<=I; \
  11.502 -\        F \\<in> program; st_set(B);\
  11.503 -\        \\<forall>m \\<in> I. F \\<in> (A Int f-``{m}) leadsTo                     \
  11.504 -\                   ((A Int f-``(converse(r)``{m})) Un B) |] \
  11.505 -\     ==> F \\<in> (A Int f-``{m}) leadsTo B";
  11.506 -by (eres_inst_tac [("a","m")] wf_induct2 1);
  11.507 -by (ALLGOALS(Asm_simp_tac));
  11.508 -by (subgoal_tac "F \\<in> (A Int (f-``(converse(r)``{x}))) leadsTo B" 1);
  11.509 -by (stac vimage_eq_UN 2);
  11.510 -by (asm_simp_tac (simpset() delsimps UN_simps
  11.511 -			    addsimps [Int_UN_distrib]) 2);
  11.512 -by (blast_tac (claset() addIs [leadsTo_cancel1, leadsTo_Un_duplicate]) 1);
  11.513 -by (auto_tac (claset() addIs [leadsTo_UN], 
  11.514 -              simpset()  delsimps UN_simps addsimps [Int_UN_distrib]));
  11.515 -qed "leadsTo_wf_induct_aux";
  11.516 -
  11.517 -(** Meta or object quantifier ? **)
  11.518 -Goal "[| wf(r); \
  11.519 -\        field(r)<=I; \
  11.520 -\        A<=f-``I;\ 
  11.521 -\        F \\<in> program; st_set(A); st_set(B); \
  11.522 -\        \\<forall>m \\<in> I. F \\<in> (A Int f-``{m}) leadsTo                     \
  11.523 -\                   ((A Int f-``(converse(r)``{m})) Un B) |] \
  11.524 -\     ==> F \\<in> A leadsTo B";
  11.525 -by (res_inst_tac [("b", "A")] subst 1);
  11.526 -by (res_inst_tac [("I", "I")] leadsTo_UN 2);
  11.527 -by (REPEAT (assume_tac 2));
  11.528 -by (Clarify_tac 2);
  11.529 -by (eres_inst_tac [("I", "I")] leadsTo_wf_induct_aux 2);
  11.530 -by (REPEAT (assume_tac 2));
  11.531 -by (rtac equalityI 1);
  11.532 -by Safe_tac;
  11.533 -by (thin_tac "field(r)<=I" 1);
  11.534 -by (dres_inst_tac [("c", "x")] subsetD 1);
  11.535 -by Safe_tac;
  11.536 -by (res_inst_tac [("b", "x")] UN_I 1);
  11.537 -by Auto_tac;
  11.538 -qed "leadsTo_wf_induct";
  11.539 -
  11.540 -Goalw [field_def] "field(measure(nat, %x. x)) = nat";
  11.541 -by (asm_full_simp_tac (simpset() addsimps [measure_def]) 1) ;
  11.542 -by (rtac equalityI 1);
  11.543 -by (force_tac (claset(), simpset()) 1);
  11.544 -by (Clarify_tac 1);
  11.545 -by (thin_tac "x\\<notin>range(?y)" 1);
  11.546 -by (etac nat_induct 1);
  11.547 -by (res_inst_tac [("b", "succ(succ(xa))")] domainI 2);
  11.548 -by (res_inst_tac [("b","succ(0)")] domainI 1); 
  11.549 -by (ALLGOALS Asm_full_simp_tac);
  11.550 -qed "nat_measure_field";
  11.551 -
  11.552 -
  11.553 -Goal "k<A ==> measure(A, %x. x) -`` {k} = k";
  11.554 -by (rtac equalityI 1);
  11.555 -by (auto_tac (claset(), simpset() addsimps [measure_def]));
  11.556 -by (blast_tac (claset() addIs [ltD]) 1); 
  11.557 -by (rtac vimageI 1); 
  11.558 -by (Blast_tac 2); 
  11.559 -by (asm_full_simp_tac (simpset() addsimps [lt_Ord, lt_Ord2, Ord_mem_iff_lt]) 1); 
  11.560 -by (blast_tac (claset() addIs [lt_trans]) 1); 
  11.561 -qed "Image_inverse_lessThan";
  11.562 -
  11.563 -(*Alternative proof is via the lemma F \\<in> (A Int f-`(lessThan m)) leadsTo B*)
  11.564 -Goal
  11.565 - "[| A<=f-``nat;\ 
  11.566 -\    F \\<in> program; st_set(A); st_set(B); \
  11.567 -\    \\<forall>m \\<in> nat. F:(A Int f-``{m}) leadsTo ((A Int f -`` m) Un B) |] \
  11.568 -\     ==> F \\<in> A leadsTo B";
  11.569 -by (res_inst_tac [("A1", "nat"),("f1", "%x. x")]
  11.570 -        (wf_measure RS leadsTo_wf_induct) 1);
  11.571 -by (Clarify_tac 6);
  11.572 -by (ALLGOALS(asm_full_simp_tac 
  11.573 -          (simpset() addsimps [nat_measure_field]))); 
  11.574 -by (asm_simp_tac (simpset() addsimps [ltI, Image_inverse_lessThan, symmetric vimage_def]) 1); 
  11.575 -qed "lessThan_induct";
  11.576 -
  11.577 -
  11.578 -(*** wlt ****)
  11.579 -
  11.580 -(*Misra's property W3*)
  11.581 -Goalw [wlt_def] "wlt(F,B) <=state";
  11.582 -by Auto_tac;
  11.583 -qed "wlt_type";
  11.584 -
  11.585 -Goalw [st_set_def] "st_set(wlt(F, B))";
  11.586 -by (rtac wlt_type 1);
  11.587 -qed "wlt_st_set";
  11.588 -AddIffs [wlt_st_set];
  11.589 -
  11.590 -Goalw [wlt_def] "F \\<in> wlt(F, B) leadsTo B <-> (F \\<in> program & st_set(B))";
  11.591 -by (blast_tac (claset() addDs [leadsToD2] addSIs [leadsTo_Union]) 1);
  11.592 -qed "wlt_leadsTo_iff";
  11.593 -
  11.594 -(* [| F \\<in> program;  st_set(B) |] ==> F \\<in> wlt(F, B) leadsTo B  *)
  11.595 -bind_thm("wlt_leadsTo", conjI RS (wlt_leadsTo_iff RS iffD2));
  11.596 -
  11.597 -Goalw [wlt_def] "F \\<in> A leadsTo B ==> A <= wlt(F, B)";
  11.598 -by (ftac leadsToD2 1);
  11.599 -by (auto_tac (claset(), simpset() addsimps [st_set_def]));
  11.600 -qed "leadsTo_subset";
  11.601 -
  11.602 -(*Misra's property W2*)
  11.603 -Goal "F \\<in> A leadsTo B <-> (A <= wlt(F,B) & F \\<in> program & st_set(B))";
  11.604 -by Auto_tac;
  11.605 -by (REPEAT(blast_tac (claset() addDs [leadsToD2,leadsTo_subset]
  11.606 -                               addIs [leadsTo_weaken_L, wlt_leadsTo]) 1));
  11.607 -qed "leadsTo_eq_subset_wlt";
  11.608 -
  11.609 -(*Misra's property W4*)
  11.610 -Goal "[| F \\<in> program; st_set(B) |] ==> B <= wlt(F,B)";
  11.611 -by (rtac leadsTo_subset 1);
  11.612 -by (asm_simp_tac (simpset() 
  11.613 -         addsimps [leadsTo_eq_subset_wlt RS iff_sym,
  11.614 -                   subset_imp_leadsTo]) 1);
  11.615 -qed "wlt_increasing";
  11.616 -
  11.617 -(*Used in the Trans case below*)
  11.618 -Goalw [constrains_def, st_set_def]
  11.619 -   "[| B <= A2; \
  11.620 -\      F \\<in> (A1 - B) co (A1 Un B); \
  11.621 -\      F \\<in> (A2 - C) co (A2 Un C) |] \
  11.622 -\   ==> F \\<in> (A1 Un A2 - C) co (A1 Un A2 Un C)";
  11.623 -by (Blast_tac 1);
  11.624 -qed "leadsTo_123_aux";
  11.625 -
  11.626 -(*Lemma (1,2,3) of Misra's draft book, Chapter 4, "Progress"*)
  11.627 -(* slightly different from the HOL one \\<in> B here is bounded *)
  11.628 -Goal "F \\<in> A leadsTo A' \
  11.629 -\     ==> \\<exists>B \\<in> Pow(state). A<=B & F \\<in> B leadsTo A' & F \\<in> (B-A') co (B Un A')";
  11.630 -by (ftac leadsToD2 1);
  11.631 -by (etac leadsTo_induct 1);
  11.632 -(*Basis*)
  11.633 -by (blast_tac (claset() addDs [ensuresD, constrainsD2, st_setD]) 1);
  11.634 -(*Trans*)
  11.635 -by (Clarify_tac 1);
  11.636 -by (res_inst_tac [("x", "Ba Un Bb")] bexI 1);
  11.637 -by (blast_tac (claset() addIs [leadsTo_123_aux,leadsTo_Un_Un, leadsTo_cancel1,
  11.638 -                               leadsTo_Un_duplicate]) 1);
  11.639 -by (Blast_tac 1);
  11.640 -(*Union*)
  11.641 -by (clarify_tac (claset() addSDs [ball_conj_distrib RS iffD1]) 1);
  11.642 -by (subgoal_tac "\\<exists>y. y \\<in> Pi(S, %A. {Ba \\<in> Pow(state). A<=Ba & \
  11.643 -                          \         F \\<in> Ba leadsTo B & F \\<in> Ba - B co Ba Un B})" 1);
  11.644 -by (rtac AC_ball_Pi 2);
  11.645 -by (ALLGOALS(Clarify_tac));
  11.646 -by (rotate_tac 1 2);
  11.647 -by (dres_inst_tac [("x", "x")] bspec 2);
  11.648 -by (REPEAT(Blast_tac 2));
  11.649 -by (res_inst_tac [("x", "\\<Union>A \\<in> S. y`A")] bexI 1);
  11.650 -by Safe_tac;
  11.651 -by (res_inst_tac [("I1", "S")] (constrains_UN RS constrains_weaken) 3);
  11.652 -by (rtac leadsTo_Union 2);
  11.653 -by (blast_tac (claset() addSDs [apply_type]) 5);  
  11.654 -by (ALLGOALS(Asm_full_simp_tac));
  11.655 -by (REPEAT(force_tac (claset() addSDs [apply_type], simpset()) 1));
  11.656 -qed "leadsTo_123";
  11.657 -
  11.658 -
  11.659 -(*Misra's property W5*)
  11.660 -Goal "[| F \\<in> program; st_set(B) |] ==>F \\<in> (wlt(F, B) - B) co (wlt(F,B))";
  11.661 -by (cut_inst_tac [("F","F")] (wlt_leadsTo RS leadsTo_123) 1);
  11.662 -by (assume_tac 1);
  11.663 -by (Blast_tac 1);
  11.664 -by (Clarify_tac 1);
  11.665 -by (subgoal_tac "Ba = wlt(F,B)" 1);
  11.666 -by (blast_tac (claset() addDs [leadsTo_eq_subset_wlt RS iffD1]) 2);
  11.667 -by (Clarify_tac 1);
  11.668 -by (asm_full_simp_tac (simpset() 
  11.669 -         addsimps [wlt_increasing RS (subset_Un_iff2 RS iffD1)]) 1);
  11.670 -qed "wlt_constrains_wlt";
  11.671 -
  11.672 -(*** Completion \\<in> Binary and General Finite versions ***)
  11.673 -
  11.674 -Goal "[| W = wlt(F, (B' Un C));     \
  11.675 -\      F \\<in> A leadsTo (A' Un C);  F \\<in> A' co (A' Un C);   \
  11.676 -\      F \\<in> B leadsTo (B' Un C);  F \\<in> B' co (B' Un C) |] \
  11.677 -\   ==> F \\<in> (A Int B) leadsTo ((A' Int B') Un C)";
  11.678 -by (subgoal_tac "st_set(C)&st_set(W)&st_set(W-C)&st_set(A')&st_set(A)\
  11.679 -\                & st_set(B) & st_set(B') & F \\<in> program" 1);
  11.680 -by (Asm_simp_tac 2);
  11.681 -by (blast_tac (claset() addSDs [leadsToD2]) 2);
  11.682 -by (subgoal_tac "F \\<in> (W-C) co (W Un B' Un C)" 1);
  11.683 -by (blast_tac (claset() addSIs [[asm_rl, wlt_constrains_wlt] 
  11.684 -                               MRS constrains_Un RS constrains_weaken]) 2);
  11.685 -by (subgoal_tac "F \\<in> (W-C) co W" 1);
  11.686 -by (asm_full_simp_tac (simpset() addsimps  [wlt_increasing RS 
  11.687 -                            (subset_Un_iff2 RS iffD1), Un_assoc]) 2);
  11.688 -by (subgoal_tac "F \\<in> (A Int W - C) leadsTo (A' Int W Un C)" 1);
  11.689 -by (blast_tac (claset() addIs [wlt_leadsTo, psp RS leadsTo_weaken]) 2);
  11.690 -(** LEVEL 9 **)
  11.691 -by (subgoal_tac "F \\<in> (A' Int W Un C) leadsTo (A' Int B' Un C)" 1);
  11.692 -by (rtac leadsTo_Un_duplicate2 2);
  11.693 -by (rtac leadsTo_Un_Un 2);
  11.694 -by (blast_tac (claset() addIs [leadsTo_refl]) 3);
  11.695 -by (res_inst_tac [("A'1", "B' Un C")] (wlt_leadsTo RS psp2 RS leadsTo_weaken) 2);
  11.696 -by (REPEAT(Blast_tac 2));
  11.697 -(** LEVEL 17 **)
  11.698 -by (dtac leadsTo_Diff 1);
  11.699 -by (blast_tac (claset() addIs [subset_imp_leadsTo]
  11.700 -                        addDs [leadsToD2, constrainsD2]) 1); 
  11.701 -by (force_tac (claset(), simpset() addsimps [st_set_def]) 1);
  11.702 -by (subgoal_tac "A Int B <= A Int W" 1);
  11.703 -by (blast_tac (claset() addSDs [leadsTo_subset]
  11.704 -                        addSIs [subset_refl RS Int_mono]) 2);
  11.705 -by (blast_tac (claset() addIs [leadsTo_Trans, subset_imp_leadsTo]) 1); 
  11.706 -qed "completion_aux";
  11.707 -bind_thm("completion", refl RS completion_aux);
  11.708 -
  11.709 -Goal "[| I \\<in> Fin(X); F \\<in> program; st_set(C) |] ==> \
  11.710 -\(\\<forall>i \\<in> I. F \\<in> (A(i)) leadsTo (A'(i) Un C)) -->  \
  11.711 -\                  (\\<forall>i \\<in> I. F \\<in> (A'(i)) co (A'(i) Un C)) --> \
  11.712 -\                  F \\<in> (\\<Inter>i \\<in> I. A(i)) leadsTo ((\\<Inter>i \\<in> I. A'(i)) Un C)";
  11.713 -by (etac Fin_induct 1); 
  11.714 -by (auto_tac (claset(), simpset() addsimps [Inter_0]));
  11.715 -by (rtac completion 1);
  11.716 -by (auto_tac (claset(), 
  11.717 -              simpset() delsimps INT_simps addsimps INT_extend_simps)); 
  11.718 -by (rtac constrains_INT 1);
  11.719 -by (REPEAT(Blast_tac 1));
  11.720 -qed "lemma";
  11.721 -
  11.722 -val prems = Goal
  11.723 -     "[| I \\<in> Fin(X);  \
  11.724 -\        !!i. i \\<in> I ==> F \\<in> A(i) leadsTo (A'(i) Un C); \
  11.725 -\        !!i. i \\<in> I ==> F \\<in> A'(i) co (A'(i) Un C); F \\<in> program; st_set(C)|]   \
  11.726 -\     ==> F \\<in> (\\<Inter>i \\<in> I. A(i)) leadsTo ((\\<Inter>i \\<in> I. A'(i)) Un C)";
  11.727 -by (resolve_tac [lemma RS mp RS mp] 1);
  11.728 -by (resolve_tac prems 3);
  11.729 -by (REPEAT(blast_tac (claset() addIs prems) 1));
  11.730 -qed "finite_completion";
  11.731 -
  11.732 -Goalw [stable_def]
  11.733 -     "[| F \\<in> A leadsTo A';  F \\<in> stable(A');   \
  11.734 -\        F \\<in> B leadsTo B';  F \\<in> stable(B') |] \
  11.735 -\   ==> F \\<in> (A Int B) leadsTo (A' Int B')";
  11.736 -by (res_inst_tac [("C1", "0")] (completion RS leadsTo_weaken_R) 1);
  11.737 -by (REPEAT(blast_tac (claset() addDs [leadsToD2, constrainsD2]) 5));
  11.738 -by (ALLGOALS(Asm_full_simp_tac));
  11.739 -qed "stable_completion";
  11.740 -
  11.741 -
  11.742 -val major::prems = Goalw [stable_def]
  11.743 -     "[| I \\<in> Fin(X); \
  11.744 -\        (!!i. i \\<in> I ==> F \\<in> A(i) leadsTo A'(i)); \
  11.745 -\        (!!i. i \\<in> I ==> F \\<in> stable(A'(i)));  F \\<in> program |] \
  11.746 -\     ==> F \\<in> (\\<Inter>i \\<in> I. A(i)) leadsTo (\\<Inter>i \\<in> I. A'(i))";
  11.747 -by (cut_facts_tac [major] 1);
  11.748 -by (subgoal_tac "st_set(\\<Inter>i \\<in> I. A'(i))" 1);
  11.749 -by (blast_tac (claset() addDs [leadsToD2]@prems) 2);
  11.750 -by (res_inst_tac [("C1", "0")] (finite_completion RS leadsTo_weaken_R) 1);
  11.751 -by (Asm_simp_tac 1);
  11.752 -by (assume_tac 6);
  11.753 -by (ALLGOALS(asm_full_simp_tac (simpset() addsimps prems)));
  11.754 -by (resolve_tac prems 2);
  11.755 -by (resolve_tac prems 1);
  11.756 -by Auto_tac;
  11.757 -qed "finite_stable_completion";
  11.758 -
    12.1 --- a/src/ZF/UNITY/WFair.thy	Sat Mar 26 18:20:29 2005 +0100
    12.2 +++ b/src/ZF/UNITY/WFair.thy	Mon Mar 28 16:19:56 2005 +0200
    12.3 @@ -2,15 +2,18 @@
    12.4      ID:         $Id$
    12.5      Author:     Sidi Ehmety, Computer Laboratory
    12.6      Copyright   1998  University of Cambridge
    12.7 -
    12.8 -Weak Fairness versions of transient, ensures, leadsTo.
    12.9 -
   12.10 -From Misra, "A Logic for Concurrent Programming", 1994
   12.11 -
   12.12 -Theory ported from HOL.
   12.13  *)
   12.14  
   12.15 -WFair = UNITY + Main_ZFC + 
   12.16 +header{*Progress under Weak Fairness*}
   12.17 +
   12.18 +theory WFair
   12.19 +imports UNITY Main_ZFC
   12.20 +begin
   12.21 +
   12.22 +text{*This theory defines the operators transient, ensures and leadsTo,
   12.23 +assuming weak fairness. From Misra, "A Logic for Concurrent Programming",
   12.24 +1994.*}
   12.25 +
   12.26  constdefs
   12.27    
   12.28    (* This definition specifies weak fairness.  The rest of the theory
   12.29 @@ -19,7 +22,7 @@
   12.30    "transient(A) =={F:program. (EX act: Acts(F). A<=domain(act) &
   12.31  			       act``A <= state-A) & st_set(A)}"
   12.32  
   12.33 -  ensures :: "[i,i] => i"       (infixl 60)
   12.34 +  ensures :: "[i,i] => i"       (infixl "ensures" 60)
   12.35    "A ensures B == ((A-B) co (A Un B)) Int transient(A-B)"
   12.36    
   12.37  consts
   12.38 @@ -30,19 +33,19 @@
   12.39  inductive 
   12.40    domains
   12.41       "leads(D, F)" <= "Pow(D)*Pow(D)"
   12.42 -  intrs 
   12.43 -    Basis  "[| F:A ensures B;  A:Pow(D); B:Pow(D) |] ==> <A,B>:leads(D, F)"
   12.44 -    Trans  "[| <A,B> : leads(D, F); <B,C> : leads(D, F) |] ==>  <A,C>:leads(D, F)"
   12.45 -    Union   "[| S:Pow({A:S. <A, B>:leads(D, F)}); B:Pow(D); S:Pow(Pow(D)) |] ==> 
   12.46 +  intros 
   12.47 +    Basis:  "[| F:A ensures B;  A:Pow(D); B:Pow(D) |] ==> <A,B>:leads(D, F)"
   12.48 +    Trans:  "[| <A,B> : leads(D, F); <B,C> : leads(D, F) |] ==>  <A,C>:leads(D, F)"
   12.49 +    Union:   "[| S:Pow({A:S. <A, B>:leads(D, F)}); B:Pow(D); S:Pow(Pow(D)) |] ==> 
   12.50  	      <Union(S),B>:leads(D, F)"
   12.51  
   12.52    monos        Pow_mono
   12.53 -  type_intrs  "[Union_Pow_iff RS iffD2, UnionI, PowI]"
   12.54 +  type_intros  Union_Pow_iff [THEN iffD2] UnionI PowI
   12.55   
   12.56  constdefs
   12.57  
   12.58    (* The Visible version of the LEADS-TO relation*)
   12.59 -  leadsTo :: "[i, i] => i"       (infixl 60)
   12.60 +  leadsTo :: "[i, i] => i"       (infixl "leadsTo" 60)
   12.61    "A leadsTo B == {F:program. <A,B>:leads(state, F)}"
   12.62    
   12.63    (* wlt(F, B) is the largest set that leads to B*)
   12.64 @@ -50,6 +53,748 @@
   12.65      "wlt(F, B) == Union({A:Pow(state). F: A leadsTo B})"
   12.66  
   12.67  syntax (xsymbols)
   12.68 -  "op leadsTo" :: "[i, i] => i" (infixl "\\<longmapsto>" 60)
   12.69 +  "leadsTo" :: "[i, i] => i" (infixl "\<longmapsto>" 60)
   12.70 +
   12.71 +(** Ad-hoc set-theory rules **)
   12.72 +
   12.73 +lemma Int_Union_Union: "Union(B) Int A = (\<Union>b \<in> B. b Int A)"
   12.74 +by auto
   12.75 +
   12.76 +lemma Int_Union_Union2: "A Int Union(B) = (\<Union>b \<in> B. A Int b)"
   12.77 +by auto
   12.78 +
   12.79 +(*** transient ***)
   12.80 +
   12.81 +lemma transient_type: "transient(A)<=program"
   12.82 +by (unfold transient_def, auto)
   12.83 +
   12.84 +lemma transientD2: 
   12.85 +"F \<in> transient(A) ==> F \<in> program & st_set(A)"
   12.86 +apply (unfold transient_def, auto)
   12.87 +done
   12.88 +
   12.89 +lemma stable_transient_empty: "[| F \<in> stable(A); F \<in> transient(A) |] ==> A = 0"
   12.90 +by (simp add: stable_def constrains_def transient_def, fast)
   12.91 +
   12.92 +lemma transient_strengthen: "[|F \<in> transient(A); B<=A|] ==> F \<in> transient(B)"
   12.93 +apply (simp add: transient_def st_set_def, clarify)
   12.94 +apply (blast intro!: rev_bexI)
   12.95 +done
   12.96 +
   12.97 +lemma transientI: 
   12.98 +"[|act \<in> Acts(F); A <= domain(act); act``A <= state-A;  
   12.99 +    F \<in> program; st_set(A)|] ==> F \<in> transient(A)"
  12.100 +by (simp add: transient_def, blast)
  12.101 +
  12.102 +lemma transientE: 
  12.103 +     "[| F \<in> transient(A);  
  12.104 +         !!act. [| act \<in> Acts(F);  A <= domain(act); act``A <= state-A|]==>P|]
  12.105 +      ==>P"
  12.106 +by (simp add: transient_def, blast)
  12.107 +
  12.108 +lemma transient_state: "transient(state) = 0"
  12.109 +apply (simp add: transient_def)
  12.110 +apply (rule equalityI, auto) 
  12.111 +apply (cut_tac F = x in Acts_type)
  12.112 +apply (simp add: Diff_cancel)
  12.113 +apply (auto intro: st0_in_state)
  12.114 +done
  12.115 +
  12.116 +lemma transient_state2: "state<=B ==> transient(B) = 0"
  12.117 +apply (simp add: transient_def st_set_def)
  12.118 +apply (rule equalityI, auto)
  12.119 +apply (cut_tac F = x in Acts_type)
  12.120 +apply (subgoal_tac "B=state")
  12.121 +apply (auto intro: st0_in_state)
  12.122 +done
  12.123 +
  12.124 +lemma transient_empty: "transient(0) = program"
  12.125 +by (auto simp add: transient_def)
  12.126 +
  12.127 +declare transient_empty [simp] transient_state [simp] transient_state2 [simp]
  12.128 +
  12.129 +(*** ensures ***)
  12.130 +
  12.131 +lemma ensures_type: "A ensures B <=program"
  12.132 +by (simp add: ensures_def constrains_def, auto)
  12.133 +
  12.134 +lemma ensuresI: 
  12.135 +"[|F:(A-B) co (A Un B); F \<in> transient(A-B)|]==>F \<in> A ensures B"
  12.136 +apply (unfold ensures_def)
  12.137 +apply (auto simp add: transient_type [THEN subsetD])
  12.138 +done
  12.139 +
  12.140 +(* Added by Sidi, from Misra's notes, Progress chapter, exercise 4 *)
  12.141 +lemma ensuresI2: "[| F \<in> A co A Un B; F \<in> transient(A) |] ==> F \<in> A ensures B"
  12.142 +apply (drule_tac B = "A-B" in constrains_weaken_L)
  12.143 +apply (drule_tac [2] B = "A-B" in transient_strengthen)
  12.144 +apply (auto simp add: ensures_def transient_type [THEN subsetD])
  12.145 +done
  12.146 +
  12.147 +lemma ensuresD: "F \<in> A ensures B ==> F:(A-B) co (A Un B) & F \<in> transient (A-B)"
  12.148 +by (unfold ensures_def, auto)
  12.149 +
  12.150 +lemma ensures_weaken_R: "[|F \<in> A ensures A'; A'<=B' |] ==> F \<in> A ensures B'"
  12.151 +apply (unfold ensures_def)
  12.152 +apply (blast intro: transient_strengthen constrains_weaken)
  12.153 +done
  12.154 +
  12.155 +(*The L-version (precondition strengthening) fails, but we have this*) 
  12.156 +lemma stable_ensures_Int: 
  12.157 +     "[| F \<in> stable(C);  F \<in> A ensures B |] ==> F:(C Int A) ensures (C Int B)"
  12.158 + 
  12.159 +apply (unfold ensures_def)
  12.160 +apply (simp (no_asm) add: Int_Un_distrib [symmetric] Diff_Int_distrib [symmetric])
  12.161 +apply (blast intro: transient_strengthen stable_constrains_Int constrains_weaken)
  12.162 +done
  12.163 +
  12.164 +lemma stable_transient_ensures: "[|F \<in> stable(A);  F \<in> transient(C); A<=B Un C|] ==> F \<in> A ensures B"
  12.165 +apply (frule stable_type [THEN subsetD])
  12.166 +apply (simp add: ensures_def stable_def)
  12.167 +apply (blast intro: transient_strengthen constrains_weaken)
  12.168 +done
  12.169 +
  12.170 +lemma ensures_eq: "(A ensures B) = (A unless B) Int transient (A-B)"
  12.171 +by (auto simp add: ensures_def unless_def)
  12.172 +
  12.173 +lemma subset_imp_ensures: "[| F \<in> program; A<=B  |] ==> F \<in> A ensures B"
  12.174 +by (auto simp add: ensures_def constrains_def transient_def st_set_def)
  12.175 +
  12.176 +(*** leadsTo ***)
  12.177 +lemmas leads_left = leads.dom_subset [THEN subsetD, THEN SigmaD1]
  12.178 +lemmas leads_right = leads.dom_subset [THEN subsetD, THEN SigmaD2]
  12.179 +
  12.180 +lemma leadsTo_type: "A leadsTo B <= program"
  12.181 +by (unfold leadsTo_def, auto)
  12.182 +
  12.183 +lemma leadsToD2: 
  12.184 +"F \<in> A leadsTo B ==> F \<in> program & st_set(A) & st_set(B)"
  12.185 +apply (unfold leadsTo_def st_set_def)
  12.186 +apply (blast dest: leads_left leads_right)
  12.187 +done
  12.188 +
  12.189 +lemma leadsTo_Basis: 
  12.190 +    "[|F \<in> A ensures B; st_set(A); st_set(B)|] ==> F \<in> A leadsTo B"
  12.191 +apply (unfold leadsTo_def st_set_def)
  12.192 +apply (cut_tac ensures_type)
  12.193 +apply (auto intro: leads.Basis)
  12.194 +done
  12.195 +declare leadsTo_Basis [intro]
  12.196 +
  12.197 +(* Added by Sidi, from Misra's notes, Progress chapter, exercise number 4 *)
  12.198 +(* [| F \<in> program; A<=B;  st_set(A); st_set(B) |] ==> A leadsTo B *)
  12.199 +lemmas subset_imp_leadsTo = subset_imp_ensures [THEN leadsTo_Basis, standard]
  12.200 +
  12.201 +lemma leadsTo_Trans: "[|F \<in> A leadsTo B;  F \<in> B leadsTo C |]==>F \<in> A leadsTo C"
  12.202 +apply (unfold leadsTo_def)
  12.203 +apply (auto intro: leads.Trans)
  12.204 +done
  12.205 +
  12.206 +(* Better when used in association with leadsTo_weaken_R *)
  12.207 +lemma transient_imp_leadsTo: "F \<in> transient(A) ==> F \<in> A leadsTo (state-A)"
  12.208 +apply (unfold transient_def)
  12.209 +apply (blast intro: ensuresI [THEN leadsTo_Basis] constrains_weaken transientI)
  12.210 +done
  12.211 +
  12.212 +(*Useful with cancellation, disjunction*)
  12.213 +lemma leadsTo_Un_duplicate: "F \<in> A leadsTo (A' Un A') ==> F \<in> A leadsTo A'"
  12.214 +by simp
  12.215 +
  12.216 +lemma leadsTo_Un_duplicate2:
  12.217 +     "F \<in> A leadsTo (A' Un C Un C) ==> F \<in> A leadsTo (A' Un C)"
  12.218 +by (simp add: Un_ac)
  12.219 +
  12.220 +(*The Union introduction rule as we should have liked to state it*)
  12.221 +lemma leadsTo_Union: 
  12.222 +    "[|!!A. A \<in> S ==> F \<in> A leadsTo B; F \<in> program; st_set(B)|]
  12.223 +     ==> F \<in> Union(S) leadsTo B"
  12.224 +apply (unfold leadsTo_def st_set_def)
  12.225 +apply (blast intro: leads.Union dest: leads_left)
  12.226 +done
  12.227 +
  12.228 +lemma leadsTo_Union_Int: 
  12.229 +    "[|!!A. A \<in> S ==>F : (A Int C) leadsTo B; F \<in> program; st_set(B)|]  
  12.230 +     ==> F : (Union(S)Int C)leadsTo B"
  12.231 +apply (unfold leadsTo_def st_set_def)
  12.232 +apply (simp only: Int_Union_Union)
  12.233 +apply (blast dest: leads_left intro: leads.Union)
  12.234 +done
  12.235 +
  12.236 +lemma leadsTo_UN: 
  12.237 +    "[| !!i. i \<in> I ==> F \<in> A(i) leadsTo B; F \<in> program; st_set(B)|]
  12.238 +     ==> F:(\<Union>i \<in> I. A(i)) leadsTo B"
  12.239 +apply (simp add: Int_Union_Union leadsTo_def st_set_def)
  12.240 +apply (blast dest: leads_left intro: leads.Union)
  12.241 +done
  12.242 +
  12.243 +(* Binary union introduction rule *)
  12.244 +lemma leadsTo_Un:
  12.245 +     "[| F \<in> A leadsTo C; F \<in> B leadsTo C |] ==> F \<in> (A Un B) leadsTo C"
  12.246 +apply (subst Un_eq_Union)
  12.247 +apply (blast intro: leadsTo_Union dest: leadsToD2)
  12.248 +done
  12.249 +
  12.250 +lemma single_leadsTo_I:
  12.251 +    "[|!!x. x \<in> A==> F:{x} leadsTo B; F \<in> program; st_set(B) |] 
  12.252 +     ==> F \<in> A leadsTo B"
  12.253 +apply (rule_tac b = A in UN_singleton [THEN subst])
  12.254 +apply (rule leadsTo_UN, auto) 
  12.255 +done
  12.256 +
  12.257 +lemma leadsTo_refl: "[| F \<in> program; st_set(A) |] ==> F \<in> A leadsTo A"
  12.258 +by (blast intro: subset_imp_leadsTo)
  12.259 +
  12.260 +lemma leadsTo_refl_iff: "F \<in> A leadsTo A <-> F \<in> program & st_set(A)"
  12.261 +by (auto intro: leadsTo_refl dest: leadsToD2)
  12.262 +
  12.263 +lemma empty_leadsTo: "F \<in> 0 leadsTo B <-> (F \<in> program & st_set(B))"
  12.264 +by (auto intro: subset_imp_leadsTo dest: leadsToD2)
  12.265 +declare empty_leadsTo [iff]
  12.266 +
  12.267 +lemma leadsTo_state: "F \<in> A leadsTo state <-> (F \<in> program & st_set(A))"
  12.268 +by (auto intro: subset_imp_leadsTo dest: leadsToD2 st_setD)
  12.269 +declare leadsTo_state [iff]
  12.270 +
  12.271 +lemma leadsTo_weaken_R: "[| F \<in> A leadsTo A'; A'<=B'; st_set(B') |] ==> F \<in> A leadsTo B'"
  12.272 +by (blast dest: leadsToD2 intro: subset_imp_leadsTo leadsTo_Trans)
  12.273 +
  12.274 +lemma leadsTo_weaken_L: "[| F \<in> A leadsTo A'; B<=A |] ==> F \<in> B leadsTo A'"
  12.275 +apply (frule leadsToD2)
  12.276 +apply (blast intro: leadsTo_Trans subset_imp_leadsTo st_set_subset)
  12.277 +done
  12.278 +
  12.279 +lemma leadsTo_weaken: "[| F \<in> A leadsTo A'; B<=A; A'<=B'; st_set(B')|]==> F \<in> B leadsTo B'"
  12.280 +apply (frule leadsToD2)
  12.281 +apply (blast intro: leadsTo_weaken_R leadsTo_weaken_L leadsTo_Trans leadsTo_refl)
  12.282 +done
  12.283 +
  12.284 +(* This rule has a nicer conclusion *)
  12.285 +lemma transient_imp_leadsTo2: "[| F \<in> transient(A); state-A<=B; st_set(B)|] ==> F \<in> A leadsTo B"
  12.286 +apply (frule transientD2)
  12.287 +apply (rule leadsTo_weaken_R)
  12.288 +apply (auto simp add: transient_imp_leadsTo)
  12.289 +done
  12.290 +
  12.291 +(*Distributes over binary unions*)
  12.292 +lemma leadsTo_Un_distrib: "F:(A Un B) leadsTo C  <->  (F \<in> A leadsTo C & F \<in> B leadsTo C)"
  12.293 +by (blast intro: leadsTo_Un leadsTo_weaken_L)
  12.294 +
  12.295 +lemma leadsTo_UN_distrib: 
  12.296 +"(F:(\<Union>i \<in> I. A(i)) leadsTo B)<-> ((\<forall>i \<in> I. F \<in> A(i) leadsTo B) & F \<in> program & st_set(B))"
  12.297 +apply (blast dest: leadsToD2 intro: leadsTo_UN leadsTo_weaken_L)
  12.298 +done
  12.299 +
  12.300 +lemma leadsTo_Union_distrib: "(F \<in> Union(S) leadsTo B) <->  (\<forall>A \<in> S. F \<in> A leadsTo B) & F \<in> program & st_set(B)"
  12.301 +by (blast dest: leadsToD2 intro: leadsTo_Union leadsTo_weaken_L)
  12.302 +
  12.303 +text{*Set difference: maybe combine with @{text leadsTo_weaken_L}??*}
  12.304 +lemma leadsTo_Diff:
  12.305 +     "[| F: (A-B) leadsTo C; F \<in> B leadsTo C; st_set(C) |]
  12.306 +      ==> F \<in> A leadsTo C"
  12.307 +by (blast intro: leadsTo_Un leadsTo_weaken dest: leadsToD2)
  12.308 +
  12.309 +lemma leadsTo_UN_UN:
  12.310 +    "[|!!i. i \<in> I ==> F \<in> A(i) leadsTo A'(i); F \<in> program |]  
  12.311 +     ==> F: (\<Union>i \<in> I. A(i)) leadsTo (\<Union>i \<in> I. A'(i))"
  12.312 +apply (rule leadsTo_Union)
  12.313 +apply (auto intro: leadsTo_weaken_R dest: leadsToD2) 
  12.314 +done
  12.315 +
  12.316 +(*Binary union version*)
  12.317 +lemma leadsTo_Un_Un: "[| F \<in> A leadsTo A'; F \<in> B leadsTo B' |] ==> F \<in> (A Un B) leadsTo (A' Un B')"
  12.318 +apply (subgoal_tac "st_set (A) & st_set (A') & st_set (B) & st_set (B') ")
  12.319 +prefer 2 apply (blast dest: leadsToD2)
  12.320 +apply (blast intro: leadsTo_Un leadsTo_weaken_R)
  12.321 +done
  12.322 +
  12.323 +(** The cancellation law **)
  12.324 +lemma leadsTo_cancel2: "[|F \<in> A leadsTo (A' Un B); F \<in> B leadsTo B'|] ==> F \<in> A leadsTo (A' Un B')"
  12.325 +apply (subgoal_tac "st_set (A) & st_set (A') & st_set (B) & st_set (B') &F \<in> program")
  12.326 +prefer 2 apply (blast dest: leadsToD2)
  12.327 +apply (blast intro: leadsTo_Trans leadsTo_Un_Un leadsTo_refl)
  12.328 +done
  12.329 +
  12.330 +lemma leadsTo_cancel_Diff2: "[|F \<in> A leadsTo (A' Un B); F \<in> (B-A') leadsTo B'|]==> F \<in> A leadsTo (A' Un B')"
  12.331 +apply (rule leadsTo_cancel2)
  12.332 +prefer 2 apply assumption
  12.333 +apply (blast dest: leadsToD2 intro: leadsTo_weaken_R)
  12.334 +done
  12.335 +
  12.336 +
  12.337 +lemma leadsTo_cancel1: "[| F \<in> A leadsTo (B Un A'); F \<in> B leadsTo B' |] ==> F \<in> A leadsTo (B' Un A')"
  12.338 +apply (simp add: Un_commute)
  12.339 +apply (blast intro!: leadsTo_cancel2)
  12.340 +done
  12.341 +
  12.342 +lemma leadsTo_cancel_Diff1:
  12.343 +     "[|F \<in> A leadsTo (B Un A'); F: (B-A') leadsTo B'|]==> F \<in> A leadsTo (B' Un A')"
  12.344 +apply (rule leadsTo_cancel1)
  12.345 +prefer 2 apply assumption
  12.346 +apply (blast intro: leadsTo_weaken_R dest: leadsToD2)
  12.347 +done
  12.348 +
  12.349 +(*The INDUCTION rule as we should have liked to state it*)
  12.350 +lemma leadsTo_induct:
  12.351 +  assumes major: "F \<in> za leadsTo zb"
  12.352 +      and basis: "!!A B. [|F \<in> A ensures B; st_set(A); st_set(B)|] ==> P(A,B)"
  12.353 +      and trans: "!!A B C. [| F \<in> A leadsTo B; P(A, B);  
  12.354 +                              F \<in> B leadsTo C; P(B, C) |] ==> P(A,C)"
  12.355 +      and union: "!!B S. [| \<forall>A \<in> S. F \<in> A leadsTo B; \<forall>A \<in> S. P(A,B); 
  12.356 +                           st_set(B); \<forall>A \<in> S. st_set(A)|] ==> P(Union(S), B)"
  12.357 +  shows "P(za, zb)"
  12.358 +apply (cut_tac major)
  12.359 +apply (unfold leadsTo_def, clarify) 
  12.360 +apply (erule leads.induct) 
  12.361 +  apply (blast intro: basis [unfolded st_set_def])
  12.362 + apply (blast intro: trans [unfolded leadsTo_def]) 
  12.363 +apply (force intro: union [unfolded st_set_def leadsTo_def]) 
  12.364 +done
  12.365 +
  12.366 +
  12.367 +(* Added by Sidi, an induction rule without ensures *)
  12.368 +lemma leadsTo_induct2:
  12.369 +  assumes major: "F \<in> za leadsTo zb"
  12.370 +      and basis1: "!!A B. [| A<=B; st_set(B) |] ==> P(A, B)"
  12.371 +      and basis2: "!!A B. [| F \<in> A co A Un B; F \<in> transient(A); st_set(B) |] 
  12.372 +                          ==> P(A, B)"
  12.373 +      and trans: "!!A B C. [| F \<in> A leadsTo B; P(A, B);  
  12.374 +                              F \<in> B leadsTo C; P(B, C) |] ==> P(A,C)"
  12.375 +      and union: "!!B S. [| \<forall>A \<in> S. F \<in> A leadsTo B; \<forall>A \<in> S. P(A,B); 
  12.376 +                           st_set(B); \<forall>A \<in> S. st_set(A)|] ==> P(Union(S), B)"
  12.377 +  shows "P(za, zb)"
  12.378 +apply (cut_tac major)
  12.379 +apply (erule leadsTo_induct)
  12.380 +apply (auto intro: trans union)
  12.381 +apply (simp add: ensures_def, clarify)
  12.382 +apply (frule constrainsD2)
  12.383 +apply (drule_tac B' = " (A-B) Un B" in constrains_weaken_R)
  12.384 +apply blast
  12.385 +apply (frule ensuresI2 [THEN leadsTo_Basis])
  12.386 +apply (drule_tac [4] basis2, simp_all)
  12.387 +apply (frule_tac A1 = A and B = B in Int_lower2 [THEN basis1])
  12.388 +apply (subgoal_tac "A=Union ({A - B, A Int B}) ")
  12.389 +prefer 2 apply blast
  12.390 +apply (erule ssubst)
  12.391 +apply (rule union)
  12.392 +apply (auto intro: subset_imp_leadsTo)
  12.393 +done
  12.394 +
  12.395 +
  12.396 +(** Variant induction rule: on the preconditions for B **)
  12.397 +(*Lemma is the weak version: can't see how to do it in one step*)
  12.398 +lemma leadsTo_induct_pre_aux: 
  12.399 +  "[| F \<in> za leadsTo zb;   
  12.400 +      P(zb);  
  12.401 +      !!A B. [| F \<in> A ensures B;  P(B); st_set(A); st_set(B) |] ==> P(A);  
  12.402 +      !!S. [| \<forall>A \<in> S. P(A); \<forall>A \<in> S. st_set(A) |] ==> P(Union(S))  
  12.403 +   |] ==> P(za)"
  12.404 +txt{*by induction on this formula*}
  12.405 +apply (subgoal_tac "P (zb) --> P (za) ")
  12.406 +txt{*now solve first subgoal: this formula is sufficient*}
  12.407 +apply (blast intro: leadsTo_refl)
  12.408 +apply (erule leadsTo_induct)
  12.409 +apply (blast+)
  12.410 +done
  12.411 +
  12.412 +
  12.413 +lemma leadsTo_induct_pre: 
  12.414 +  "[| F \<in> za leadsTo zb;   
  12.415 +      P(zb);  
  12.416 +      !!A B. [| F \<in> A ensures B;  F \<in> B leadsTo zb;  P(B); st_set(A) |] ==> P(A);  
  12.417 +      !!S. \<forall>A \<in> S. F \<in> A leadsTo zb & P(A) & st_set(A) ==> P(Union(S))  
  12.418 +   |] ==> P(za)"
  12.419 +apply (subgoal_tac " (F \<in> za leadsTo zb) & P (za) ")
  12.420 +apply (erule conjunct2)
  12.421 +apply (frule leadsToD2) 
  12.422 +apply (erule leadsTo_induct_pre_aux)
  12.423 +prefer 3 apply (blast dest: leadsToD2 intro: leadsTo_Union)
  12.424 +prefer 2 apply (blast intro: leadsTo_Trans leadsTo_Basis)
  12.425 +apply (blast intro: leadsTo_refl)
  12.426 +done
  12.427 +
  12.428 +(** The impossibility law **)
  12.429 +lemma leadsTo_empty: 
  12.430 +   "F \<in> A leadsTo 0 ==> A=0"
  12.431 +apply (erule leadsTo_induct_pre)
  12.432 +apply (auto simp add: ensures_def constrains_def transient_def st_set_def)
  12.433 +apply (drule bspec, assumption)+
  12.434 +apply blast
  12.435 +done
  12.436 +declare leadsTo_empty [simp]
  12.437 +
  12.438 +subsection{*PSP: Progress-Safety-Progress*}
  12.439 +
  12.440 +text{*Special case of PSP: Misra's "stable conjunction"*}
  12.441 +
  12.442 +lemma psp_stable: 
  12.443 +   "[| F \<in> A leadsTo A'; F \<in> stable(B) |] ==> F:(A Int B) leadsTo (A' Int B)"
  12.444 +apply (unfold stable_def)
  12.445 +apply (frule leadsToD2) 
  12.446 +apply (erule leadsTo_induct)
  12.447 +prefer 3 apply (blast intro: leadsTo_Union_Int)
  12.448 +prefer 2 apply (blast intro: leadsTo_Trans)
  12.449 +apply (rule leadsTo_Basis)
  12.450 +apply (simp add: ensures_def Diff_Int_distrib2 [symmetric] Int_Un_distrib2 [symmetric])
  12.451 +apply (auto intro: transient_strengthen constrains_Int)
  12.452 +done
  12.453 +
  12.454 +
  12.455 +lemma psp_stable2: "[|F \<in> A leadsTo A'; F \<in> stable(B) |]==>F: (B Int A) leadsTo (B Int A')"
  12.456 +apply (simp (no_asm_simp) add: psp_stable Int_ac)
  12.457 +done
  12.458 +
  12.459 +lemma psp_ensures: 
  12.460 +"[| F \<in> A ensures A'; F \<in> B co B' |]==> F: (A Int B') ensures ((A' Int B) Un (B' - B))"
  12.461 +apply (unfold ensures_def constrains_def st_set_def)
  12.462 +(*speeds up the proof*)
  12.463 +apply clarify
  12.464 +apply (blast intro: transient_strengthen)
  12.465 +done
  12.466 +
  12.467 +lemma psp: 
  12.468 +"[|F \<in> A leadsTo A'; F \<in> B co B'; st_set(B')|]==> F:(A Int B') leadsTo ((A' Int B) Un (B' - B))"
  12.469 +apply (subgoal_tac "F \<in> program & st_set (A) & st_set (A') & st_set (B) ")
  12.470 +prefer 2 apply (blast dest!: constrainsD2 leadsToD2)
  12.471 +apply (erule leadsTo_induct)
  12.472 +prefer 3 apply (blast intro: leadsTo_Union_Int)
  12.473 + txt{*Basis case*}
  12.474 + apply (blast intro: psp_ensures leadsTo_Basis)
  12.475 +txt{*Transitivity case has a delicate argument involving "cancellation"*}
  12.476 +apply (rule leadsTo_Un_duplicate2)
  12.477 +apply (erule leadsTo_cancel_Diff1)
  12.478 +apply (simp add: Int_Diff Diff_triv)
  12.479 +apply (blast intro: leadsTo_weaken_L dest: constrains_imp_subset)
  12.480 +done
  12.481 +
  12.482 +
  12.483 +lemma psp2: "[| F \<in> A leadsTo A'; F \<in> B co B'; st_set(B') |]  
  12.484 +    ==> F \<in> (B' Int A) leadsTo ((B Int A') Un (B' - B))"
  12.485 +by (simp (no_asm_simp) add: psp Int_ac)
  12.486 +
  12.487 +lemma psp_unless: 
  12.488 +   "[| F \<in> A leadsTo A';  F \<in> B unless B'; st_set(B); st_set(B') |]  
  12.489 +    ==> F \<in> (A Int B) leadsTo ((A' Int B) Un B')"
  12.490 +apply (unfold unless_def)
  12.491 +apply (subgoal_tac "st_set (A) &st_set (A') ")
  12.492 +prefer 2 apply (blast dest: leadsToD2)
  12.493 +apply (drule psp, assumption, blast)
  12.494 +apply (blast intro: leadsTo_weaken)
  12.495 +done
  12.496 +
  12.497 +
  12.498 +subsection{*Proving the induction rules*}
  12.499 +
  12.500 +(** The most general rule \<in> r is any wf relation; f is any variant function **)
  12.501 +lemma leadsTo_wf_induct_aux: "[| wf(r);  
  12.502 +         m \<in> I;  
  12.503 +         field(r)<=I;  
  12.504 +         F \<in> program; st_set(B); 
  12.505 +         \<forall>m \<in> I. F \<in> (A Int f-``{m}) leadsTo                      
  12.506 +                    ((A Int f-``(converse(r)``{m})) Un B) |]  
  12.507 +      ==> F \<in> (A Int f-``{m}) leadsTo B"
  12.508 +apply (erule_tac a = m in wf_induct2, simp_all)
  12.509 +apply (subgoal_tac "F \<in> (A Int (f-`` (converse (r) ``{x}))) leadsTo B")
  12.510 + apply (blast intro: leadsTo_cancel1 leadsTo_Un_duplicate)
  12.511 +apply (subst vimage_eq_UN)
  12.512 +apply (simp del: UN_simps add: Int_UN_distrib)
  12.513 +apply (auto intro: leadsTo_UN simp del: UN_simps simp add: Int_UN_distrib)
  12.514 +done
  12.515 +
  12.516 +(** Meta or object quantifier ? **)
  12.517 +lemma leadsTo_wf_induct: "[| wf(r);  
  12.518 +         field(r)<=I;  
  12.519 +         A<=f-``I;  
  12.520 +         F \<in> program; st_set(A); st_set(B);  
  12.521 +         \<forall>m \<in> I. F \<in> (A Int f-``{m}) leadsTo                      
  12.522 +                    ((A Int f-``(converse(r)``{m})) Un B) |]  
  12.523 +      ==> F \<in> A leadsTo B"
  12.524 +apply (rule_tac b = A in subst)
  12.525 + defer 1
  12.526 + apply (rule_tac I = I in leadsTo_UN)
  12.527 + apply (erule_tac I = I in leadsTo_wf_induct_aux, assumption+, best) 
  12.528 +done
  12.529 +
  12.530 +lemma nat_measure_field: "field(measure(nat, %x. x)) = nat"
  12.531 +apply (unfold field_def)
  12.532 +apply (simp add: measure_def)
  12.533 +apply (rule equalityI, force, clarify)
  12.534 +apply (erule_tac V = "x\<notin>range (?y) " in thin_rl)
  12.535 +apply (erule nat_induct)
  12.536 +apply (rule_tac [2] b = "succ (succ (xa))" in domainI)
  12.537 +apply (rule_tac b = "succ (0) " in domainI)
  12.538 +apply simp_all
  12.539 +done
  12.540 +
  12.541 +
  12.542 +lemma Image_inverse_lessThan: "k<A ==> measure(A, %x. x) -`` {k} = k"
  12.543 +apply (rule equalityI)
  12.544 +apply (auto simp add: measure_def)
  12.545 +apply (blast intro: ltD)
  12.546 +apply (rule vimageI)
  12.547 +prefer 2 apply blast
  12.548 +apply (simp add: lt_Ord lt_Ord2 Ord_mem_iff_lt)
  12.549 +apply (blast intro: lt_trans)
  12.550 +done
  12.551 +
  12.552 +(*Alternative proof is via the lemma F \<in> (A Int f-`(lessThan m)) leadsTo B*)
  12.553 +lemma lessThan_induct: 
  12.554 + "[| A<=f-``nat;  
  12.555 +     F \<in> program; st_set(A); st_set(B);  
  12.556 +     \<forall>m \<in> nat. F:(A Int f-``{m}) leadsTo ((A Int f -`` m) Un B) |]  
  12.557 +      ==> F \<in> A leadsTo B"
  12.558 +apply (rule_tac A1 = nat and f1 = "%x. x" in wf_measure [THEN leadsTo_wf_induct]) 
  12.559 +apply (simp_all add: nat_measure_field)
  12.560 +apply (simp add: ltI Image_inverse_lessThan vimage_def [symmetric])
  12.561 +done
  12.562 +
  12.563 +
  12.564 +(*** wlt ****)
  12.565 +
  12.566 +(*Misra's property W3*)
  12.567 +lemma wlt_type: "wlt(F,B) <=state"
  12.568 +by (unfold wlt_def, auto)
  12.569 +
  12.570 +lemma wlt_st_set: "st_set(wlt(F, B))"
  12.571 +apply (unfold st_set_def)
  12.572 +apply (rule wlt_type)
  12.573 +done
  12.574 +declare wlt_st_set [iff]
  12.575 +
  12.576 +lemma wlt_leadsTo_iff: "F \<in> wlt(F, B) leadsTo B <-> (F \<in> program & st_set(B))"
  12.577 +apply (unfold wlt_def)
  12.578 +apply (blast dest: leadsToD2 intro!: leadsTo_Union)
  12.579 +done
  12.580 +
  12.581 +(* [| F \<in> program;  st_set(B) |] ==> F \<in> wlt(F, B) leadsTo B  *)
  12.582 +lemmas wlt_leadsTo = conjI [THEN wlt_leadsTo_iff [THEN iffD2], standard]
  12.583 +
  12.584 +lemma leadsTo_subset: "F \<in> A leadsTo B ==> A <= wlt(F, B)"
  12.585 +apply (unfold wlt_def)
  12.586 +apply (frule leadsToD2)
  12.587 +apply (auto simp add: st_set_def)
  12.588 +done
  12.589 +
  12.590 +(*Misra's property W2*)
  12.591 +lemma leadsTo_eq_subset_wlt: "F \<in> A leadsTo B <-> (A <= wlt(F,B) & F \<in> program & st_set(B))"
  12.592 +apply auto
  12.593 +apply (blast dest: leadsToD2 leadsTo_subset intro: leadsTo_weaken_L wlt_leadsTo)+
  12.594 +done
  12.595 +
  12.596 +(*Misra's property W4*)
  12.597 +lemma wlt_increasing: "[| F \<in> program; st_set(B) |] ==> B <= wlt(F,B)"
  12.598 +apply (rule leadsTo_subset)
  12.599 +apply (simp (no_asm_simp) add: leadsTo_eq_subset_wlt [THEN iff_sym] subset_imp_leadsTo)
  12.600 +done
  12.601 +
  12.602 +(*Used in the Trans case below*)
  12.603 +lemma leadsTo_123_aux: 
  12.604 +   "[| B <= A2;  
  12.605 +       F \<in> (A1 - B) co (A1 Un B);  
  12.606 +       F \<in> (A2 - C) co (A2 Un C) |]  
  12.607 +    ==> F \<in> (A1 Un A2 - C) co (A1 Un A2 Un C)"
  12.608 +apply (unfold constrains_def st_set_def, blast)
  12.609 +done
  12.610 +
  12.611 +(*Lemma (1,2,3) of Misra's draft book, Chapter 4, "Progress"*)
  12.612 +(* slightly different from the HOL one \<in> B here is bounded *)
  12.613 +lemma leadsTo_123: "F \<in> A leadsTo A'  
  12.614 +      ==> \<exists>B \<in> Pow(state). A<=B & F \<in> B leadsTo A' & F \<in> (B-A') co (B Un A')"
  12.615 +apply (frule leadsToD2)
  12.616 +apply (erule leadsTo_induct)
  12.617 +  txt{*Basis*}
  12.618 +  apply (blast dest: ensuresD constrainsD2 st_setD)
  12.619 + txt{*Trans*}
  12.620 + apply clarify
  12.621 + apply (rule_tac x = "Ba Un Bb" in bexI)
  12.622 + apply (blast intro: leadsTo_123_aux leadsTo_Un_Un leadsTo_cancel1 leadsTo_Un_duplicate, blast)
  12.623 +txt{*Union*}
  12.624 +apply (clarify dest!: ball_conj_distrib [THEN iffD1])
  12.625 +apply (subgoal_tac "\<exists>y. y \<in> Pi (S, %A. {Ba \<in> Pow (state) . A<=Ba & F \<in> Ba leadsTo B & F \<in> Ba - B co Ba Un B}) ")
  12.626 +defer 1
  12.627 +apply (rule AC_ball_Pi, safe)
  12.628 +apply (rotate_tac 1)
  12.629 +apply (drule_tac x = x in bspec, blast, blast) 
  12.630 +apply (rule_tac x = "\<Union>A \<in> S. y`A" in bexI, safe)
  12.631 +apply (rule_tac [3] I1 = S in constrains_UN [THEN constrains_weaken])
  12.632 +apply (rule_tac [2] leadsTo_Union)
  12.633 +prefer 5 apply (blast dest!: apply_type, simp_all)
  12.634 +apply (force dest!: apply_type)+
  12.635 +done
  12.636 +
  12.637 +
  12.638 +(*Misra's property W5*)
  12.639 +lemma wlt_constrains_wlt: "[| F \<in> program; st_set(B) |] ==>F \<in> (wlt(F, B) - B) co (wlt(F,B))"
  12.640 +apply (cut_tac F = F in wlt_leadsTo [THEN leadsTo_123], assumption, blast)
  12.641 +apply clarify
  12.642 +apply (subgoal_tac "Ba = wlt (F,B) ")
  12.643 +prefer 2 apply (blast dest: leadsTo_eq_subset_wlt [THEN iffD1], clarify)
  12.644 +apply (simp add: wlt_increasing [THEN subset_Un_iff2 [THEN iffD1]])
  12.645 +done
  12.646 +
  12.647 +
  12.648 +subsection{*Completion: Binary and General Finite versions*}
  12.649 +
  12.650 +lemma completion_aux: "[| W = wlt(F, (B' Un C));      
  12.651 +       F \<in> A leadsTo (A' Un C);  F \<in> A' co (A' Un C);    
  12.652 +       F \<in> B leadsTo (B' Un C);  F \<in> B' co (B' Un C) |]  
  12.653 +    ==> F \<in> (A Int B) leadsTo ((A' Int B') Un C)"
  12.654 +apply (subgoal_tac "st_set (C) &st_set (W) &st_set (W-C) &st_set (A') &st_set (A) & st_set (B) & st_set (B') & F \<in> program")
  12.655 + prefer 2 
  12.656 + apply simp 
  12.657 + apply (blast dest!: leadsToD2)
  12.658 +apply (subgoal_tac "F \<in> (W-C) co (W Un B' Un C) ")
  12.659 + prefer 2
  12.660 + apply (blast intro!: constrains_weaken [OF constrains_Un [OF _ wlt_constrains_wlt]])
  12.661 +apply (subgoal_tac "F \<in> (W-C) co W")
  12.662 + prefer 2
  12.663 + apply (simp add: wlt_increasing [THEN subset_Un_iff2 [THEN iffD1]] Un_assoc)
  12.664 +apply (subgoal_tac "F \<in> (A Int W - C) leadsTo (A' Int W Un C) ")
  12.665 + prefer 2 apply (blast intro: wlt_leadsTo psp [THEN leadsTo_weaken])
  12.666 +(** step 13 **)
  12.667 +apply (subgoal_tac "F \<in> (A' Int W Un C) leadsTo (A' Int B' Un C) ")
  12.668 +apply (drule leadsTo_Diff)
  12.669 +apply (blast intro: subset_imp_leadsTo dest: leadsToD2 constrainsD2)
  12.670 +apply (force simp add: st_set_def)
  12.671 +apply (subgoal_tac "A Int B <= A Int W")
  12.672 +prefer 2 apply (blast dest!: leadsTo_subset intro!: subset_refl [THEN Int_mono])
  12.673 +apply (blast intro: leadsTo_Trans subset_imp_leadsTo)
  12.674 +txt{*last subgoal*}
  12.675 +apply (rule_tac leadsTo_Un_duplicate2)
  12.676 +apply (rule_tac leadsTo_Un_Un)
  12.677 + prefer 2 apply (blast intro: leadsTo_refl)
  12.678 +apply (rule_tac A'1 = "B' Un C" in wlt_leadsTo[THEN psp2, THEN leadsTo_weaken])
  12.679 +apply blast+
  12.680 +done
  12.681 +
  12.682 +lemmas completion = refl [THEN completion_aux, standard]
  12.683 +
  12.684 +lemma finite_completion_aux:
  12.685 +     "[| I \<in> Fin(X); F \<in> program; st_set(C) |] ==>  
  12.686 +       (\<forall>i \<in> I. F \<in> (A(i)) leadsTo (A'(i) Un C)) -->   
  12.687 +                     (\<forall>i \<in> I. F \<in> (A'(i)) co (A'(i) Un C)) -->  
  12.688 +                   F \<in> (\<Inter>i \<in> I. A(i)) leadsTo ((\<Inter>i \<in> I. A'(i)) Un C)"
  12.689 +apply (erule Fin_induct)
  12.690 +apply (auto simp add: Inter_0)
  12.691 +apply (rule completion)
  12.692 +apply (auto simp del: INT_simps simp add: INT_extend_simps)
  12.693 +apply (blast intro: constrains_INT)
  12.694 +done
  12.695 +
  12.696 +lemma finite_completion: 
  12.697 +     "[| I \<in> Fin(X);   
  12.698 +         !!i. i \<in> I ==> F \<in> A(i) leadsTo (A'(i) Un C);  
  12.699 +         !!i. i \<in> I ==> F \<in> A'(i) co (A'(i) Un C); F \<in> program; st_set(C)|]    
  12.700 +      ==> F \<in> (\<Inter>i \<in> I. A(i)) leadsTo ((\<Inter>i \<in> I. A'(i)) Un C)"
  12.701 +by (blast intro: finite_completion_aux [THEN mp, THEN mp])
  12.702 +
  12.703 +lemma stable_completion: 
  12.704 +     "[| F \<in> A leadsTo A';  F \<in> stable(A');    
  12.705 +         F \<in> B leadsTo B';  F \<in> stable(B') |]  
  12.706 +    ==> F \<in> (A Int B) leadsTo (A' Int B')"
  12.707 +apply (unfold stable_def)
  12.708 +apply (rule_tac C1 = 0 in completion [THEN leadsTo_weaken_R], simp+)
  12.709 +apply (blast dest: leadsToD2)
  12.710 +done
  12.711 +
  12.712 +
  12.713 +lemma finite_stable_completion: 
  12.714 +     "[| I \<in> Fin(X);  
  12.715 +         (!!i. i \<in> I ==> F \<in> A(i) leadsTo A'(i));  
  12.716 +         (!!i. i \<in> I ==> F \<in> stable(A'(i)));  F \<in> program |]  
  12.717 +      ==> F \<in> (\<Inter>i \<in> I. A(i)) leadsTo (\<Inter>i \<in> I. A'(i))"
  12.718 +apply (unfold stable_def)
  12.719 +apply (subgoal_tac "st_set (\<Inter>i \<in> I. A' (i))")
  12.720 +prefer 2 apply (blast dest: leadsToD2)
  12.721 +apply (rule_tac C1 = 0 in finite_completion [THEN leadsTo_weaken_R], auto) 
  12.722 +done
  12.723 +
  12.724 +ML
  12.725 +{*
  12.726 +val Int_Union_Union = thm "Int_Union_Union";
  12.727 +val Int_Union_Union2 = thm "Int_Union_Union2";
  12.728 +val transient_type = thm "transient_type";
  12.729 +val transientD2 = thm "transientD2";
  12.730 +val stable_transient_empty = thm "stable_transient_empty";
  12.731 +val transient_strengthen = thm "transient_strengthen";
  12.732 +val transientI = thm "transientI";
  12.733 +val transientE = thm "transientE";
  12.734 +val transient_state = thm "transient_state";
  12.735 +val transient_state2 = thm "transient_state2";
  12.736 +val transient_empty = thm "transient_empty";
  12.737 +val ensures_type = thm "ensures_type";
  12.738 +val ensuresI = thm "ensuresI";
  12.739 +val ensuresI2 = thm "ensuresI2";
  12.740 +val ensuresD = thm "ensuresD";
  12.741 +val ensures_weaken_R = thm "ensures_weaken_R";
  12.742 +val stable_ensures_Int = thm "stable_ensures_Int";
  12.743 +val stable_transient_ensures = thm "stable_transient_ensures";
  12.744 +val ensures_eq = thm "ensures_eq";
  12.745 +val subset_imp_ensures = thm "subset_imp_ensures";
  12.746 +val leads_left = thm "leads_left";
  12.747 +val leads_right = thm "leads_right";
  12.748 +val leadsTo_type = thm "leadsTo_type";
  12.749 +val leadsToD2 = thm "leadsToD2";
  12.750 +val leadsTo_Basis = thm "leadsTo_Basis";
  12.751 +val subset_imp_leadsTo = thm "subset_imp_leadsTo";
  12.752 +val leadsTo_Trans = thm "leadsTo_Trans";
  12.753 +val transient_imp_leadsTo = thm "transient_imp_leadsTo";
  12.754 +val leadsTo_Un_duplicate = thm "leadsTo_Un_duplicate";
  12.755 +val leadsTo_Un_duplicate2 = thm "leadsTo_Un_duplicate2";
  12.756 +val leadsTo_Union = thm "leadsTo_Union";
  12.757 +val leadsTo_Union_Int = thm "leadsTo_Union_Int";
  12.758 +val leadsTo_UN = thm "leadsTo_UN";
  12.759 +val leadsTo_Un = thm "leadsTo_Un";
  12.760 +val single_leadsTo_I = thm "single_leadsTo_I";
  12.761 +val leadsTo_refl = thm "leadsTo_refl";
  12.762 +val leadsTo_refl_iff = thm "leadsTo_refl_iff";
  12.763 +val empty_leadsTo = thm "empty_leadsTo";
  12.764 +val leadsTo_state = thm "leadsTo_state";
  12.765 +val leadsTo_weaken_R = thm "leadsTo_weaken_R";
  12.766 +val leadsTo_weaken_L = thm "leadsTo_weaken_L";
  12.767 +val leadsTo_weaken = thm "leadsTo_weaken";
  12.768 +val transient_imp_leadsTo2 = thm "transient_imp_leadsTo2";
  12.769 +val leadsTo_Un_distrib = thm "leadsTo_Un_distrib";
  12.770 +val leadsTo_UN_distrib = thm "leadsTo_UN_distrib";
  12.771 +val leadsTo_Union_distrib = thm "leadsTo_Union_distrib";
  12.772 +val leadsTo_Diff = thm "leadsTo_Diff";
  12.773 +val leadsTo_UN_UN = thm "leadsTo_UN_UN";
  12.774 +val leadsTo_Un_Un = thm "leadsTo_Un_Un";
  12.775 +val leadsTo_cancel2 = thm "leadsTo_cancel2";
  12.776 +val leadsTo_cancel_Diff2 = thm "leadsTo_cancel_Diff2";
  12.777 +val leadsTo_cancel1 = thm "leadsTo_cancel1";
  12.778 +val leadsTo_cancel_Diff1 = thm "leadsTo_cancel_Diff1";
  12.779 +val leadsTo_induct = thm "leadsTo_induct";
  12.780 +val leadsTo_induct2 = thm "leadsTo_induct2";
  12.781 +val leadsTo_induct_pre_aux = thm "leadsTo_induct_pre_aux";
  12.782 +val leadsTo_induct_pre = thm "leadsTo_induct_pre";
  12.783 +val leadsTo_empty = thm "leadsTo_empty";
  12.784 +val psp_stable = thm "psp_stable";
  12.785 +val psp_stable2 = thm "psp_stable2";
  12.786 +val psp_ensures = thm "psp_ensures";
  12.787 +val psp = thm "psp";
  12.788 +val psp2 = thm "psp2";
  12.789 +val psp_unless = thm "psp_unless";
  12.790 +val leadsTo_wf_induct_aux = thm "leadsTo_wf_induct_aux";
  12.791 +val leadsTo_wf_induct = thm "leadsTo_wf_induct";
  12.792 +val nat_measure_field = thm "nat_measure_field";
  12.793 +val Image_inverse_lessThan = thm "Image_inverse_lessThan";
  12.794 +val lessThan_induct = thm "lessThan_induct";
  12.795 +val wlt_type = thm "wlt_type";
  12.796 +val wlt_st_set = thm "wlt_st_set";
  12.797 +val wlt_leadsTo_iff = thm "wlt_leadsTo_iff";
  12.798 +val wlt_leadsTo = thm "wlt_leadsTo";
  12.799 +val leadsTo_subset = thm "leadsTo_subset";
  12.800 +val leadsTo_eq_subset_wlt = thm "leadsTo_eq_subset_wlt";
  12.801 +val wlt_increasing = thm "wlt_increasing";
  12.802 +val leadsTo_123_aux = thm "leadsTo_123_aux";
  12.803 +val leadsTo_123 = thm "leadsTo_123";
  12.804 +val wlt_constrains_wlt = thm "wlt_constrains_wlt";
  12.805 +val completion_aux = thm "completion_aux";
  12.806 +val completion = thm "completion";
  12.807 +val finite_completion_aux = thm "finite_completion_aux";
  12.808 +val finite_completion = thm "finite_completion";
  12.809 +val stable_completion = thm "stable_completion";
  12.810 +val finite_stable_completion = thm "finite_stable_completion";
  12.811 +*}
  12.812  
  12.813  end