converting UNITY to new-style theories
authorpaulson
Wed Jan 29 11:02:08 2003 +0100 (2003-01-29)
changeset 137908d7e9fce8c50
parent 13789 d37f66755f47
child 13791 3b6ff7ceaf27
converting UNITY to new-style theories
src/HOL/IsaMakefile
src/HOL/UNITY/ELT.ML
src/HOL/UNITY/ELT.thy
src/HOL/UNITY/Extend.ML
src/HOL/UNITY/Extend.thy
src/HOL/UNITY/Lift_prog.thy
src/HOL/UNITY/Project.ML
src/HOL/UNITY/Project.thy
src/HOL/UNITY/ROOT.ML
src/HOL/UNITY/Rename.ML
src/HOL/UNITY/Rename.thy
src/HOL/UNITY/UNITY_tactics.ML
     1.1 --- a/src/HOL/IsaMakefile	Tue Jan 28 22:53:39 2003 +0100
     1.2 +++ b/src/HOL/IsaMakefile	Wed Jan 29 11:02:08 2003 +0100
     1.3 @@ -381,36 +381,24 @@
     1.4  HOL-UNITY: HOL $(LOG)/HOL-UNITY.gz
     1.5  
     1.6  $(LOG)/HOL-UNITY.gz: $(OUT)/HOL Library/Multiset.thy UNITY/ROOT.ML \
     1.7 -  UNITY/UNITY_Main.thy UNITY/Comp.ML UNITY/Comp.thy \
     1.8 -  UNITY/Detects.thy \
     1.9 -  UNITY/ELT.ML UNITY/ELT.thy UNITY/Extend.ML \
    1.10 +  UNITY/UNITY_Main.thy UNITY/UNITY_tactics.ML \
    1.11 +  UNITY/Comp.ML UNITY/Comp.thy UNITY/Detects.thy  UNITY/ELT.thy \
    1.12    UNITY/Extend.thy UNITY/FP.ML UNITY/FP.thy UNITY/Follows.ML \
    1.13    UNITY/Follows.thy UNITY/GenPrefix.ML UNITY/GenPrefix.thy \
    1.14 -  UNITY/Guar.ML UNITY/Guar.thy  \
    1.15 -  UNITY/Lift_prog.thy \
    1.16 -  UNITY/ListOrder.thy  \
    1.17 -  UNITY/PPROD.thy \
    1.18 -  UNITY/Project.ML UNITY/Project.thy \
    1.19 -  UNITY/Rename.ML UNITY/Rename.thy \
    1.20 +  UNITY/Guar.ML UNITY/Guar.thy UNITY/Lift_prog.thy  UNITY/ListOrder.thy  \
    1.21 +  UNITY/PPROD.thy  UNITY/Project.thy UNITY/Rename.thy \
    1.22    UNITY/SubstAx.ML UNITY/SubstAx.thy UNITY/UNITY.ML \
    1.23 -  UNITY/UNITY.thy UNITY/Union.ML UNITY/Union.thy UNITY/WFair.ML \
    1.24 -  UNITY/WFair.thy \
    1.25 -  UNITY/Simple/Channel.thy  \
    1.26 -  UNITY/Simple/Common.thy  \
    1.27 -  UNITY/Simple/Deadlock.thy  \
    1.28 -  UNITY/Simple/Lift.thy  \
    1.29 -  UNITY/Simple/Mutex.thy  \
    1.30 +  UNITY/UNITY.thy UNITY/Union.ML UNITY/Union.thy UNITY/WFair.ML  UNITY/WFair.thy \
    1.31 +  UNITY/Simple/Channel.thy UNITY/Simple/Common.thy  \
    1.32 +  UNITY/Simple/Deadlock.thy UNITY/Simple/Lift.thy UNITY/Simple/Mutex.thy  \
    1.33    UNITY/Simple/NSP_Bad.ML UNITY/Simple/NSP_Bad.thy  \
    1.34 -  UNITY/Simple/Network.thy  \
    1.35 -  UNITY/Simple/Reach.thy   \
    1.36 -  UNITY/Simple/Reachability.thy   \
    1.37 -  UNITY/Simple/Token.thy \
    1.38 +  UNITY/Simple/Network.thy\
    1.39 +  UNITY/Simple/Reach.thy UNITY/Simple/Reachability.thy UNITY/Simple/Token.thy\
    1.40    UNITY/Comp/Alloc.ML UNITY/Comp/Alloc.thy \
    1.41    UNITY/Comp/AllocBase.ML UNITY/Comp/AllocBase.thy \
    1.42    UNITY/Comp/Client.ML UNITY/Comp/Client.thy \
    1.43    UNITY/Comp/Counter.ML UNITY/Comp/Counter.thy \
    1.44 -  UNITY/Comp/Counterc.ML UNITY/Comp/Counterc.thy \
    1.45 -  UNITY/Comp/Handshake.thy \
    1.46 +  UNITY/Comp/Counterc.ML UNITY/Comp/Counterc.thy UNITY/Comp/Handshake.thy \
    1.47    UNITY/Comp/PriorityAux.ML UNITY/Comp/PriorityAux.thy \
    1.48    UNITY/Comp/Priority.ML UNITY/Comp/Priority.thy \
    1.49    UNITY/Comp/TimerArray.thy
     2.1 --- a/src/HOL/UNITY/ELT.ML	Tue Jan 28 22:53:39 2003 +0100
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,678 +0,0 @@
     2.4 -(*  Title:      HOL/UNITY/ELT
     2.5 -    ID:         $Id$
     2.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     2.7 -    Copyright   1999  University of Cambridge
     2.8 -
     2.9 -leadsTo strengthened with a specification of the allowable sets transient parts
    2.10 -*)
    2.11 -
    2.12 -(*** givenBy ***)
    2.13 -
    2.14 -Goalw [givenBy_def] "givenBy id = UNIV";
    2.15 -by Auto_tac;
    2.16 -qed "givenBy_id";
    2.17 -Addsimps [givenBy_id];
    2.18 -
    2.19 -Goalw [givenBy_def] "(givenBy v) = {A. ALL x:A. ALL y. v x = v y --> y: A}";
    2.20 -by Safe_tac;
    2.21 -by (res_inst_tac [("x", "v ` ?u")] image_eqI 2);
    2.22 -by Auto_tac;
    2.23 -qed "givenBy_eq_all";
    2.24 -
    2.25 -val prems =
    2.26 -Goal "(!!x y. [| x:A;  v x = v y |] ==> y: A) ==> A: givenBy v";
    2.27 -by (stac givenBy_eq_all 1);
    2.28 -by (blast_tac (claset() addIs prems) 1);
    2.29 -qed "givenByI";
    2.30 -
    2.31 -Goalw [givenBy_def] "[| A: givenBy v;  x:A;  v x = v y |] ==> y: A";
    2.32 -by Auto_tac;
    2.33 -qed "givenByD";
    2.34 -
    2.35 -Goal "{} : givenBy v";
    2.36 -by (blast_tac (claset() addSIs [givenByI]) 1);
    2.37 -qed "empty_mem_givenBy";
    2.38 -
    2.39 -AddIffs [empty_mem_givenBy];
    2.40 -
    2.41 -Goal "A: givenBy v ==> EX P. A = {s. P(v s)}";
    2.42 -by (res_inst_tac [("x", "%n. EX s. v s = n & s : A")] exI 1);
    2.43 -by (full_simp_tac (simpset() addsimps [givenBy_eq_all]) 1);
    2.44 -by (Blast_tac 1);
    2.45 -qed "givenBy_imp_eq_Collect";
    2.46 -
    2.47 -Goalw [givenBy_def] "{s. P(v s)} : givenBy v";
    2.48 -by (Best_tac 1);
    2.49 -qed "Collect_mem_givenBy";
    2.50 -
    2.51 -Goal "givenBy v = {A. EX P. A = {s. P(v s)}}";
    2.52 -by (blast_tac (claset() addIs [Collect_mem_givenBy,
    2.53 -			       givenBy_imp_eq_Collect]) 1);
    2.54 -qed "givenBy_eq_Collect";
    2.55 -
    2.56 -(*preserving v preserves properties given by v*)
    2.57 -Goal "[| F : preserves v;  D : givenBy v |] ==> F : stable D";
    2.58 -by (force_tac (claset(), 
    2.59 -	       simpset() addsimps [impOfSubs preserves_subset_stable, 
    2.60 -				   givenBy_eq_Collect]) 1);
    2.61 -qed "preserves_givenBy_imp_stable";
    2.62 -
    2.63 -Goal "givenBy (w o v) <= givenBy v";
    2.64 -by (simp_tac (simpset() addsimps [givenBy_eq_Collect]) 1);
    2.65 -by (Deepen_tac 0 1);
    2.66 -qed "givenBy_o_subset";
    2.67 -
    2.68 -Goal "[| A : givenBy v;  B : givenBy v |] ==> A-B : givenBy v";
    2.69 -by (full_simp_tac (simpset() addsimps [givenBy_eq_Collect]) 1);
    2.70 -by Safe_tac;
    2.71 -by (res_inst_tac [("x", "%z. ?R z & ~ ?Q z")] exI 1);
    2.72 -by (deepen_tac (set_cs addSIs [equalityI]) 0 1);
    2.73 -qed "givenBy_DiffI";
    2.74 -
    2.75 -
    2.76 -(** Standard leadsTo rules **)
    2.77 -
    2.78 -Goalw [leadsETo_def]
    2.79 -     "[| F: A ensures B;  A-B: insert {} CC |] ==> F : A leadsTo[CC] B";
    2.80 -by (blast_tac (claset() addIs [elt.Basis]) 1);
    2.81 -qed "leadsETo_Basis";
    2.82 -AddIs [leadsETo_Basis];
    2.83 -
    2.84 -Goalw [leadsETo_def]
    2.85 -     "[| F : A leadsTo[CC] B;  F : B leadsTo[CC] C |] ==> F : A leadsTo[CC] C";
    2.86 -by (blast_tac (claset() addIs [elt.Trans]) 1);
    2.87 -qed "leadsETo_Trans";
    2.88 -
    2.89 -
    2.90 -(*Useful with cancellation, disjunction*)
    2.91 -Goal "F : A leadsTo[CC] (A' Un A') ==> F : A leadsTo[CC] A'";
    2.92 -by (asm_full_simp_tac (simpset() addsimps Un_ac) 1);
    2.93 -qed "leadsETo_Un_duplicate";
    2.94 -
    2.95 -Goal "F : A leadsTo[CC] (A' Un C Un C) ==> F : A leadsTo[CC] (A' Un C)";
    2.96 -by (asm_full_simp_tac (simpset() addsimps Un_ac) 1);
    2.97 -qed "leadsETo_Un_duplicate2";
    2.98 -
    2.99 -(*The Union introduction rule as we should have liked to state it*)
   2.100 -val prems = Goalw [leadsETo_def]
   2.101 -    "(!!A. A : S ==> F : A leadsTo[CC] B) ==> F : (Union S) leadsTo[CC] B";
   2.102 -by (blast_tac (claset() addIs [elt.Union] addDs prems) 1);
   2.103 -qed "leadsETo_Union";
   2.104 -
   2.105 -val prems = Goal
   2.106 -    "(!!i. i : I ==> F : (A i) leadsTo[CC] B) \
   2.107 -\    ==> F : (UN i:I. A i) leadsTo[CC] B";
   2.108 -by (stac (Union_image_eq RS sym) 1);
   2.109 -by (blast_tac (claset() addIs leadsETo_Union::prems) 1);
   2.110 -qed "leadsETo_UN";
   2.111 -
   2.112 -(*The INDUCTION rule as we should have liked to state it*)
   2.113 -val major::prems = Goalw [leadsETo_def]
   2.114 -  "[| F : za leadsTo[CC] zb;  \
   2.115 -\     !!A B. [| F : A ensures B;  A-B : insert {} CC |] ==> P A B; \
   2.116 -\     !!A B C. [| F : A leadsTo[CC] B; P A B; F : B leadsTo[CC] C; P B C |] \
   2.117 -\              ==> P A C; \
   2.118 -\     !!B S. ALL A:S. F : A leadsTo[CC] B & P A B ==> P (Union S) B \
   2.119 -\  |] ==> P za zb";
   2.120 -by (rtac (major RS CollectD RS elt.induct) 1);
   2.121 -by (REPEAT (blast_tac (claset() addIs prems) 1));
   2.122 -qed "leadsETo_induct";
   2.123 -
   2.124 -
   2.125 -(** New facts involving leadsETo **)
   2.126 -
   2.127 -Goal "CC' <= CC ==> (A leadsTo[CC'] B) <= (A leadsTo[CC] B)";
   2.128 -by Safe_tac;
   2.129 -by (etac leadsETo_induct 1);
   2.130 -by (blast_tac (claset() addIs [leadsETo_Union]) 3);
   2.131 -by (blast_tac (claset() addIs [leadsETo_Trans]) 2);
   2.132 -by (blast_tac (claset() addIs [leadsETo_Basis]) 1);
   2.133 -qed "leadsETo_mono";
   2.134 -
   2.135 -Goal "[| F : A leadsTo[CC] B;  F : B leadsTo[DD] C |] \
   2.136 -\     ==> F : A leadsTo[CC Un DD] C";
   2.137 -by (blast_tac (claset() addIs [impOfSubs leadsETo_mono, leadsETo_Trans]) 1);
   2.138 -qed "leadsETo_Trans_Un";
   2.139 -
   2.140 -val prems = Goalw [leadsETo_def]
   2.141 - "(!!A. A : S ==> F : (A Int C) leadsTo[CC] B) ==> F : (Union S Int C) leadsTo[CC] B";
   2.142 -by (simp_tac (HOL_ss addsimps [Int_Union_Union]) 1);
   2.143 -by (blast_tac (claset() addIs [elt.Union] addDs prems) 1);
   2.144 -qed "leadsETo_Union_Int";
   2.145 -
   2.146 -(*Binary union introduction rule*)
   2.147 -Goal "[| F : A leadsTo[CC] C; F : B leadsTo[CC] C |] ==> F : (A Un B) leadsTo[CC] C";
   2.148 -by (stac Un_eq_Union 1);
   2.149 -by (blast_tac (claset() addIs [leadsETo_Union]) 1);
   2.150 -qed "leadsETo_Un";
   2.151 -
   2.152 -val prems = 
   2.153 -Goal "(!!x. x : A ==> F : {x} leadsTo[CC] B) ==> F : A leadsTo[CC] B";
   2.154 -by (stac (UN_singleton RS sym) 1 THEN rtac leadsETo_UN 1);
   2.155 -by (blast_tac (claset() addIs prems) 1);
   2.156 -qed "single_leadsETo_I";
   2.157 -
   2.158 -
   2.159 -Goal "A<=B ==> F : A leadsTo[CC] B";
   2.160 -by (asm_simp_tac (simpset() addsimps [subset_imp_ensures RS leadsETo_Basis,
   2.161 -				      Diff_eq_empty_iff RS iffD2]) 1);
   2.162 -qed "subset_imp_leadsETo";
   2.163 -
   2.164 -bind_thm ("empty_leadsETo", empty_subsetI RS subset_imp_leadsETo);
   2.165 -Addsimps [empty_leadsETo];
   2.166 -
   2.167 -
   2.168 -
   2.169 -(** Weakening laws **)
   2.170 -
   2.171 -Goal "[| F : A leadsTo[CC] A';  A'<=B' |] ==> F : A leadsTo[CC] B'";
   2.172 -by (blast_tac (claset() addIs [subset_imp_leadsETo, leadsETo_Trans]) 1);
   2.173 -qed "leadsETo_weaken_R";
   2.174 -
   2.175 -Goal "[| F : A leadsTo[CC] A'; B<=A |] ==> F : B leadsTo[CC] A'";
   2.176 -by (blast_tac (claset() addIs [leadsETo_Trans, subset_imp_leadsETo]) 1);
   2.177 -qed_spec_mp "leadsETo_weaken_L";
   2.178 -
   2.179 -(*Distributes over binary unions*)
   2.180 -Goal "F : (A Un B) leadsTo[CC] C  =  \
   2.181 -\     (F : A leadsTo[CC] C & F : B leadsTo[CC] C)";
   2.182 -by (blast_tac (claset() addIs [leadsETo_Un, leadsETo_weaken_L]) 1);
   2.183 -qed "leadsETo_Un_distrib";
   2.184 -
   2.185 -Goal "F : (UN i:I. A i) leadsTo[CC] B  =  \
   2.186 -\     (ALL i : I. F : (A i) leadsTo[CC] B)";
   2.187 -by (blast_tac (claset() addIs [leadsETo_UN, leadsETo_weaken_L]) 1);
   2.188 -qed "leadsETo_UN_distrib";
   2.189 -
   2.190 -Goal "F : (Union S) leadsTo[CC] B  =  (ALL A : S. F : A leadsTo[CC] B)";
   2.191 -by (blast_tac (claset() addIs [leadsETo_Union, leadsETo_weaken_L]) 1);
   2.192 -qed "leadsETo_Union_distrib";
   2.193 -
   2.194 -Goal "[| F : A leadsTo[CC'] A'; B<=A; A'<=B';  CC' <= CC |] \
   2.195 -\     ==> F : B leadsTo[CC] B'";
   2.196 -by (dtac (impOfSubs leadsETo_mono) 1);
   2.197 -by (assume_tac 1);
   2.198 -by (blast_tac (claset() delrules [subsetCE]
   2.199 -			addIs [leadsETo_weaken_R, leadsETo_weaken_L,
   2.200 -			       leadsETo_Trans]) 1);
   2.201 -qed "leadsETo_weaken";
   2.202 -
   2.203 -Goal "[| F : A leadsTo[CC] A';  CC <= givenBy v |] \
   2.204 -\     ==> F : A leadsTo[givenBy v] A'";
   2.205 -by (blast_tac (claset() addIs [empty_mem_givenBy, leadsETo_weaken]) 1);
   2.206 -qed "leadsETo_givenBy";
   2.207 -
   2.208 -
   2.209 -(*Set difference*)
   2.210 -Goal "[| F : (A-B) leadsTo[CC] C; F : B leadsTo[CC] C |] \
   2.211 -\     ==> F : A leadsTo[CC] C";
   2.212 -by (blast_tac (claset() addIs [leadsETo_Un, leadsETo_weaken]) 1);
   2.213 -qed "leadsETo_Diff";
   2.214 -
   2.215 -
   2.216 -(*Binary union version*)
   2.217 -Goal "[| F : A leadsTo[CC] A';  F : B leadsTo[CC] B' |] \
   2.218 -\     ==> F : (A Un B) leadsTo[CC] (A' Un B')";
   2.219 -by (blast_tac (claset() addIs [leadsETo_Un, 
   2.220 -			       leadsETo_weaken_R]) 1);
   2.221 -qed "leadsETo_Un_Un";
   2.222 -
   2.223 -
   2.224 -(** The cancellation law **)
   2.225 -
   2.226 -Goal "[| F : A leadsTo[CC] (A' Un B); F : B leadsTo[CC] B' |] \
   2.227 -\     ==> F : A leadsTo[CC] (A' Un B')";
   2.228 -by (blast_tac (claset() addIs [leadsETo_Un_Un, 
   2.229 -			       subset_imp_leadsETo, leadsETo_Trans]) 1);
   2.230 -qed "leadsETo_cancel2";
   2.231 -
   2.232 -Goal "[| F : A leadsTo[CC] (B Un A'); F : B leadsTo[CC] B' |] \
   2.233 -\   ==> F : A leadsTo[CC] (B' Un A')";
   2.234 -by (asm_full_simp_tac (simpset() addsimps [Un_commute]) 1);
   2.235 -by (blast_tac (claset() addSIs [leadsETo_cancel2]) 1);
   2.236 -qed "leadsETo_cancel1";
   2.237 -
   2.238 -Goal "[| F : A leadsTo[CC] (B Un A'); F : (B-A') leadsTo[CC] B' |] \
   2.239 -\   ==> F : A leadsTo[CC] (B' Un A')";
   2.240 -by (rtac leadsETo_cancel1 1);
   2.241 -by (assume_tac 2);
   2.242 -by (ALLGOALS Asm_simp_tac);
   2.243 -qed "leadsETo_cancel_Diff1";
   2.244 -
   2.245 -
   2.246 -(** The impossibility law **)
   2.247 -
   2.248 -Goal "F : A leadsTo[CC] B ==> B={} --> A={}";
   2.249 -by (etac leadsETo_induct 1);
   2.250 -by (ALLGOALS Asm_simp_tac);
   2.251 -by (rewrite_goals_tac [ensures_def, constrains_def, transient_def]);
   2.252 -by (Blast_tac 1);
   2.253 -val lemma = result() RS mp;
   2.254 -
   2.255 -Goal "F : A leadsTo[CC] {} ==> A={}";
   2.256 -by (blast_tac (claset() addSIs [lemma]) 1);
   2.257 -qed "leadsETo_empty";
   2.258 -
   2.259 -
   2.260 -(** PSP: Progress-Safety-Progress **)
   2.261 -
   2.262 -(*Special case of PSP: Misra's "stable conjunction"*)
   2.263 -Goalw [stable_def]
   2.264 -   "[| F : A leadsTo[CC] A';  F : stable B;  ALL C:CC. C Int B : CC |] \
   2.265 -\   ==> F : (A Int B) leadsTo[CC] (A' Int B)";
   2.266 -by (etac leadsETo_induct 1);
   2.267 -by (blast_tac (claset() addIs [leadsETo_Union_Int]) 3);
   2.268 -by (blast_tac (claset() addIs [leadsETo_Trans]) 2);
   2.269 -by (rtac leadsETo_Basis 1);
   2.270 -by (force_tac (claset(),
   2.271 -	       simpset() addsimps [Diff_Int_distrib2 RS sym]) 2);
   2.272 -by (asm_full_simp_tac
   2.273 -    (simpset() addsimps [ensures_def, 
   2.274 -			 Diff_Int_distrib2 RS sym, Int_Un_distrib2 RS sym]) 1);
   2.275 -by (blast_tac (claset() addIs [transient_strengthen, constrains_Int]) 1);
   2.276 -qed "e_psp_stable";
   2.277 -
   2.278 -Goal "[| F : A leadsTo[CC] A'; F : stable B;  ALL C:CC. C Int B : CC |] \
   2.279 -\     ==> F : (B Int A) leadsTo[CC] (B Int A')";
   2.280 -by (asm_simp_tac (simpset() addsimps e_psp_stable::Int_ac) 1);
   2.281 -qed "e_psp_stable2";
   2.282 -
   2.283 -Goal "[| F : A leadsTo[CC] A'; F : B co B';  \
   2.284 -\        ALL C:CC. C Int B Int B' : CC |] \
   2.285 -\     ==> F : (A Int B') leadsTo[CC] ((A' Int B) Un (B' - B))";
   2.286 -by (etac leadsETo_induct 1);
   2.287 -by (blast_tac (claset() addIs [leadsETo_Union_Int]) 3);
   2.288 -(*Transitivity case has a delicate argument involving "cancellation"*)
   2.289 -by (rtac leadsETo_Un_duplicate2 2);
   2.290 -by (etac leadsETo_cancel_Diff1 2);
   2.291 -by (asm_full_simp_tac (simpset() addsimps [Int_Diff, Diff_triv]) 2);
   2.292 -by (blast_tac (claset() addIs [leadsETo_weaken_L] 
   2.293 -                        addDs [constrains_imp_subset]) 2);
   2.294 -(*Basis case*)
   2.295 -by (rtac leadsETo_Basis 1);
   2.296 -by (blast_tac (claset() addIs [psp_ensures]) 1);
   2.297 -by (subgoal_tac "A Int B' - (Ba Int B Un (B' - B)) = (A - Ba) Int B Int B'" 1);
   2.298 -by Auto_tac;
   2.299 -qed "e_psp";
   2.300 -
   2.301 -Goal "[| F : A leadsTo[CC] A'; F : B co B';  \
   2.302 -\        ALL C:CC. C Int B Int B' : CC |] \
   2.303 -\     ==> F : (B' Int A) leadsTo[CC] ((B Int A') Un (B' - B))";
   2.304 -by (asm_full_simp_tac (simpset() addsimps e_psp::Int_ac) 1);
   2.305 -qed "e_psp2";
   2.306 -
   2.307 -
   2.308 -(*** Special properties involving the parameter [CC] ***)
   2.309 -
   2.310 -(*??IS THIS NEEDED?? or is it just an example of what's provable??*)
   2.311 -Goal "[| F: (A leadsTo[givenBy v] B);  G : preserves v;  \
   2.312 -\        F Join G : stable C |] \
   2.313 -\     ==> F Join G : ((C Int A) leadsTo[(%D. C Int D) ` givenBy v] B)";
   2.314 -by (etac leadsETo_induct 1);
   2.315 -by (stac Int_Union 3);
   2.316 -by (blast_tac (claset() addIs [leadsETo_UN]) 3);
   2.317 -by (blast_tac (claset() addIs [e_psp_stable2 RS leadsETo_weaken_L, 
   2.318 -			       leadsETo_Trans]) 2);
   2.319 -by (rtac leadsETo_Basis 1);
   2.320 -by (auto_tac (claset(),
   2.321 -	      simpset() addsimps [Diff_eq_empty_iff RS iffD2,
   2.322 -				  Int_Diff, ensures_def,
   2.323 -				  givenBy_eq_Collect, Join_transient]));
   2.324 -by (blast_tac (claset() addIs [transient_strengthen]) 3);
   2.325 -by (ALLGOALS (dres_inst_tac [("P1","P")] (impOfSubs preserves_subset_stable)));
   2.326 -by (rewtac stable_def);
   2.327 -by (blast_tac (claset() addIs [constrains_Int RS constrains_weaken]) 2);
   2.328 -by (blast_tac (claset() addIs [constrains_Int RS constrains_weaken]) 1);
   2.329 -qed "gen_leadsETo_imp_Join_leadsETo";
   2.330 -
   2.331 -(*useful??*)
   2.332 -Goal "[| F Join G : (A leadsTo[CC] B);  ALL C:CC. G : stable C |] \
   2.333 -\     ==> F: (A leadsTo[CC] B)";
   2.334 -by (etac leadsETo_induct 1);
   2.335 -by (blast_tac (claset() addIs [leadsETo_Union]) 3);
   2.336 -by (blast_tac (claset() addIs [leadsETo_Trans]) 2);
   2.337 -by (rtac leadsETo_Basis 1);
   2.338 -by (case_tac "A <= B" 1);
   2.339 -by (etac subset_imp_ensures 1);
   2.340 -by (auto_tac (claset() addIs [constrains_weaken],
   2.341 -              simpset() addsimps [stable_def, ensures_def, Join_transient]));
   2.342 -by (REPEAT (thin_tac "?F : ?A co ?B" 1));
   2.343 -by (etac transientE 1);
   2.344 -by (rewtac constrains_def);
   2.345 -by (blast_tac (claset() addSDs [bspec]) 1);
   2.346 -qed "Join_leadsETo_stable_imp_leadsETo";
   2.347 -
   2.348 -(**** Relationship with traditional "leadsTo", strong & weak ****)
   2.349 -
   2.350 -(** strong **)
   2.351 -
   2.352 -Goal "(A leadsTo[CC] B) <= (A leadsTo B)";
   2.353 -by Safe_tac;
   2.354 -by (etac leadsETo_induct 1);
   2.355 -by (blast_tac (claset() addIs [leadsTo_Union]) 3);
   2.356 -by (blast_tac (claset() addIs [leadsTo_Trans]) 2);
   2.357 -by (Blast_tac 1);
   2.358 -qed "leadsETo_subset_leadsTo";
   2.359 -
   2.360 -Goal "(A leadsTo[UNIV] B) = (A leadsTo B)";
   2.361 -by Safe_tac;
   2.362 -by (etac (impOfSubs leadsETo_subset_leadsTo) 1);
   2.363 -(*right-to-left case*)
   2.364 -by (etac leadsTo_induct 1);
   2.365 -by (blast_tac (claset() addIs [leadsETo_Union]) 3);
   2.366 -by (blast_tac (claset() addIs [leadsETo_Trans]) 2);
   2.367 -by (Blast_tac 1);
   2.368 -qed "leadsETo_UNIV_eq_leadsTo";
   2.369 -
   2.370 -(**** weak ****)
   2.371 -
   2.372 -Goalw [LeadsETo_def]
   2.373 -     "A LeadsTo[CC] B = \
   2.374 -\       {F. F : (reachable F Int A) leadsTo[(%C. reachable F Int C) ` CC] \
   2.375 -\       (reachable F Int B)}";
   2.376 -by (blast_tac (claset() addDs [e_psp_stable2] addIs [leadsETo_weaken]) 1);
   2.377 -qed "LeadsETo_eq_leadsETo";
   2.378 -
   2.379 -(*** Introduction rules: Basis, Trans, Union ***)
   2.380 -
   2.381 -Goal "[| F : A LeadsTo[CC] B;  F : B LeadsTo[CC] C |] \
   2.382 -\     ==> F : A LeadsTo[CC] C";
   2.383 -by (asm_full_simp_tac (simpset() addsimps [LeadsETo_eq_leadsETo]) 1);
   2.384 -by (blast_tac (claset() addIs [leadsETo_Trans]) 1);
   2.385 -qed "LeadsETo_Trans";
   2.386 -
   2.387 -val prems = Goalw [LeadsETo_def]
   2.388 -     "(!!A. A : S ==> F : A LeadsTo[CC] B) ==> F : (Union S) LeadsTo[CC] B";
   2.389 -by (Simp_tac 1);
   2.390 -by (stac Int_Union 1);
   2.391 -by (blast_tac (claset() addIs [leadsETo_UN] addDs prems) 1);
   2.392 -qed "LeadsETo_Union";
   2.393 -
   2.394 -val prems = 
   2.395 -Goal "(!!i. i : I ==> F : (A i) LeadsTo[CC] B) \
   2.396 -\     ==> F : (UN i:I. A i) LeadsTo[CC] B";
   2.397 -by (simp_tac (HOL_ss addsimps [Union_image_eq RS sym]) 1);
   2.398 -by (blast_tac (claset() addIs (LeadsETo_Union::prems)) 1);
   2.399 -qed "LeadsETo_UN";
   2.400 -
   2.401 -(*Binary union introduction rule*)
   2.402 -Goal "[| F : A LeadsTo[CC] C; F : B LeadsTo[CC] C |] \
   2.403 -\     ==> F : (A Un B) LeadsTo[CC] C";
   2.404 -by (stac Un_eq_Union 1);
   2.405 -by (blast_tac (claset() addIs [LeadsETo_Union]) 1);
   2.406 -qed "LeadsETo_Un";
   2.407 -
   2.408 -(*Lets us look at the starting state*)
   2.409 -val prems = 
   2.410 -Goal "(!!s. s : A ==> F : {s} LeadsTo[CC] B) ==> F : A LeadsTo[CC] B";
   2.411 -by (stac (UN_singleton RS sym) 1 THEN rtac LeadsETo_UN 1);
   2.412 -by (blast_tac (claset() addIs prems) 1);
   2.413 -qed "single_LeadsETo_I";
   2.414 -
   2.415 -Goal "A <= B ==> F : A LeadsTo[CC] B";
   2.416 -by (simp_tac (simpset() addsimps [LeadsETo_def]) 1);
   2.417 -by (blast_tac (claset() addIs [subset_imp_leadsETo]) 1);
   2.418 -qed "subset_imp_LeadsETo";
   2.419 -
   2.420 -bind_thm ("empty_LeadsETo", empty_subsetI RS subset_imp_LeadsETo);
   2.421 -
   2.422 -Goal "[| F : A LeadsTo[CC] A';  A' <= B' |] ==> F : A LeadsTo[CC] B'";
   2.423 -by (full_simp_tac (simpset() addsimps [LeadsETo_def]) 1);
   2.424 -by (blast_tac (claset() addIs [leadsETo_weaken_R]) 1);
   2.425 -qed_spec_mp "LeadsETo_weaken_R";
   2.426 -
   2.427 -Goal "[| F : A LeadsTo[CC] A';  B <= A |] ==> F : B LeadsTo[CC] A'";
   2.428 -by (full_simp_tac (simpset() addsimps [LeadsETo_def]) 1);
   2.429 -by (blast_tac (claset() addIs [leadsETo_weaken_L]) 1);
   2.430 -qed_spec_mp "LeadsETo_weaken_L";
   2.431 -
   2.432 -Goal "[| F : A LeadsTo[CC'] A';   \
   2.433 -\        B <= A;  A' <= B';  CC' <= CC |] \
   2.434 -\     ==> F : B LeadsTo[CC] B'";
   2.435 -by (full_simp_tac (simpset() addsimps [LeadsETo_def]) 1);
   2.436 -by (blast_tac (claset() addIs [leadsETo_weaken]) 1);
   2.437 -qed "LeadsETo_weaken";
   2.438 -
   2.439 -Goalw [LeadsETo_def, LeadsTo_def] "(A LeadsTo[CC] B) <= (A LeadsTo B)";
   2.440 -by (blast_tac (claset() addIs [impOfSubs leadsETo_subset_leadsTo]) 1);
   2.441 -qed "LeadsETo_subset_LeadsTo";
   2.442 -
   2.443 -(*Postcondition can be strengthened to (reachable F Int B) *)
   2.444 -Goal "F : A ensures B ==> F : (reachable F Int A) ensures B";
   2.445 -by (rtac (stable_ensures_Int RS ensures_weaken_R) 1);
   2.446 -by Auto_tac;
   2.447 -qed "reachable_ensures";
   2.448 -
   2.449 -Goal "F : A leadsTo B ==> F : (reachable F Int A) leadsTo[Pow(reachable F)] B";
   2.450 -by (etac leadsTo_induct 1);
   2.451 -by (stac Int_Union 3);
   2.452 -by (blast_tac (claset() addIs [leadsETo_UN]) 3);
   2.453 -by (blast_tac (claset() addDs [e_psp_stable2] 
   2.454 -                        addIs [leadsETo_Trans, leadsETo_weaken_L]) 2);
   2.455 -by (blast_tac (claset() addIs [reachable_ensures, leadsETo_Basis]) 1);
   2.456 -val lemma = result();
   2.457 -
   2.458 -Goal "(A LeadsTo[UNIV] B) = (A LeadsTo B)";
   2.459 -by Safe_tac;
   2.460 -by (etac (impOfSubs LeadsETo_subset_LeadsTo) 1);
   2.461 -(*right-to-left case*)
   2.462 -by (rewrite_goals_tac [LeadsETo_def, LeadsTo_def]);
   2.463 -by (fast_tac (claset() addEs [lemma RS leadsETo_weaken]) 1);
   2.464 -qed "LeadsETo_UNIV_eq_LeadsTo";
   2.465 -
   2.466 -
   2.467 -(**** EXTEND/PROJECT PROPERTIES ****)
   2.468 -
   2.469 -Open_locale "Extend";
   2.470 -
   2.471 -(*givenBy laws that need to be in the locale*)
   2.472 -
   2.473 -Goal "givenBy (v o f) = extend_set h ` (givenBy v)";
   2.474 -by (simp_tac (simpset() addsimps [givenBy_eq_Collect]) 1);
   2.475 -by (Deepen_tac 0 1);
   2.476 -qed "givenBy_o_eq_extend_set";
   2.477 -
   2.478 -Goal "givenBy f = range (extend_set h)";
   2.479 -by (simp_tac (simpset() addsimps [givenBy_eq_Collect]) 1);
   2.480 -by (Deepen_tac 0 1);
   2.481 -qed "givenBy_eq_extend_set";
   2.482 -
   2.483 -Goal "D : givenBy v ==> extend_set h D : givenBy (v o f)";
   2.484 -by (full_simp_tac (simpset() addsimps [givenBy_eq_all]) 1);
   2.485 -by (Blast_tac 1);
   2.486 -qed "extend_set_givenBy_I";
   2.487 -
   2.488 -Goal "F : A leadsTo[CC] B \
   2.489 -\     ==> extend h F : (extend_set h A) leadsTo[extend_set h ` CC] \
   2.490 -\                      (extend_set h B)";
   2.491 -by (etac leadsETo_induct 1);
   2.492 -by (asm_simp_tac (simpset() addsimps [leadsETo_UN, extend_set_Union]) 3);
   2.493 -by (blast_tac (claset() addIs [leadsETo_Trans]) 2);
   2.494 -by (force_tac (claset() addIs [leadsETo_Basis, subset_imp_ensures],
   2.495 -	       simpset() addsimps [extend_ensures,
   2.496 -				   extend_set_Diff_distrib RS sym]) 1);
   2.497 -qed "leadsETo_imp_extend_leadsETo";
   2.498 -
   2.499 -
   2.500 -
   2.501 -(*NOT USED, but analogous to preserves_project_transient_empty in Project.ML*)
   2.502 -Goal "[| G : preserves (v o f);  project h C G : transient D;  \
   2.503 -\        D : givenBy v |] ==> D={}";
   2.504 -by (rtac stable_transient_empty 1);
   2.505 -by (assume_tac 2);
   2.506 -(*If addIs then PROOF FAILED at depth 2*)
   2.507 -by (blast_tac (claset() addSIs [preserves_givenBy_imp_stable,
   2.508 -				project_preserves_I]) 1);
   2.509 -result();
   2.510 -
   2.511 -
   2.512 -(*This version's stronger in the "ensures" precondition
   2.513 -  BUT there's no ensures_weaken_L*)
   2.514 -Goal "[| project h C G ~: transient (project_set h C Int (A-B)) | \
   2.515 -\          project_set h C Int (A - B) = {};  \
   2.516 -\        extend h F Join G : stable C;  \
   2.517 -\        F Join project h C G : (project_set h C Int A) ensures B |] \
   2.518 -\     ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)";
   2.519 -by (stac (Int_extend_set_lemma RS sym) 1);
   2.520 -by (rtac Join_project_ensures 1);
   2.521 -by (auto_tac (claset(), simpset() addsimps [Int_Diff]));
   2.522 -qed "Join_project_ensures_strong";
   2.523 -
   2.524 -(*Generalizes preserves_project_transient_empty*)
   2.525 -Goal "[| G : preserves (v o f);  \
   2.526 -\        project h C G : transient (C' Int D);  \
   2.527 -\        project h C G : stable C';  D : givenBy v |]    \
   2.528 -\     ==> C' Int D = {}";
   2.529 -by (rtac stable_transient_empty 1);
   2.530 -by (assume_tac 2);
   2.531 -(*If addIs then PROOF FAILED at depth 3*)
   2.532 -by (blast_tac (claset() addSIs [stable_Int, preserves_givenBy_imp_stable,
   2.533 -				project_preserves_I]) 1);
   2.534 -qed "preserves_o_project_transient_empty";
   2.535 -
   2.536 -Goal "[| extend h F Join G : stable C;  \
   2.537 -\        F Join project h C G : (project_set h C Int A) leadsTo[(%D. project_set h C Int D)`givenBy v] B;  \
   2.538 -\        G : preserves (v o f) |] \
   2.539 -\     ==> extend h F Join G : \
   2.540 -\           (C Int extend_set h (project_set h C Int A)) \
   2.541 -\           leadsTo[(%D. C Int extend_set h D)`givenBy v]  (extend_set h B)";
   2.542 -by (etac leadsETo_induct 1);
   2.543 -by (asm_simp_tac (simpset() delsimps UN_simps
   2.544 -		  addsimps [Int_UN_distrib, leadsETo_UN, extend_set_Union]) 3);
   2.545 -by (blast_tac (claset() addIs [e_psp_stable2 RS leadsETo_weaken_L, 
   2.546 -			       leadsETo_Trans]) 2);
   2.547 -by Auto_tac;
   2.548 -by (force_tac (claset() addIs [leadsETo_Basis, subset_imp_ensures],
   2.549 -	       simpset()) 1);
   2.550 -by (rtac leadsETo_Basis 1);
   2.551 -by (asm_simp_tac (simpset() addsimps [Int_Diff, Int_extend_set_lemma,
   2.552 -				      extend_set_Diff_distrib RS sym]) 2);
   2.553 -by (rtac Join_project_ensures_strong 1);
   2.554 -by (auto_tac (claset() addDs [preserves_o_project_transient_empty]
   2.555 -		       addIs [project_stable_project_set], 
   2.556 -	      simpset() addsimps [Int_left_absorb]));
   2.557 -by (asm_simp_tac
   2.558 -    (simpset() addsimps [stable_ensures_Int RS ensures_weaken_R,
   2.559 -			 Int_lower2, project_stable_project_set,
   2.560 -			 extend_stable_project_set]) 1);
   2.561 -val lemma = result();
   2.562 -
   2.563 -Goal "[| extend h F Join G : stable C;  \
   2.564 -\        F Join project h C G : \
   2.565 -\            (project_set h C Int A) \
   2.566 -\            leadsTo[(%D. project_set h C Int D)`givenBy v] B;  \
   2.567 -\        G : preserves (v o f) |] \
   2.568 -\     ==> extend h F Join G : (C Int extend_set h A) \
   2.569 -\           leadsTo[(%D. C Int extend_set h D)`givenBy v] (extend_set h B)";
   2.570 -by (rtac (lemma RS leadsETo_weaken) 1);
   2.571 -by (auto_tac (claset(), 
   2.572 -	      simpset() addsimps [split_extended_all]));
   2.573 -qed "project_leadsETo_D_lemma";
   2.574 -
   2.575 -Goal "[| F Join project h UNIV G : A leadsTo[givenBy v] B;  \
   2.576 -\        G : preserves (v o f) |]  \
   2.577 -\     ==> extend h F Join G : (extend_set h A) \
   2.578 -\           leadsTo[givenBy (v o f)] (extend_set h B)";
   2.579 -by (rtac (make_elim project_leadsETo_D_lemma) 1);
   2.580 -by (stac stable_UNIV 1);
   2.581 -by Auto_tac;
   2.582 -by (etac leadsETo_givenBy 1);
   2.583 -by (rtac (givenBy_o_eq_extend_set RS equalityD2) 1);
   2.584 -qed "project_leadsETo_D";
   2.585 -
   2.586 -Goal "[| F Join project h (reachable (extend h F Join G)) G \
   2.587 -\            : A LeadsTo[givenBy v] B;  \
   2.588 -\        G : preserves (v o f) |] \
   2.589 -\     ==> extend h F Join G : \
   2.590 -\           (extend_set h A) LeadsTo[givenBy (v o f)] (extend_set h B)";
   2.591 -by (rtac (make_elim (subset_refl RS stable_reachable RS 
   2.592 -		     project_leadsETo_D_lemma)) 1);
   2.593 -by (auto_tac (claset(), 
   2.594 -	      simpset() addsimps [LeadsETo_def]));
   2.595 -by (asm_full_simp_tac 
   2.596 -    (simpset() addsimps [project_set_reachable_extend_eq RS sym]) 1);
   2.597 -by (etac (impOfSubs leadsETo_mono) 1);
   2.598 -by (blast_tac (claset() addIs [extend_set_givenBy_I]) 1);
   2.599 -qed "project_LeadsETo_D";
   2.600 -
   2.601 -Goalw [extending_def]
   2.602 -     "(ALL G. extend h F ok G --> G : preserves (v o f)) \
   2.603 -\     ==> extending (%G. UNIV) h F \
   2.604 -\               (extend_set h A leadsTo[givenBy (v o f)] extend_set h B) \
   2.605 -\               (A leadsTo[givenBy v] B)";
   2.606 -by (auto_tac (claset(), simpset() addsimps [project_leadsETo_D]));
   2.607 -qed "extending_leadsETo";
   2.608 -
   2.609 -
   2.610 -Goalw [extending_def]
   2.611 -     "(ALL G. extend h F ok G --> G : preserves (v o f)) \
   2.612 -\     ==> extending (%G. reachable (extend h F Join G)) h F \
   2.613 -\               (extend_set h A LeadsTo[givenBy (v o f)] extend_set h B) \
   2.614 -\               (A LeadsTo[givenBy v]  B)";
   2.615 -by (blast_tac (claset() addIs [project_LeadsETo_D]) 1);
   2.616 -qed "extending_LeadsETo";
   2.617 -
   2.618 -
   2.619 -(*** leadsETo in the precondition ***)
   2.620 -
   2.621 -(*Lemma for the Trans case*)
   2.622 -Goal "[| extend h F Join G : stable C;    \
   2.623 -\        F Join project h C G    \
   2.624 -\          : project_set h C Int project_set h A leadsTo project_set h B |] \
   2.625 -\     ==> F Join project h C G    \
   2.626 -\           : project_set h C Int project_set h A leadsTo    \
   2.627 -\             project_set h C Int project_set h B";
   2.628 -by (rtac (psp_stable2 RS leadsTo_weaken_L) 1);
   2.629 -by (auto_tac (claset(),
   2.630 -	      simpset() addsimps [project_stable_project_set, 
   2.631 -				  extend_stable_project_set]));
   2.632 -val lemma = result();
   2.633 -
   2.634 -Goal "[| extend h F Join G : stable C;  \
   2.635 -\        extend h F Join G : \
   2.636 -\          (C Int A) leadsTo[(%D. C Int D)`givenBy f]  B |]  \
   2.637 -\ ==> F Join project h C G  \
   2.638 -\   : (project_set h C Int project_set h (C Int A)) leadsTo (project_set h B)";
   2.639 -by (etac leadsETo_induct 1);
   2.640 -by (asm_simp_tac (HOL_ss addsimps [Int_UN_distrib, project_set_Union]) 3);
   2.641 -by (blast_tac (claset() addIs [leadsTo_UN]) 3);
   2.642 -by (blast_tac (claset() addIs [leadsTo_Trans, lemma]) 2);
   2.643 -by (asm_full_simp_tac 
   2.644 -    (simpset() addsimps [givenBy_eq_extend_set]) 1);
   2.645 -by (rtac leadsTo_Basis 1);
   2.646 -by (blast_tac (claset() addIs [ensures_extend_set_imp_project_ensures]) 1);
   2.647 -
   2.648 -qed "project_leadsETo_I_lemma";
   2.649 -
   2.650 -Goal "extend h F Join G : (extend_set h A) leadsTo[givenBy f] (extend_set h B)\
   2.651 -\     ==> F Join project h UNIV G : A leadsTo B";
   2.652 -by (rtac (project_leadsETo_I_lemma RS leadsTo_weaken) 1);
   2.653 -by Auto_tac;
   2.654 -qed "project_leadsETo_I";
   2.655 -
   2.656 -Goal "extend h F Join G : (extend_set h A) LeadsTo[givenBy f] (extend_set h B)\
   2.657 -\     ==> F Join project h (reachable (extend h F Join G)) G  \
   2.658 -\          : A LeadsTo B";
   2.659 -by (full_simp_tac (simpset() addsimps [LeadsTo_def, LeadsETo_def]) 1);
   2.660 -by (rtac (project_leadsETo_I_lemma RS leadsTo_weaken) 1);
   2.661 -by (auto_tac (claset(), 
   2.662 -	      simpset() addsimps [project_set_reachable_extend_eq RS sym]));
   2.663 -qed "project_LeadsETo_I";
   2.664 -
   2.665 -Goalw [projecting_def]
   2.666 -     "projecting (%G. UNIV) h F \
   2.667 -\                (extend_set h A leadsTo[givenBy f] extend_set h B) \
   2.668 -\                (A leadsTo B)";
   2.669 -by (force_tac (claset() addDs [project_leadsETo_I], simpset()) 1);
   2.670 -qed "projecting_leadsTo";
   2.671 -
   2.672 -Goalw [projecting_def]
   2.673 -     "projecting (%G. reachable (extend h F Join G)) h F \
   2.674 -\                (extend_set h A LeadsTo[givenBy f] extend_set h B) \
   2.675 -\                (A LeadsTo B)";
   2.676 -by (force_tac (claset() addDs [project_LeadsETo_I], simpset()) 1);
   2.677 -qed "projecting_LeadsTo";
   2.678 -
   2.679 -Close_locale "Extend";
   2.680 -
   2.681 -
     3.1 --- a/src/HOL/UNITY/ELT.thy	Tue Jan 28 22:53:39 2003 +0100
     3.2 +++ b/src/HOL/UNITY/ELT.thy	Wed Jan 29 11:02:08 2003 +0100
     3.3 @@ -10,19 +10,19 @@
     3.4    elt :: "['a set set, 'a program, 'a set] => ('a set) set"
     3.5  
     3.6  inductive "elt CC F B"
     3.7 -  intrs 
     3.8 +  intros 
     3.9  
    3.10 -    Weaken  "A <= B ==> A : elt CC F B"
    3.11 +    Weaken:  "A <= B ==> A : elt CC F B"
    3.12  
    3.13 -    ETrans  "[| F : A ensures A';  A-A' : CC;  A' : elt CC F B |]
    3.14 -	     ==> A : elt CC F B"
    3.15 +    ETrans:  "[| F : A ensures A';  A-A' : CC;  A' : elt CC F B |]
    3.16 +	      ==> A : elt CC F B"
    3.17  
    3.18 -    Union  "{A. A: S} : Pow (elt CC F B) ==> (Union S) : elt CC F B"
    3.19 +    Union:  "{A. A: S} : Pow (elt CC F B) ==> (Union S) : elt CC F B"
    3.20  
    3.21    monos Pow_mono
    3.22  *)
    3.23  
    3.24 -ELT = Project +
    3.25 +theory ELT = Project:
    3.26  
    3.27  consts
    3.28  
    3.29 @@ -31,13 +31,13 @@
    3.30  
    3.31  
    3.32  inductive "elt CC F"
    3.33 -  intrs 
    3.34 + intros 
    3.35  
    3.36 -    Basis  "[| F : A ensures B;  A-B : (insert {} CC) |] ==> (A,B) : elt CC F"
    3.37 +   Basis:  "[| F : A ensures B;  A-B : (insert {} CC) |] ==> (A,B) : elt CC F"
    3.38  
    3.39 -    Trans  "[| (A,B) : elt CC F;  (B,C) : elt CC F |] ==> (A,C) : elt CC F"
    3.40 +   Trans:  "[| (A,B) : elt CC F;  (B,C) : elt CC F |] ==> (A,C) : elt CC F"
    3.41  
    3.42 -    Union  "ALL A: S. (A,B) : elt CC F ==> (Union S, B) : elt CC F"
    3.43 +   Union:  "ALL A: S. (A,B) : elt CC F ==> (Union S, B) : elt CC F"
    3.44  
    3.45  
    3.46  constdefs
    3.47 @@ -56,4 +56,662 @@
    3.48      "LeadsETo A CC B ==
    3.49        {F. F : (reachable F Int A) leadsTo[(%C. reachable F Int C) ` CC] B}"
    3.50  
    3.51 +
    3.52 +(*** givenBy ***)
    3.53 +
    3.54 +lemma givenBy_id [simp]: "givenBy id = UNIV"
    3.55 +by (unfold givenBy_def, auto)
    3.56 +
    3.57 +lemma givenBy_eq_all: "(givenBy v) = {A. ALL x:A. ALL y. v x = v y --> y: A}"
    3.58 +apply (unfold givenBy_def, safe)
    3.59 +apply (rule_tac [2] x = "v ` ?u" in image_eqI, auto)
    3.60 +done
    3.61 +
    3.62 +lemma givenByI: "(!!x y. [| x:A;  v x = v y |] ==> y: A) ==> A: givenBy v"
    3.63 +by (subst givenBy_eq_all, blast)
    3.64 +
    3.65 +lemma givenByD: "[| A: givenBy v;  x:A;  v x = v y |] ==> y: A"
    3.66 +by (unfold givenBy_def, auto)
    3.67 +
    3.68 +lemma empty_mem_givenBy [iff]: "{} : givenBy v"
    3.69 +by (blast intro!: givenByI)
    3.70 +
    3.71 +lemma givenBy_imp_eq_Collect: "A: givenBy v ==> EX P. A = {s. P(v s)}"
    3.72 +apply (rule_tac x = "%n. EX s. v s = n & s : A" in exI)
    3.73 +apply (simp (no_asm_use) add: givenBy_eq_all)
    3.74 +apply blast
    3.75 +done
    3.76 +
    3.77 +lemma Collect_mem_givenBy: "{s. P(v s)} : givenBy v"
    3.78 +by (unfold givenBy_def, best)
    3.79 +
    3.80 +lemma givenBy_eq_Collect: "givenBy v = {A. EX P. A = {s. P(v s)}}"
    3.81 +by (blast intro: Collect_mem_givenBy givenBy_imp_eq_Collect)
    3.82 +
    3.83 +(*preserving v preserves properties given by v*)
    3.84 +lemma preserves_givenBy_imp_stable:
    3.85 +     "[| F : preserves v;  D : givenBy v |] ==> F : stable D"
    3.86 +apply (force simp add: preserves_subset_stable [THEN subsetD] givenBy_eq_Collect)
    3.87 +done
    3.88 +
    3.89 +lemma givenBy_o_subset: "givenBy (w o v) <= givenBy v"
    3.90 +apply (simp (no_asm) add: givenBy_eq_Collect)
    3.91 +apply best 
    3.92 +done
    3.93 +
    3.94 +lemma givenBy_DiffI:
    3.95 +     "[| A : givenBy v;  B : givenBy v |] ==> A-B : givenBy v"
    3.96 +apply (simp (no_asm_use) add: givenBy_eq_Collect)
    3.97 +apply safe
    3.98 +apply (rule_tac x = "%z. ?R z & ~ ?Q z" in exI)
    3.99 +apply (tactic "deepen_tac (set_cs addSIs [equalityI]) 0 1")
   3.100 +done
   3.101 +
   3.102 +
   3.103 +(** Standard leadsTo rules **)
   3.104 +
   3.105 +lemma leadsETo_Basis [intro]: 
   3.106 +     "[| F: A ensures B;  A-B: insert {} CC |] ==> F : A leadsTo[CC] B"
   3.107 +apply (unfold leadsETo_def)
   3.108 +apply (blast intro: elt.Basis)
   3.109 +done
   3.110 +
   3.111 +lemma leadsETo_Trans: 
   3.112 +     "[| F : A leadsTo[CC] B;  F : B leadsTo[CC] C |] ==> F : A leadsTo[CC] C"
   3.113 +apply (unfold leadsETo_def)
   3.114 +apply (blast intro: elt.Trans)
   3.115 +done
   3.116 +
   3.117 +
   3.118 +(*Useful with cancellation, disjunction*)
   3.119 +lemma leadsETo_Un_duplicate:
   3.120 +     "F : A leadsTo[CC] (A' Un A') ==> F : A leadsTo[CC] A'"
   3.121 +apply (simp add: Un_ac)
   3.122 +done
   3.123 +
   3.124 +lemma leadsETo_Un_duplicate2:
   3.125 +     "F : A leadsTo[CC] (A' Un C Un C) ==> F : A leadsTo[CC] (A' Un C)"
   3.126 +by (simp add: Un_ac)
   3.127 +
   3.128 +(*The Union introduction rule as we should have liked to state it*)
   3.129 +lemma leadsETo_Union:
   3.130 +    "(!!A. A : S ==> F : A leadsTo[CC] B) ==> F : (Union S) leadsTo[CC] B"
   3.131 +apply (unfold leadsETo_def)
   3.132 +apply (blast intro: elt.Union)
   3.133 +done
   3.134 +
   3.135 +lemma leadsETo_UN:
   3.136 +    "(!!i. i : I ==> F : (A i) leadsTo[CC] B)  
   3.137 +     ==> F : (UN i:I. A i) leadsTo[CC] B"
   3.138 +apply (subst Union_image_eq [symmetric])
   3.139 +apply (blast intro: leadsETo_Union)
   3.140 +done
   3.141 +
   3.142 +(*The INDUCTION rule as we should have liked to state it*)
   3.143 +lemma leadsETo_induct:
   3.144 +  "[| F : za leadsTo[CC] zb;   
   3.145 +      !!A B. [| F : A ensures B;  A-B : insert {} CC |] ==> P A B;  
   3.146 +      !!A B C. [| F : A leadsTo[CC] B; P A B; F : B leadsTo[CC] C; P B C |]  
   3.147 +               ==> P A C;  
   3.148 +      !!B S. ALL A:S. F : A leadsTo[CC] B & P A B ==> P (Union S) B  
   3.149 +   |] ==> P za zb"
   3.150 +apply (unfold leadsETo_def)
   3.151 +apply (drule CollectD) 
   3.152 +apply (erule elt.induct, blast+)
   3.153 +done
   3.154 +
   3.155 +
   3.156 +(** New facts involving leadsETo **)
   3.157 +
   3.158 +lemma leadsETo_mono: "CC' <= CC ==> (A leadsTo[CC'] B) <= (A leadsTo[CC] B)"
   3.159 +apply safe
   3.160 +apply (erule leadsETo_induct)
   3.161 +prefer 3 apply (blast intro: leadsETo_Union)
   3.162 +prefer 2 apply (blast intro: leadsETo_Trans)
   3.163 +apply (blast intro: leadsETo_Basis)
   3.164 +done
   3.165 +
   3.166 +lemma leadsETo_Trans_Un:
   3.167 +     "[| F : A leadsTo[CC] B;  F : B leadsTo[DD] C |]  
   3.168 +      ==> F : A leadsTo[CC Un DD] C"
   3.169 +by (blast intro: leadsETo_mono [THEN subsetD] leadsETo_Trans)
   3.170 +
   3.171 +lemma leadsETo_Union_Int:
   3.172 + "(!!A. A : S ==> F : (A Int C) leadsTo[CC] B) 
   3.173 +  ==> F : (Union S Int C) leadsTo[CC] B"
   3.174 +apply (unfold leadsETo_def)
   3.175 +apply (simp only: Int_Union_Union)
   3.176 +apply (blast intro: elt.Union)
   3.177 +done
   3.178 +
   3.179 +(*Binary union introduction rule*)
   3.180 +lemma leadsETo_Un:
   3.181 +     "[| F : A leadsTo[CC] C; F : B leadsTo[CC] C |] 
   3.182 +      ==> F : (A Un B) leadsTo[CC] C"
   3.183 +apply (subst Un_eq_Union)
   3.184 +apply (blast intro: leadsETo_Union)
   3.185 +done
   3.186 +
   3.187 +lemma single_leadsETo_I:
   3.188 +     "(!!x. x : A ==> F : {x} leadsTo[CC] B) ==> F : A leadsTo[CC] B"
   3.189 +apply (subst UN_singleton [symmetric], rule leadsETo_UN, blast)
   3.190 +done
   3.191 +
   3.192 +
   3.193 +lemma subset_imp_leadsETo: "A<=B ==> F : A leadsTo[CC] B"
   3.194 +by (simp add: subset_imp_ensures [THEN leadsETo_Basis] Diff_eq_empty_iff [THEN iffD2])
   3.195 +
   3.196 +lemmas empty_leadsETo = empty_subsetI [THEN subset_imp_leadsETo, simp]
   3.197 +
   3.198 +
   3.199 +
   3.200 +(** Weakening laws **)
   3.201 +
   3.202 +lemma leadsETo_weaken_R:
   3.203 +     "[| F : A leadsTo[CC] A';  A'<=B' |] ==> F : A leadsTo[CC] B'"
   3.204 +apply (blast intro: subset_imp_leadsETo leadsETo_Trans)
   3.205 +done
   3.206 +
   3.207 +lemma leadsETo_weaken_L [rule_format (no_asm)]:
   3.208 +     "[| F : A leadsTo[CC] A'; B<=A |] ==> F : B leadsTo[CC] A'"
   3.209 +apply (blast intro: leadsETo_Trans subset_imp_leadsETo)
   3.210 +done
   3.211 +
   3.212 +(*Distributes over binary unions*)
   3.213 +lemma leadsETo_Un_distrib:
   3.214 +     "F : (A Un B) leadsTo[CC] C  =   
   3.215 +      (F : A leadsTo[CC] C & F : B leadsTo[CC] C)"
   3.216 +apply (blast intro: leadsETo_Un leadsETo_weaken_L)
   3.217 +done
   3.218 +
   3.219 +lemma leadsETo_UN_distrib:
   3.220 +     "F : (UN i:I. A i) leadsTo[CC] B  =   
   3.221 +      (ALL i : I. F : (A i) leadsTo[CC] B)"
   3.222 +apply (blast intro: leadsETo_UN leadsETo_weaken_L)
   3.223 +done
   3.224 +
   3.225 +lemma leadsETo_Union_distrib:
   3.226 +     "F : (Union S) leadsTo[CC] B  =  (ALL A : S. F : A leadsTo[CC] B)"
   3.227 +apply (blast intro: leadsETo_Union leadsETo_weaken_L)
   3.228 +done
   3.229 +
   3.230 +lemma leadsETo_weaken:
   3.231 +     "[| F : A leadsTo[CC'] A'; B<=A; A'<=B';  CC' <= CC |]  
   3.232 +      ==> F : B leadsTo[CC] B'"
   3.233 +apply (drule leadsETo_mono [THEN subsetD], assumption)
   3.234 +apply (blast del: subsetCE intro: leadsETo_weaken_R leadsETo_weaken_L leadsETo_Trans)
   3.235 +done
   3.236 +
   3.237 +lemma leadsETo_givenBy:
   3.238 +     "[| F : A leadsTo[CC] A';  CC <= givenBy v |]  
   3.239 +      ==> F : A leadsTo[givenBy v] A'"
   3.240 +by (blast intro: empty_mem_givenBy leadsETo_weaken)
   3.241 +
   3.242 +
   3.243 +(*Set difference*)
   3.244 +lemma leadsETo_Diff:
   3.245 +     "[| F : (A-B) leadsTo[CC] C; F : B leadsTo[CC] C |]  
   3.246 +      ==> F : A leadsTo[CC] C"
   3.247 +by (blast intro: leadsETo_Un leadsETo_weaken)
   3.248 +
   3.249 +
   3.250 +(*Binary union version*)
   3.251 +lemma leadsETo_Un_Un:
   3.252 +     "[| F : A leadsTo[CC] A';  F : B leadsTo[CC] B' |]  
   3.253 +      ==> F : (A Un B) leadsTo[CC] (A' Un B')"
   3.254 +by (blast intro: leadsETo_Un leadsETo_weaken_R)
   3.255 +
   3.256 +
   3.257 +(** The cancellation law **)
   3.258 +
   3.259 +lemma leadsETo_cancel2:
   3.260 +     "[| F : A leadsTo[CC] (A' Un B); F : B leadsTo[CC] B' |]  
   3.261 +      ==> F : A leadsTo[CC] (A' Un B')"
   3.262 +by (blast intro: leadsETo_Un_Un subset_imp_leadsETo leadsETo_Trans)
   3.263 +
   3.264 +lemma leadsETo_cancel1:
   3.265 +     "[| F : A leadsTo[CC] (B Un A'); F : B leadsTo[CC] B' |]  
   3.266 +    ==> F : A leadsTo[CC] (B' Un A')"
   3.267 +apply (simp add: Un_commute)
   3.268 +apply (blast intro!: leadsETo_cancel2)
   3.269 +done
   3.270 +
   3.271 +lemma leadsETo_cancel_Diff1:
   3.272 +     "[| F : A leadsTo[CC] (B Un A'); F : (B-A') leadsTo[CC] B' |]  
   3.273 +    ==> F : A leadsTo[CC] (B' Un A')"
   3.274 +apply (rule leadsETo_cancel1)
   3.275 +prefer 2 apply assumption
   3.276 +apply (simp_all (no_asm_simp))
   3.277 +done
   3.278 +
   3.279 +
   3.280 +(** The impossibility law **)
   3.281 +
   3.282 +lemma leadsETo_empty_lemma: "F : A leadsTo[CC] B ==> B={} --> A={}"
   3.283 +apply (erule leadsETo_induct)
   3.284 +apply (simp_all (no_asm_simp))
   3.285 +apply (unfold ensures_def constrains_def transient_def, blast)
   3.286 +done
   3.287 +
   3.288 +lemma leadsETo_empty: "F : A leadsTo[CC] {} ==> A={}"
   3.289 +by (blast intro!: leadsETo_empty_lemma [THEN mp])
   3.290 +
   3.291 +
   3.292 +(** PSP: Progress-Safety-Progress **)
   3.293 +
   3.294 +(*Special case of PSP: Misra's "stable conjunction"*)
   3.295 +lemma e_psp_stable: 
   3.296 +   "[| F : A leadsTo[CC] A';  F : stable B;  ALL C:CC. C Int B : CC |]  
   3.297 +    ==> F : (A Int B) leadsTo[CC] (A' Int B)"
   3.298 +apply (unfold stable_def)
   3.299 +apply (erule leadsETo_induct)
   3.300 +prefer 3 apply (blast intro: leadsETo_Union_Int)
   3.301 +prefer 2 apply (blast intro: leadsETo_Trans)
   3.302 +apply (rule leadsETo_Basis)
   3.303 +prefer 2 apply (force simp add: Diff_Int_distrib2 [symmetric])
   3.304 +apply (simp add: ensures_def Diff_Int_distrib2 [symmetric] Int_Un_distrib2 [symmetric])
   3.305 +apply (blast intro: transient_strengthen constrains_Int)
   3.306 +done
   3.307 +
   3.308 +lemma e_psp_stable2:
   3.309 +     "[| F : A leadsTo[CC] A'; F : stable B;  ALL C:CC. C Int B : CC |]  
   3.310 +      ==> F : (B Int A) leadsTo[CC] (B Int A')"
   3.311 +by (simp (no_asm_simp) add: e_psp_stable Int_ac)
   3.312 +
   3.313 +lemma e_psp:
   3.314 +     "[| F : A leadsTo[CC] A'; F : B co B';   
   3.315 +         ALL C:CC. C Int B Int B' : CC |]  
   3.316 +      ==> F : (A Int B') leadsTo[CC] ((A' Int B) Un (B' - B))"
   3.317 +apply (erule leadsETo_induct)
   3.318 +prefer 3 apply (blast intro: leadsETo_Union_Int)
   3.319 +(*Transitivity case has a delicate argument involving "cancellation"*)
   3.320 +apply (rule_tac [2] leadsETo_Un_duplicate2)
   3.321 +apply (erule_tac [2] leadsETo_cancel_Diff1)
   3.322 +prefer 2
   3.323 + apply (simp add: Int_Diff Diff_triv)
   3.324 + apply (blast intro: leadsETo_weaken_L dest: constrains_imp_subset)
   3.325 +(*Basis case*)
   3.326 +apply (rule leadsETo_Basis)
   3.327 +apply (blast intro: psp_ensures)
   3.328 +apply (subgoal_tac "A Int B' - (Ba Int B Un (B' - B)) = (A - Ba) Int B Int B'")
   3.329 +apply auto
   3.330 +done
   3.331 +
   3.332 +lemma e_psp2:
   3.333 +     "[| F : A leadsTo[CC] A'; F : B co B';   
   3.334 +         ALL C:CC. C Int B Int B' : CC |]  
   3.335 +      ==> F : (B' Int A) leadsTo[CC] ((B Int A') Un (B' - B))"
   3.336 +by (simp add: e_psp Int_ac)
   3.337 +
   3.338 +
   3.339 +(*** Special properties involving the parameter [CC] ***)
   3.340 +
   3.341 +(*??IS THIS NEEDED?? or is it just an example of what's provable??*)
   3.342 +lemma gen_leadsETo_imp_Join_leadsETo:
   3.343 +     "[| F: (A leadsTo[givenBy v] B);  G : preserves v;   
   3.344 +         F Join G : stable C |]  
   3.345 +      ==> F Join G : ((C Int A) leadsTo[(%D. C Int D) ` givenBy v] B)"
   3.346 +apply (erule leadsETo_induct)
   3.347 +  prefer 3
   3.348 +  apply (subst Int_Union) 
   3.349 +  apply (blast intro: leadsETo_UN)
   3.350 +prefer 2
   3.351 + apply (blast intro: e_psp_stable2 [THEN leadsETo_weaken_L] leadsETo_Trans)
   3.352 +apply (rule leadsETo_Basis)
   3.353 +apply (auto simp add: Diff_eq_empty_iff [THEN iffD2] Int_Diff ensures_def givenBy_eq_Collect Join_transient)
   3.354 +prefer 3 apply (blast intro: transient_strengthen)
   3.355 +apply (drule_tac [2] P1 = P in preserves_subset_stable [THEN subsetD])
   3.356 +apply (drule_tac P1 = P in preserves_subset_stable [THEN subsetD])
   3.357 +apply (unfold stable_def)
   3.358 +apply (blast intro: constrains_Int [THEN constrains_weaken])+
   3.359 +done
   3.360 +
   3.361 +(*useful??*)
   3.362 +lemma Join_leadsETo_stable_imp_leadsETo:
   3.363 +     "[| F Join G : (A leadsTo[CC] B);  ALL C:CC. G : stable C |]  
   3.364 +      ==> F: (A leadsTo[CC] B)"
   3.365 +apply (erule leadsETo_induct)
   3.366 +prefer 3 apply (blast intro: leadsETo_Union)
   3.367 +prefer 2 apply (blast intro: leadsETo_Trans)
   3.368 +apply (rule leadsETo_Basis)
   3.369 +apply (case_tac "A <= B")
   3.370 +apply (erule subset_imp_ensures)
   3.371 +apply (auto intro: constrains_weaken simp add: stable_def ensures_def Join_transient)
   3.372 +apply (erule_tac V = "?F : ?A co ?B" in thin_rl)+
   3.373 +apply (erule transientE)
   3.374 +apply (unfold constrains_def)
   3.375 +apply (blast dest!: bspec)
   3.376 +done
   3.377 +
   3.378 +(**** Relationship with traditional "leadsTo", strong & weak ****)
   3.379 +
   3.380 +(** strong **)
   3.381 +
   3.382 +lemma leadsETo_subset_leadsTo: "(A leadsTo[CC] B) <= (A leadsTo B)"
   3.383 +apply safe
   3.384 +apply (erule leadsETo_induct)
   3.385 +prefer 3 apply (blast intro: leadsTo_Union)
   3.386 +prefer 2 apply (blast intro: leadsTo_Trans, blast)
   3.387 +done
   3.388 +
   3.389 +lemma leadsETo_UNIV_eq_leadsTo: "(A leadsTo[UNIV] B) = (A leadsTo B)"
   3.390 +apply safe
   3.391 +apply (erule leadsETo_subset_leadsTo [THEN subsetD])
   3.392 +(*right-to-left case*)
   3.393 +apply (erule leadsTo_induct)
   3.394 +prefer 3 apply (blast intro: leadsETo_Union)
   3.395 +prefer 2 apply (blast intro: leadsETo_Trans, blast)
   3.396 +done
   3.397 +
   3.398 +(**** weak ****)
   3.399 +
   3.400 +lemma LeadsETo_eq_leadsETo: 
   3.401 +     "A LeadsTo[CC] B =  
   3.402 +        {F. F : (reachable F Int A) leadsTo[(%C. reachable F Int C) ` CC]  
   3.403 +        (reachable F Int B)}"
   3.404 +apply (unfold LeadsETo_def)
   3.405 +apply (blast dest: e_psp_stable2 intro: leadsETo_weaken)
   3.406 +done
   3.407 +
   3.408 +(*** Introduction rules: Basis, Trans, Union ***)
   3.409 +
   3.410 +lemma LeadsETo_Trans:
   3.411 +     "[| F : A LeadsTo[CC] B;  F : B LeadsTo[CC] C |]  
   3.412 +      ==> F : A LeadsTo[CC] C"
   3.413 +apply (simp add: LeadsETo_eq_leadsETo)
   3.414 +apply (blast intro: leadsETo_Trans)
   3.415 +done
   3.416 +
   3.417 +lemma LeadsETo_Union:
   3.418 +     "(!!A. A : S ==> F : A LeadsTo[CC] B) ==> F : (Union S) LeadsTo[CC] B"
   3.419 +apply (simp add: LeadsETo_def)
   3.420 +apply (subst Int_Union)
   3.421 +apply (blast intro: leadsETo_UN)
   3.422 +done
   3.423 +
   3.424 +lemma LeadsETo_UN:
   3.425 +     "(!!i. i : I ==> F : (A i) LeadsTo[CC] B)  
   3.426 +      ==> F : (UN i:I. A i) LeadsTo[CC] B"
   3.427 +apply (simp only: Union_image_eq [symmetric])
   3.428 +apply (blast intro: LeadsETo_Union)
   3.429 +done
   3.430 +
   3.431 +(*Binary union introduction rule*)
   3.432 +lemma LeadsETo_Un:
   3.433 +     "[| F : A LeadsTo[CC] C; F : B LeadsTo[CC] C |]  
   3.434 +      ==> F : (A Un B) LeadsTo[CC] C"
   3.435 +apply (subst Un_eq_Union)
   3.436 +apply (blast intro: LeadsETo_Union)
   3.437 +done
   3.438 +
   3.439 +(*Lets us look at the starting state*)
   3.440 +lemma single_LeadsETo_I:
   3.441 +     "(!!s. s : A ==> F : {s} LeadsTo[CC] B) ==> F : A LeadsTo[CC] B"
   3.442 +apply (subst UN_singleton [symmetric], rule LeadsETo_UN, blast)
   3.443 +done
   3.444 +
   3.445 +lemma subset_imp_LeadsETo:
   3.446 +     "A <= B ==> F : A LeadsTo[CC] B"
   3.447 +apply (simp (no_asm) add: LeadsETo_def)
   3.448 +apply (blast intro: subset_imp_leadsETo)
   3.449 +done
   3.450 +
   3.451 +lemmas empty_LeadsETo = empty_subsetI [THEN subset_imp_LeadsETo, standard]
   3.452 +
   3.453 +lemma LeadsETo_weaken_R [rule_format (no_asm)]:
   3.454 +     "[| F : A LeadsTo[CC] A';  A' <= B' |] ==> F : A LeadsTo[CC] B'"
   3.455 +apply (simp (no_asm_use) add: LeadsETo_def)
   3.456 +apply (blast intro: leadsETo_weaken_R)
   3.457 +done
   3.458 +
   3.459 +lemma LeadsETo_weaken_L [rule_format (no_asm)]:
   3.460 +     "[| F : A LeadsTo[CC] A';  B <= A |] ==> F : B LeadsTo[CC] A'"
   3.461 +apply (simp (no_asm_use) add: LeadsETo_def)
   3.462 +apply (blast intro: leadsETo_weaken_L)
   3.463 +done
   3.464 +
   3.465 +lemma LeadsETo_weaken:
   3.466 +     "[| F : A LeadsTo[CC'] A';    
   3.467 +         B <= A;  A' <= B';  CC' <= CC |]  
   3.468 +      ==> F : B LeadsTo[CC] B'"
   3.469 +apply (simp (no_asm_use) add: LeadsETo_def)
   3.470 +apply (blast intro: leadsETo_weaken)
   3.471 +done
   3.472 +
   3.473 +lemma LeadsETo_subset_LeadsTo: "(A LeadsTo[CC] B) <= (A LeadsTo B)"
   3.474 +apply (unfold LeadsETo_def LeadsTo_def)
   3.475 +apply (blast intro: leadsETo_subset_leadsTo [THEN subsetD])
   3.476 +done
   3.477 +
   3.478 +(*Postcondition can be strengthened to (reachable F Int B) *)
   3.479 +lemma reachable_ensures:
   3.480 +     "F : A ensures B ==> F : (reachable F Int A) ensures B"
   3.481 +apply (rule stable_ensures_Int [THEN ensures_weaken_R], auto)
   3.482 +done
   3.483 +
   3.484 +lemma lel_lemma:
   3.485 +     "F : A leadsTo B ==> F : (reachable F Int A) leadsTo[Pow(reachable F)] B"
   3.486 +apply (erule leadsTo_induct)
   3.487 +  apply (blast intro: reachable_ensures leadsETo_Basis)
   3.488 + apply (blast dest: e_psp_stable2 intro: leadsETo_Trans leadsETo_weaken_L)
   3.489 +apply (subst Int_Union)
   3.490 +apply (blast intro: leadsETo_UN)
   3.491 +done
   3.492 +
   3.493 +lemma LeadsETo_UNIV_eq_LeadsTo: "(A LeadsTo[UNIV] B) = (A LeadsTo B)"
   3.494 +apply safe
   3.495 +apply (erule LeadsETo_subset_LeadsTo [THEN subsetD])
   3.496 +(*right-to-left case*)
   3.497 +apply (unfold LeadsETo_def LeadsTo_def)
   3.498 +apply (fast elim: lel_lemma [THEN leadsETo_weaken])
   3.499 +done
   3.500 +
   3.501 +
   3.502 +(**** EXTEND/PROJECT PROPERTIES ****)
   3.503 +
   3.504 +lemma (in Extend) givenBy_o_eq_extend_set: "givenBy (v o f) = extend_set h ` (givenBy v)"
   3.505 +apply (simp (no_asm) add: givenBy_eq_Collect)
   3.506 +apply best 
   3.507 +done
   3.508 +
   3.509 +lemma (in Extend) givenBy_eq_extend_set: "givenBy f = range (extend_set h)"
   3.510 +apply (simp (no_asm) add: givenBy_eq_Collect)
   3.511 +apply best
   3.512 +done
   3.513 +
   3.514 +lemma (in Extend) extend_set_givenBy_I:
   3.515 +     "D : givenBy v ==> extend_set h D : givenBy (v o f)"
   3.516 +apply (simp (no_asm_use) add: givenBy_eq_all)
   3.517 +apply blast
   3.518 +done
   3.519 +
   3.520 +lemma (in Extend) leadsETo_imp_extend_leadsETo:
   3.521 +     "F : A leadsTo[CC] B  
   3.522 +      ==> extend h F : (extend_set h A) leadsTo[extend_set h ` CC]  
   3.523 +                       (extend_set h B)"
   3.524 +apply (erule leadsETo_induct)
   3.525 +  apply (force intro: leadsETo_Basis subset_imp_ensures 
   3.526 +               simp add: extend_ensures extend_set_Diff_distrib [symmetric])
   3.527 + apply (blast intro: leadsETo_Trans)
   3.528 +apply (simp add: leadsETo_UN extend_set_Union)
   3.529 +done
   3.530 +
   3.531 +
   3.532 +
   3.533 +(*NOT USED, but analogous to preserves_project_transient_empty in Project.ML*)
   3.534 +lemma (in Extend) 
   3.535 +     "[| G : preserves (v o f);  project h C G : transient D;   
   3.536 +         D : givenBy v |] ==> D={}"
   3.537 +apply (rule stable_transient_empty)
   3.538 + prefer 2 apply assumption
   3.539 +(*If addIs then PROOF FAILED at depth 2*)
   3.540 +apply (blast intro!: preserves_givenBy_imp_stable project_preserves_I)
   3.541 +done
   3.542 +
   3.543 +
   3.544 +(*This version's stronger in the "ensures" precondition
   3.545 +  BUT there's no ensures_weaken_L*)
   3.546 +lemma (in Extend) Join_project_ensures_strong:
   3.547 +     "[| project h C G ~: transient (project_set h C Int (A-B)) |  
   3.548 +           project_set h C Int (A - B) = {};   
   3.549 +         extend h F Join G : stable C;   
   3.550 +         F Join project h C G : (project_set h C Int A) ensures B |]  
   3.551 +      ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)"
   3.552 +apply (subst Int_extend_set_lemma [symmetric])
   3.553 +apply (rule Join_project_ensures)
   3.554 +apply (auto simp add: Int_Diff)
   3.555 +done
   3.556 +
   3.557 +(*Generalizes preserves_project_transient_empty*)
   3.558 +lemma (in Extend) preserves_o_project_transient_empty:
   3.559 +     "[| G : preserves (v o f);   
   3.560 +         project h C G : transient (C' Int D);   
   3.561 +         project h C G : stable C';  D : givenBy v |]     
   3.562 +      ==> C' Int D = {}"
   3.563 +apply (rule stable_transient_empty)
   3.564 +prefer 2 apply assumption
   3.565 +(*Fragile proof.  Was just a single blast call.
   3.566 +  If just "intro" then PROOF FAILED at depth 3*)
   3.567 +apply (rule stable_Int) 
   3.568 + apply (blast intro!: preserves_givenBy_imp_stable project_preserves_I)+
   3.569 +done
   3.570 +
   3.571 +lemma (in Extend) pld_lemma:
   3.572 +     "[| extend h F Join G : stable C;   
   3.573 +         F Join project h C G : (project_set h C Int A) leadsTo[(%D. project_set h C Int D)`givenBy v] B;   
   3.574 +         G : preserves (v o f) |]  
   3.575 +      ==> extend h F Join G :  
   3.576 +            (C Int extend_set h (project_set h C Int A))  
   3.577 +            leadsTo[(%D. C Int extend_set h D)`givenBy v]  (extend_set h B)"
   3.578 +apply (erule leadsETo_induct)
   3.579 +  prefer 3
   3.580 +  apply (simp del: UN_simps add: Int_UN_distrib leadsETo_UN extend_set_Union)
   3.581 + prefer 2
   3.582 + apply (blast intro: e_psp_stable2 [THEN leadsETo_weaken_L] leadsETo_Trans)
   3.583 +txt{*Base case is hard*}
   3.584 +apply auto
   3.585 +apply (force intro: leadsETo_Basis subset_imp_ensures)
   3.586 +apply (rule leadsETo_Basis)
   3.587 + prefer 2
   3.588 + apply (simp add: Int_Diff Int_extend_set_lemma extend_set_Diff_distrib [symmetric])
   3.589 +apply (rule Join_project_ensures_strong)
   3.590 +apply (auto dest: preserves_o_project_transient_empty intro: project_stable_project_set simp add: Int_left_absorb)
   3.591 +apply (simp (no_asm_simp) add: stable_ensures_Int [THEN ensures_weaken_R] Int_lower2 project_stable_project_set extend_stable_project_set)
   3.592 +done
   3.593 +
   3.594 +lemma (in Extend) project_leadsETo_D_lemma:
   3.595 +     "[| extend h F Join G : stable C;   
   3.596 +         F Join project h C G :  
   3.597 +             (project_set h C Int A)  
   3.598 +             leadsTo[(%D. project_set h C Int D)`givenBy v] B;   
   3.599 +         G : preserves (v o f) |]  
   3.600 +      ==> extend h F Join G : (C Int extend_set h A)  
   3.601 +            leadsTo[(%D. C Int extend_set h D)`givenBy v] (extend_set h B)"
   3.602 +apply (rule pld_lemma [THEN leadsETo_weaken])
   3.603 +apply (auto simp add: split_extended_all)
   3.604 +done
   3.605 +
   3.606 +lemma (in Extend) project_leadsETo_D:
   3.607 +     "[| F Join project h UNIV G : A leadsTo[givenBy v] B;   
   3.608 +         G : preserves (v o f) |]   
   3.609 +      ==> extend h F Join G : (extend_set h A)  
   3.610 +            leadsTo[givenBy (v o f)] (extend_set h B)"
   3.611 +apply (cut_tac project_leadsETo_D_lemma [of _ _ UNIV], auto) 
   3.612 +apply (erule leadsETo_givenBy)
   3.613 +apply (rule givenBy_o_eq_extend_set [THEN equalityD2])
   3.614 +done
   3.615 +
   3.616 +lemma (in Extend) project_LeadsETo_D:
   3.617 +     "[| F Join project h (reachable (extend h F Join G)) G  
   3.618 +             : A LeadsTo[givenBy v] B;   
   3.619 +         G : preserves (v o f) |]  
   3.620 +      ==> extend h F Join G :  
   3.621 +            (extend_set h A) LeadsTo[givenBy (v o f)] (extend_set h B)"
   3.622 +apply (cut_tac subset_refl [THEN stable_reachable, THEN project_leadsETo_D_lemma])
   3.623 +apply (auto simp add: LeadsETo_def)
   3.624 + apply (erule leadsETo_mono [THEN [2] rev_subsetD])
   3.625 + apply (blast intro: extend_set_givenBy_I)
   3.626 +apply (simp add: project_set_reachable_extend_eq [symmetric])
   3.627 +done
   3.628 +
   3.629 +lemma (in Extend) extending_leadsETo: 
   3.630 +     "(ALL G. extend h F ok G --> G : preserves (v o f))  
   3.631 +      ==> extending (%G. UNIV) h F  
   3.632 +                (extend_set h A leadsTo[givenBy (v o f)] extend_set h B)  
   3.633 +                (A leadsTo[givenBy v] B)"
   3.634 +apply (unfold extending_def)
   3.635 +apply (auto simp add: project_leadsETo_D)
   3.636 +done
   3.637 +
   3.638 +lemma (in Extend) extending_LeadsETo: 
   3.639 +     "(ALL G. extend h F ok G --> G : preserves (v o f))  
   3.640 +      ==> extending (%G. reachable (extend h F Join G)) h F  
   3.641 +                (extend_set h A LeadsTo[givenBy (v o f)] extend_set h B)  
   3.642 +                (A LeadsTo[givenBy v]  B)"
   3.643 +apply (unfold extending_def)
   3.644 +apply (blast intro: project_LeadsETo_D)
   3.645 +done
   3.646 +
   3.647 +
   3.648 +(*** leadsETo in the precondition ***)
   3.649 +
   3.650 +(*Lemma for the Trans case*)
   3.651 +lemma (in Extend) pli_lemma:
   3.652 +     "[| extend h F Join G : stable C;     
   3.653 +         F Join project h C G     
   3.654 +           : project_set h C Int project_set h A leadsTo project_set h B |]  
   3.655 +      ==> F Join project h C G     
   3.656 +            : project_set h C Int project_set h A leadsTo     
   3.657 +              project_set h C Int project_set h B"
   3.658 +apply (rule psp_stable2 [THEN leadsTo_weaken_L])
   3.659 +apply (auto simp add: project_stable_project_set extend_stable_project_set)
   3.660 +done
   3.661 +
   3.662 +lemma (in Extend) project_leadsETo_I_lemma:
   3.663 +     "[| extend h F Join G : stable C;   
   3.664 +         extend h F Join G :  
   3.665 +           (C Int A) leadsTo[(%D. C Int D)`givenBy f]  B |]   
   3.666 +  ==> F Join project h C G   
   3.667 +    : (project_set h C Int project_set h (C Int A)) leadsTo (project_set h B)"
   3.668 +apply (erule leadsETo_induct)
   3.669 +  prefer 3
   3.670 +  apply (simp only: Int_UN_distrib project_set_Union)
   3.671 +  apply (blast intro: leadsTo_UN)
   3.672 + prefer 2 apply (blast intro: leadsTo_Trans pli_lemma)
   3.673 +apply (simp add: givenBy_eq_extend_set)
   3.674 +apply (rule leadsTo_Basis)
   3.675 +apply (blast intro: ensures_extend_set_imp_project_ensures)
   3.676 +done
   3.677 +
   3.678 +lemma (in Extend) project_leadsETo_I:
   3.679 +     "extend h F Join G : (extend_set h A) leadsTo[givenBy f] (extend_set h B)
   3.680 +      ==> F Join project h UNIV G : A leadsTo B"
   3.681 +apply (rule project_leadsETo_I_lemma [THEN leadsTo_weaken], auto)
   3.682 +done
   3.683 +
   3.684 +lemma (in Extend) project_LeadsETo_I:
   3.685 +     "extend h F Join G : (extend_set h A) LeadsTo[givenBy f] (extend_set h B) 
   3.686 +      ==> F Join project h (reachable (extend h F Join G)) G   
   3.687 +           : A LeadsTo B"
   3.688 +apply (simp (no_asm_use) add: LeadsTo_def LeadsETo_def)
   3.689 +apply (rule project_leadsETo_I_lemma [THEN leadsTo_weaken])
   3.690 +apply (auto simp add: project_set_reachable_extend_eq [symmetric])
   3.691 +done
   3.692 +
   3.693 +lemma (in Extend) projecting_leadsTo: 
   3.694 +     "projecting (%G. UNIV) h F  
   3.695 +                 (extend_set h A leadsTo[givenBy f] extend_set h B)  
   3.696 +                 (A leadsTo B)"
   3.697 +apply (unfold projecting_def)
   3.698 +apply (force dest: project_leadsETo_I)
   3.699 +done
   3.700 +
   3.701 +lemma (in Extend) projecting_LeadsTo: 
   3.702 +     "projecting (%G. reachable (extend h F Join G)) h F  
   3.703 +                 (extend_set h A LeadsTo[givenBy f] extend_set h B)  
   3.704 +                 (A LeadsTo B)"
   3.705 +apply (unfold projecting_def)
   3.706 +apply (force dest: project_LeadsETo_I)
   3.707 +done
   3.708 +
   3.709  end
     4.1 --- a/src/HOL/UNITY/Extend.ML	Tue Jan 28 22:53:39 2003 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,795 +0,0 @@
     4.4 -(*  Title:      HOL/UNITY/Extend.ML
     4.5 -    ID:         $Id$
     4.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4.7 -    Copyright   1999  University of Cambridge
     4.8 -
     4.9 -Extending of state sets
    4.10 -  function f (forget)    maps the extended state to the original state
    4.11 -  function g (forgotten) maps the extended state to the "extending part"
    4.12 -*)
    4.13 -
    4.14 -(** These we prove OUTSIDE the locale. **)
    4.15 -
    4.16 -
    4.17 -(*** Restrict [MOVE to Relation.thy?] ***)
    4.18 -
    4.19 -Goalw [Restrict_def] "((x,y): Restrict A r) = ((x,y): r & x: A)";
    4.20 -by (Blast_tac 1);
    4.21 -qed "Restrict_iff";
    4.22 -AddIffs [Restrict_iff];
    4.23 -
    4.24 -Goal "Restrict UNIV = id";
    4.25 -by (rtac ext 1);
    4.26 -by (auto_tac (claset(), simpset() addsimps [Restrict_def]));
    4.27 -qed "Restrict_UNIV";
    4.28 -Addsimps [Restrict_UNIV];
    4.29 -
    4.30 -Goal "Restrict {} r = {}";
    4.31 -by (auto_tac (claset(), simpset() addsimps [Restrict_def]));
    4.32 -qed "Restrict_empty";
    4.33 -Addsimps [Restrict_empty];
    4.34 -
    4.35 -Goalw [Restrict_def] "Restrict A (Restrict B r) = Restrict (A Int B) r";
    4.36 -by (Blast_tac 1);
    4.37 -qed "Restrict_Int";
    4.38 -Addsimps [Restrict_Int];
    4.39 -
    4.40 -Goalw [Restrict_def] "Domain r <= A ==> Restrict A r = r";
    4.41 -by Auto_tac;
    4.42 -qed "Restrict_triv";
    4.43 -
    4.44 -Goalw [Restrict_def] "Restrict A r <= r";
    4.45 -by Auto_tac;
    4.46 -qed "Restrict_subset";
    4.47 -
    4.48 -Goalw [Restrict_def]
    4.49 -     "[| A <= B;  Restrict B r = Restrict B s |] \
    4.50 -\     ==> Restrict A r = Restrict A s";
    4.51 -by (Blast_tac 1);
    4.52 -qed "Restrict_eq_mono";
    4.53 -
    4.54 -Goalw [Restrict_def, image_def]
    4.55 -     "[| s : RR;  Restrict A r = Restrict A s |] \
    4.56 -\     ==> Restrict A r : Restrict A ` RR";
    4.57 -by Auto_tac;
    4.58 -qed "Restrict_imageI";
    4.59 -
    4.60 -Goal "Domain (Restrict A r) = A Int Domain r";
    4.61 -by (Blast_tac 1);
    4.62 -qed "Domain_Restrict";
    4.63 -
    4.64 -Goal "(Restrict A r) `` B = r `` (A Int B)";
    4.65 -by (Blast_tac 1);
    4.66 -qed "Image_Restrict";
    4.67 -
    4.68 -Addsimps [Domain_Restrict, Image_Restrict];
    4.69 -
    4.70 -
    4.71 -Goal "f Id = Id ==> insert Id (f`Acts F) = f ` Acts F";
    4.72 -by (blast_tac (claset() addIs [sym RS image_eqI]) 1);
    4.73 -qed "insert_Id_image_Acts";
    4.74 -
    4.75 -(*Possibly easier than reasoning about "inv h"*)
    4.76 -val [surj_h,prem] = 
    4.77 -Goalw [good_map_def]
    4.78 -     "[| surj h; !! x x' y y'. h(x,y) = h(x',y') ==> x=x' |] ==> good_map h";
    4.79 -by (safe_tac (claset() addSIs [surj_h]));
    4.80 -by (rtac prem 1);
    4.81 -by (stac (surjective_pairing RS sym) 1);
    4.82 -by (stac (surj_h RS surj_f_inv_f) 1);
    4.83 -by (rtac refl 1);
    4.84 -qed "good_mapI";
    4.85 -
    4.86 -Goalw [good_map_def] "good_map h ==> surj h";
    4.87 -by Auto_tac;
    4.88 -qed "good_map_is_surj";
    4.89 -
    4.90 -(*A convenient way of finding a closed form for inv h*)
    4.91 -val [surj,prem] = Goalw [inv_def]
    4.92 -     "[| surj h;  !! x y. g (h(x,y)) = x |] ==> fst (inv h z) = g z";
    4.93 -by (res_inst_tac [("y1", "z")] (surj RS surjD RS exE) 1);
    4.94 -by (rtac someI2 1);
    4.95 -by (dres_inst_tac [("f", "g")] arg_cong 2);
    4.96 -by (auto_tac (claset(), simpset() addsimps [prem]));
    4.97 -qed "fst_inv_equalityI";
    4.98 -
    4.99 -
   4.100 -Open_locale "Extend";
   4.101 -
   4.102 -val slice_def = thm "slice_def";
   4.103 -
   4.104 -(*** Trivial properties of f, g, h ***)
   4.105 -
   4.106 -val good_h = rewrite_rule [good_map_def] (thm "good_h");
   4.107 -val surj_h = good_h RS conjunct1;
   4.108 -
   4.109 -val f_def = thm "f_def";
   4.110 -val g_def = thm "g_def";
   4.111 -
   4.112 -Goal "f(h(x,y)) = x";
   4.113 -by (simp_tac (simpset() addsimps [f_def, good_h RS conjunct2]) 1);
   4.114 -qed "f_h_eq";
   4.115 -Addsimps [f_h_eq];
   4.116 -
   4.117 -Goal "h(x,y) = h(x',y') ==> x=x'";
   4.118 -by (dres_inst_tac [("f", "fst o inv h")] arg_cong 1);
   4.119 -(*FIXME: If locales worked properly we could put just "f" above*)
   4.120 -by (full_simp_tac (simpset() addsimps [f_def, good_h RS conjunct2]) 1);
   4.121 -qed "h_inject1";
   4.122 -AddDs [h_inject1];
   4.123 -
   4.124 -Goal "h(f z, g z) = z";
   4.125 -by (simp_tac (simpset() addsimps [f_def, g_def, surj_h RS surj_f_inv_f]) 1);
   4.126 -qed "h_f_g_eq";
   4.127 -
   4.128 -
   4.129 -(** A sequence of proof steps borrowed from Provers/split_paired_all.ML **)
   4.130 -
   4.131 -val cT = TFree ("'c", HOLogic.typeS);
   4.132 -
   4.133 -(* "PROP P x == PROP P (h (f x, g x))" *)
   4.134 -val lemma1 = Thm.combination
   4.135 -  (Thm.reflexive (cterm_of (sign_of thy) (Free ("P", cT --> propT))))
   4.136 -  (Drule.unvarify (h_f_g_eq RS sym RS eq_reflection));
   4.137 -
   4.138 -val prems = Goalw [lemma1] "(!!u y. PROP P (h (u, y))) ==> PROP P x";
   4.139 -by (resolve_tac prems 1);
   4.140 -val lemma2 = result();
   4.141 -
   4.142 -val prems = Goal "(!!u y. PROP P (h (u, y))) ==> (!!z. PROP P z)";
   4.143 -by (rtac lemma2 1);
   4.144 -by (resolve_tac prems 1);
   4.145 -val lemma3 = result();
   4.146 -
   4.147 -val prems = Goal "(!!z. PROP P z) ==> (!!u y. PROP P (h (u, y)))";
   4.148 -(*not needed for proof, but prevents generalization over h, 'c, etc.*)
   4.149 -by (cut_facts_tac [surj_h] 1);
   4.150 -by (resolve_tac prems 1);
   4.151 -val lemma4 = result();
   4.152 -
   4.153 -val split_extended_all = Thm.equal_intr lemma4 lemma3;
   4.154 -
   4.155 -
   4.156 -(*** extend_set: basic properties ***)
   4.157 -
   4.158 -Goal "(x : project_set h C) = (EX y. h(x,y) : C)";
   4.159 -by (simp_tac (simpset() addsimps [project_set_def]) 1);
   4.160 -qed "project_set_iff";
   4.161 -
   4.162 -AddIffs [project_set_iff];
   4.163 -
   4.164 -Goalw [extend_set_def] "A<=B ==> extend_set h A <= extend_set h B";
   4.165 -by (Blast_tac 1);
   4.166 -qed "extend_set_mono";
   4.167 -
   4.168 -Goalw [extend_set_def] "z : extend_set h A = (f z : A)";
   4.169 -by (force_tac (claset() addIs  [h_f_g_eq RS sym], simpset()) 1);
   4.170 -qed "mem_extend_set_iff";
   4.171 -
   4.172 -AddIffs [mem_extend_set_iff];
   4.173 -
   4.174 -Goalw [extend_set_def] "(extend_set h A <= extend_set h B) = (A <= B)";
   4.175 -by (Force_tac 1);
   4.176 -qed "extend_set_strict_mono";
   4.177 -AddIffs [extend_set_strict_mono];
   4.178 -
   4.179 -Goalw [extend_set_def] "extend_set h {} = {}";
   4.180 -by Auto_tac;
   4.181 -qed "extend_set_empty";
   4.182 -Addsimps [extend_set_empty];
   4.183 -
   4.184 -Goal "extend_set h {s. P s} = {s. P (f s)}";
   4.185 -by Auto_tac;
   4.186 -qed "extend_set_eq_Collect";
   4.187 -
   4.188 -Goal "extend_set h {x} = {s. f s = x}";
   4.189 -by Auto_tac;
   4.190 -qed "extend_set_sing";
   4.191 -
   4.192 -Goalw [extend_set_def] "project_set h (extend_set h C) = C";
   4.193 -by Auto_tac;
   4.194 -qed "extend_set_inverse";
   4.195 -Addsimps [extend_set_inverse];
   4.196 -
   4.197 -Goalw [extend_set_def] "C <= extend_set h (project_set h C)";
   4.198 -by (auto_tac (claset(), 
   4.199 -	      simpset() addsimps [split_extended_all]));
   4.200 -by (Blast_tac 1);
   4.201 -qed "extend_set_project_set";
   4.202 -
   4.203 -Goal "inj (extend_set h)";
   4.204 -by (rtac inj_on_inverseI 1);
   4.205 -by (rtac extend_set_inverse 1);
   4.206 -qed "inj_extend_set";
   4.207 -
   4.208 -Goalw [extend_set_def] "extend_set h UNIV = UNIV";
   4.209 -by (auto_tac (claset(), 
   4.210 -	      simpset() addsimps [split_extended_all]));
   4.211 -qed "extend_set_UNIV_eq";
   4.212 -Addsimps [standard extend_set_UNIV_eq];
   4.213 -
   4.214 -(*** project_set: basic properties ***)
   4.215 -
   4.216 -(*project_set is simply image!*)
   4.217 -Goal "project_set h C = f ` C";
   4.218 -by (auto_tac (claset() addIs [f_h_eq RS sym], 
   4.219 -	      simpset() addsimps [split_extended_all]));
   4.220 -qed "project_set_eq";
   4.221 -
   4.222 -(*Converse appears to fail*)
   4.223 -Goal "!!z. z : C ==> f z : project_set h C";
   4.224 -by (auto_tac (claset(), 
   4.225 -	      simpset() addsimps [split_extended_all]));
   4.226 -qed "project_set_I";
   4.227 -
   4.228 -
   4.229 -(*** More laws ***)
   4.230 -
   4.231 -(*Because A and B could differ on the "other" part of the state, 
   4.232 -   cannot generalize to 
   4.233 -      project_set h (A Int B) = project_set h A Int project_set h B
   4.234 -*)
   4.235 -Goal "project_set h ((extend_set h A) Int B) = A Int (project_set h B)";
   4.236 -by Auto_tac;
   4.237 -qed "project_set_extend_set_Int";
   4.238 -
   4.239 -(*Unused, but interesting?*)
   4.240 -Goal "project_set h ((extend_set h A) Un B) = A Un (project_set h B)";
   4.241 -by Auto_tac;
   4.242 -qed "project_set_extend_set_Un";
   4.243 -
   4.244 -Goal "project_set h (A Int B) <= (project_set h A) Int (project_set h B)";
   4.245 -by Auto_tac;
   4.246 -qed "project_set_Int_subset";
   4.247 -
   4.248 -Goal "extend_set h (A Un B) = extend_set h A Un extend_set h B";
   4.249 -by Auto_tac;
   4.250 -qed "extend_set_Un_distrib";
   4.251 -
   4.252 -Goal "extend_set h (A Int B) = extend_set h A Int extend_set h B";
   4.253 -by Auto_tac;
   4.254 -qed "extend_set_Int_distrib";
   4.255 -
   4.256 -Goal "extend_set h (INTER A B) = (INT x:A. extend_set h (B x))";
   4.257 -by Auto_tac;
   4.258 -qed "extend_set_INT_distrib";
   4.259 -
   4.260 -Goal "extend_set h (A - B) = extend_set h A - extend_set h B";
   4.261 -by Auto_tac;
   4.262 -qed "extend_set_Diff_distrib";
   4.263 -
   4.264 -Goal "extend_set h (Union A) = (UN X:A. extend_set h X)";
   4.265 -by (Blast_tac 1);
   4.266 -qed "extend_set_Union";
   4.267 -
   4.268 -Goalw [extend_set_def] "(extend_set h A <= - extend_set h B) = (A <= - B)";
   4.269 -by Auto_tac;
   4.270 -qed "extend_set_subset_Compl_eq";
   4.271 -
   4.272 -
   4.273 -(*** extend_act ***)
   4.274 -
   4.275 -(*Can't strengthen it to
   4.276 -  ((h(s,y), h(s',y')) : extend_act h act) = ((s, s') : act & y=y')
   4.277 -  because h doesn't have to be injective in the 2nd argument*)
   4.278 -Goalw [extend_act_def]
   4.279 -     "((h(s,y), h(s',y)) : extend_act h act) = ((s, s') : act)";
   4.280 -by Auto_tac;
   4.281 -qed "mem_extend_act_iff";
   4.282 -AddIffs [mem_extend_act_iff]; 
   4.283 -
   4.284 -(*Converse fails: (z,z') would include actions that changed the g-part*)
   4.285 -Goalw [extend_act_def]
   4.286 -     "(z, z') : extend_act h act ==> (f z, f z') : act";
   4.287 -by Auto_tac;
   4.288 -qed "extend_act_D";
   4.289 -
   4.290 -Goalw [extend_act_def, project_act_def]
   4.291 -     "project_act h (extend_act h act) = act";
   4.292 -by (Blast_tac 1);
   4.293 -qed "extend_act_inverse";
   4.294 -Addsimps [extend_act_inverse];
   4.295 -
   4.296 -Goalw [extend_act_def, project_act_def]
   4.297 -     "project_act h (Restrict C (extend_act h act)) = \
   4.298 -\     Restrict (project_set h C) act";
   4.299 -by (Blast_tac 1);
   4.300 -qed "project_act_extend_act_restrict";
   4.301 -Addsimps [project_act_extend_act_restrict];
   4.302 -
   4.303 -Goalw [extend_act_def, project_act_def]
   4.304 -     "act' <= extend_act h act ==> project_act h act' <= act";
   4.305 -by (Force_tac 1);
   4.306 -qed "subset_extend_act_D";
   4.307 -
   4.308 -Goal "inj (extend_act h)";
   4.309 -by (rtac inj_on_inverseI 1);
   4.310 -by (rtac extend_act_inverse 1);
   4.311 -qed "inj_extend_act";
   4.312 -
   4.313 -Goalw [extend_set_def, extend_act_def]
   4.314 -     "extend_act h act `` (extend_set h A) = extend_set h (act `` A)";
   4.315 -by (Force_tac 1);
   4.316 -qed "extend_act_Image";
   4.317 -Addsimps [extend_act_Image];
   4.318 -
   4.319 -Goalw [extend_act_def] "(extend_act h act' <= extend_act h act) = (act'<=act)";
   4.320 -by Auto_tac;
   4.321 -qed "extend_act_strict_mono";
   4.322 -
   4.323 -AddIffs [extend_act_strict_mono, inj_extend_act RS inj_eq];
   4.324 -(*The latter theorem is  (extend_act h act' = extend_act h act) = (act'=act) *)
   4.325 -
   4.326 -Goalw [extend_set_def, extend_act_def]
   4.327 -    "Domain (extend_act h act) = extend_set h (Domain act)";
   4.328 -by (Force_tac 1);
   4.329 -qed "Domain_extend_act"; 
   4.330 -
   4.331 -Goalw [extend_act_def]
   4.332 -    "extend_act h Id = Id";
   4.333 -by (force_tac (claset() addIs  [h_f_g_eq RS sym], simpset()) 1);
   4.334 -qed "extend_act_Id";
   4.335 -
   4.336 -Goalw [project_act_def]
   4.337 -     "!!z z'. (z, z') : act ==> (f z, f z') : project_act h act";
   4.338 -by (force_tac (claset(), 
   4.339 -              simpset() addsimps [split_extended_all]) 1);
   4.340 -qed "project_act_I";
   4.341 -
   4.342 -Goalw [project_act_def] "project_act h Id = Id";
   4.343 -by (Force_tac 1);
   4.344 -qed "project_act_Id";
   4.345 -
   4.346 -Goalw [project_act_def]
   4.347 -  "Domain (project_act h act) = project_set h (Domain act)";
   4.348 -by (force_tac (claset(), 
   4.349 -              simpset() addsimps [split_extended_all]) 1);
   4.350 -qed "Domain_project_act";
   4.351 -
   4.352 -Addsimps [extend_act_Id, project_act_Id];
   4.353 -
   4.354 -
   4.355 -(**** extend ****)
   4.356 -
   4.357 -(*** Basic properties ***)
   4.358 -
   4.359 -Goalw [extend_def] "Init (extend h F) = extend_set h (Init F)";
   4.360 -by Auto_tac;
   4.361 -qed "Init_extend";
   4.362 -Addsimps [Init_extend];
   4.363 -
   4.364 -Goalw [project_def] "Init (project h C F) = project_set h (Init F)";
   4.365 -by Auto_tac;
   4.366 -qed "Init_project";
   4.367 -Addsimps [Init_project];
   4.368 -
   4.369 -Goal "Acts (extend h F) = (extend_act h ` Acts F)";
   4.370 -by (simp_tac (simpset() addsimps [extend_def, insert_Id_image_Acts]) 1);
   4.371 -qed "Acts_extend";
   4.372 -Addsimps [Acts_extend];
   4.373 -
   4.374 -Goal "AllowedActs (extend h F) = project_act h -` AllowedActs F";
   4.375 -by (simp_tac (simpset() addsimps [extend_def, insert_absorb]) 1);
   4.376 -qed "AllowedActs_extend";
   4.377 -Addsimps [AllowedActs_extend];
   4.378 -
   4.379 -Goal "Acts(project h C F) = insert Id (project_act h ` Restrict C ` Acts F)";
   4.380 -by (auto_tac (claset(), 
   4.381 -	      simpset() addsimps [project_def, image_iff]));
   4.382 -qed "Acts_project";
   4.383 -Addsimps [Acts_project];
   4.384 -
   4.385 -Goal "AllowedActs(project h C F) = \
   4.386 -\       {act. Restrict (project_set h C) act \
   4.387 -\              : project_act h ` Restrict C ` AllowedActs F}";
   4.388 -by (simp_tac (simpset() addsimps [project_def, image_iff]) 1);
   4.389 -by (stac insert_absorb 1);
   4.390 -by (auto_tac (claset() addSIs [inst "x" "Id" bexI], 
   4.391 -                 simpset() addsimps [project_act_def]));  
   4.392 -qed "AllowedActs_project";
   4.393 -Addsimps [AllowedActs_project];
   4.394 -
   4.395 -Goal "Allowed (extend h F) = project h UNIV -` Allowed F";
   4.396 -by (simp_tac (simpset() addsimps [AllowedActs_extend, Allowed_def]) 1);
   4.397 -by (Blast_tac 1); 
   4.398 -qed "Allowed_extend";
   4.399 -
   4.400 -Goalw [SKIP_def] "extend h SKIP = SKIP";
   4.401 -by (rtac program_equalityI 1);
   4.402 -by Auto_tac;
   4.403 -qed "extend_SKIP";
   4.404 -Addsimps [export extend_SKIP];
   4.405 -
   4.406 -Goal "project_set h UNIV = UNIV";
   4.407 -by Auto_tac;
   4.408 -qed "project_set_UNIV";
   4.409 -Addsimps [project_set_UNIV];
   4.410 -
   4.411 -Goal "project_set h (Union A) = (UN X:A. project_set h X)";
   4.412 -by (Blast_tac 1);
   4.413 -qed "project_set_Union";
   4.414 -
   4.415 -(*Converse FAILS: the extended state contributing to project_set h C
   4.416 -  may not coincide with the one contributing to project_act h act*)
   4.417 -Goal "project_act h (Restrict C act) <= \
   4.418 -\     Restrict (project_set h C) (project_act h act)";
   4.419 -by (auto_tac (claset(), simpset() addsimps [project_act_def]));  
   4.420 -qed "project_act_Restrict_subset";
   4.421 -
   4.422 -
   4.423 -Goal "project_act h (Restrict C Id) = Restrict (project_set h C) Id";
   4.424 -by (auto_tac (claset(), simpset() addsimps [project_act_def]));  
   4.425 -qed "project_act_Restrict_Id_eq";
   4.426 -
   4.427 -Goal "project h C (extend h F) = \
   4.428 -\     mk_program (Init F, Restrict (project_set h C) ` Acts F, \
   4.429 -\                 {act. Restrict (project_set h C) act : project_act h ` Restrict C ` (project_act h -` AllowedActs F)})";
   4.430 -by (rtac program_equalityI 1);
   4.431 -by (asm_simp_tac (simpset() addsimps [image_eq_UN]) 2);
   4.432 -by (Simp_tac 1);
   4.433 -by (simp_tac (simpset() addsimps [project_def]) 1);
   4.434 -qed "project_extend_eq";
   4.435 -
   4.436 -Goal "project h UNIV (extend h F) = F";
   4.437 -by (asm_simp_tac (simpset() addsimps [project_extend_eq, image_eq_UN, 
   4.438 -                   subset_UNIV RS subset_trans RS Restrict_triv]) 1);
   4.439 -by (rtac program_equalityI 1);
   4.440 -by (ALLGOALS Simp_tac);
   4.441 -by (stac insert_absorb 1);
   4.442 -by (simp_tac (simpset() addsimps [inst "x" "Id" bexI]) 1); 
   4.443 -by Auto_tac;  
   4.444 -by (rename_tac "act" 1);
   4.445 -by (res_inst_tac [("x","extend_act h act")] bexI 1);
   4.446 -by Auto_tac;  
   4.447 -qed "extend_inverse";
   4.448 -Addsimps [extend_inverse];
   4.449 -
   4.450 -Goal "inj (extend h)";
   4.451 -by (rtac inj_on_inverseI 1);
   4.452 -by (rtac extend_inverse 1);
   4.453 -qed "inj_extend";
   4.454 -
   4.455 -Goal "extend h (F Join G) = extend h F Join extend h G";
   4.456 -by (rtac program_equalityI 1);
   4.457 -by (simp_tac (simpset() addsimps [image_Un]) 2);
   4.458 -by (simp_tac (simpset() addsimps [extend_set_Int_distrib]) 1);
   4.459 -by Auto_tac;  
   4.460 -qed "extend_Join";
   4.461 -Addsimps [extend_Join];
   4.462 -
   4.463 -Goal "extend h (JOIN I F) = (JN i:I. extend h (F i))";
   4.464 -by (rtac program_equalityI 1);
   4.465 -by (simp_tac (simpset() addsimps [image_UN]) 2);
   4.466 -by (simp_tac (simpset() addsimps [extend_set_INT_distrib]) 1);
   4.467 -by Auto_tac;  
   4.468 -qed "extend_JN";
   4.469 -Addsimps [extend_JN];
   4.470 -
   4.471 -(** These monotonicity results look natural but are UNUSED **)
   4.472 -
   4.473 -Goal "F <= G ==> extend h F <= extend h G";
   4.474 -by (full_simp_tac (simpset() addsimps [component_eq_subset]) 1);
   4.475 -by Auto_tac;
   4.476 -qed "extend_mono";
   4.477 -
   4.478 -Goal "F <= G ==> project h C F <= project h C G";
   4.479 -by (full_simp_tac (simpset() addsimps [component_eq_subset]) 1);
   4.480 -by (Blast_tac 1); 
   4.481 -qed "project_mono";
   4.482 -
   4.483 -
   4.484 -(*** Safety: co, stable ***)
   4.485 -
   4.486 -Goal "(extend h F : (extend_set h A) co (extend_set h B)) = \
   4.487 -\     (F : A co B)";
   4.488 -by (simp_tac (simpset() addsimps [constrains_def]) 1);
   4.489 -qed "extend_constrains";
   4.490 -
   4.491 -Goal "(extend h F : stable (extend_set h A)) = (F : stable A)";
   4.492 -by (asm_simp_tac (simpset() addsimps [stable_def, extend_constrains]) 1);
   4.493 -qed "extend_stable";
   4.494 -
   4.495 -Goal "(extend h F : invariant (extend_set h A)) = (F : invariant A)";
   4.496 -by (asm_simp_tac (simpset() addsimps [invariant_def, extend_stable]) 1);
   4.497 -qed "extend_invariant";
   4.498 -
   4.499 -(*Projects the state predicates in the property satisfied by  extend h F.
   4.500 -  Converse fails: A and B may differ in their extra variables*)
   4.501 -Goal "extend h F : A co B ==> F : (project_set h A) co (project_set h B)";
   4.502 -by (auto_tac (claset(), simpset() addsimps [constrains_def]));
   4.503 -by (Force_tac 1);
   4.504 -qed "extend_constrains_project_set";
   4.505 -
   4.506 -Goal "extend h F : stable A ==> F : stable (project_set h A)";
   4.507 -by (asm_full_simp_tac
   4.508 -    (simpset() addsimps [stable_def, extend_constrains_project_set]) 1);
   4.509 -qed "extend_stable_project_set";
   4.510 -
   4.511 -
   4.512 -(*** Weak safety primitives: Co, Stable ***)
   4.513 -
   4.514 -Goal "p : reachable (extend h F) ==> f p : reachable F";
   4.515 -by (etac reachable.induct 1);
   4.516 -by (auto_tac
   4.517 -    (claset() addIs reachable.intrs,
   4.518 -     simpset() addsimps [extend_act_def, image_iff]));
   4.519 -qed "reachable_extend_f";
   4.520 -
   4.521 -Goal "h(s,y) : reachable (extend h F) ==> s : reachable F";
   4.522 -by (force_tac (claset() addSDs [reachable_extend_f], simpset()) 1);
   4.523 -qed "h_reachable_extend";
   4.524 -
   4.525 -Goalw [extend_set_def]
   4.526 -     "reachable (extend h F) = extend_set h (reachable F)";
   4.527 -by (rtac equalityI 1);
   4.528 -by (force_tac (claset() addIs  [h_f_g_eq RS sym]
   4.529 -			addSDs [reachable_extend_f], 
   4.530 -	       simpset()) 1);
   4.531 -by (Clarify_tac 1);
   4.532 -by (etac reachable.induct 1);
   4.533 -by (ALLGOALS (force_tac (claset() addIs reachable.intrs, 
   4.534 -			 simpset())));
   4.535 -qed "reachable_extend_eq";
   4.536 -
   4.537 -Goal "(extend h F : (extend_set h A) Co (extend_set h B)) =  \
   4.538 -\     (F : A Co B)";
   4.539 -by (simp_tac
   4.540 -    (simpset() addsimps [Constrains_def, reachable_extend_eq, 
   4.541 -			 extend_constrains, extend_set_Int_distrib RS sym]) 1);
   4.542 -qed "extend_Constrains";
   4.543 -
   4.544 -Goal "(extend h F : Stable (extend_set h A)) = (F : Stable A)";
   4.545 -by (simp_tac (simpset() addsimps [Stable_def, extend_Constrains]) 1);
   4.546 -qed "extend_Stable";
   4.547 -
   4.548 -Goal "(extend h F : Always (extend_set h A)) = (F : Always A)";
   4.549 -by (asm_simp_tac (simpset() addsimps [Always_def, extend_Stable]) 1);
   4.550 -qed "extend_Always";
   4.551 -
   4.552 -
   4.553 -(** Safety and "project" **)
   4.554 -
   4.555 -(** projection: monotonicity for safety **)
   4.556 -
   4.557 -Goal "D <= C ==> \
   4.558 -\     project_act h (Restrict D act) <= project_act h (Restrict C act)";
   4.559 -by (auto_tac (claset(), simpset() addsimps [project_act_def]));
   4.560 -qed "project_act_mono";
   4.561 -
   4.562 -Goal "[| D <= C; project h C F : A co B |] ==> project h D F : A co B";
   4.563 -by (auto_tac (claset(), simpset() addsimps [constrains_def]));
   4.564 -by (dtac project_act_mono 1);
   4.565 -by (Blast_tac 1);
   4.566 -qed "project_constrains_mono";
   4.567 -
   4.568 -Goal "[| D <= C;  project h C F : stable A |] ==> project h D F : stable A";
   4.569 -by (asm_full_simp_tac
   4.570 -    (simpset() addsimps [stable_def, project_constrains_mono]) 1);
   4.571 -qed "project_stable_mono";
   4.572 -
   4.573 -(*Key lemma used in several proofs about project and co*)
   4.574 -Goalw [constrains_def]
   4.575 -     "(project h C F : A co B)  =  \
   4.576 -\     (F : (C Int extend_set h A) co (extend_set h B) & A <= B)";
   4.577 -by (auto_tac (claset() addSIs [project_act_I], simpset() addsimps [ball_Un]));
   4.578 -by (force_tac (claset() addSIs [project_act_I] addSDs [subsetD], simpset()) 1);
   4.579 -(*the <== direction*)
   4.580 -by (rewtac project_act_def);
   4.581 -by (force_tac (claset() addSDs [subsetD], simpset()) 1);
   4.582 -qed "project_constrains";
   4.583 -
   4.584 -Goalw [stable_def]
   4.585 -     "(project h UNIV F : stable A) = (F : stable (extend_set h A))";
   4.586 -by (simp_tac (simpset() addsimps [project_constrains]) 1);
   4.587 -qed "project_stable";
   4.588 -
   4.589 -Goal "F : stable (extend_set h A) ==> project h C F : stable A";
   4.590 -by (dtac (project_stable RS iffD2) 1);
   4.591 -by (blast_tac (claset() addIs [project_stable_mono]) 1);
   4.592 -qed "project_stable_I";
   4.593 -
   4.594 -Goal "A Int extend_set h ((project_set h A) Int B) = A Int extend_set h B";
   4.595 -by (auto_tac (claset(), simpset() addsimps [split_extended_all]));
   4.596 -qed "Int_extend_set_lemma";
   4.597 -
   4.598 -(*Strange (look at occurrences of C) but used in leadsETo proofs*)
   4.599 -Goal "G : C co B ==> project h C G : project_set h C co project_set h B";
   4.600 -by (full_simp_tac (simpset() addsimps [constrains_def, project_def, 
   4.601 -				       project_act_def]) 1);
   4.602 -by (Blast_tac 1);
   4.603 -qed "project_constrains_project_set";
   4.604 -
   4.605 -Goal "G : stable C ==> project h C G : stable (project_set h C)";
   4.606 -by (asm_full_simp_tac (simpset() addsimps [stable_def, 
   4.607 -					   project_constrains_project_set]) 1);
   4.608 -qed "project_stable_project_set";
   4.609 -
   4.610 -
   4.611 -(*** Progress: transient, ensures ***)
   4.612 -
   4.613 -Goal "(extend h F : transient (extend_set h A)) = (F : transient A)";
   4.614 -by (auto_tac (claset(),
   4.615 -	      simpset() addsimps [transient_def, extend_set_subset_Compl_eq,
   4.616 -				  Domain_extend_act]));
   4.617 -qed "extend_transient";
   4.618 -
   4.619 -Goal "(extend h F : (extend_set h A) ensures (extend_set h B)) = \
   4.620 -\     (F : A ensures B)";
   4.621 -by (simp_tac
   4.622 -    (simpset() addsimps [ensures_def, extend_constrains, extend_transient, 
   4.623 -			 extend_set_Un_distrib RS sym, 
   4.624 -			 extend_set_Diff_distrib RS sym]) 1);
   4.625 -qed "extend_ensures";
   4.626 -
   4.627 -Goal "F : A leadsTo B \
   4.628 -\     ==> extend h F : (extend_set h A) leadsTo (extend_set h B)";
   4.629 -by (etac leadsTo_induct 1);
   4.630 -by (asm_simp_tac (simpset() addsimps [leadsTo_UN, extend_set_Union]) 3);
   4.631 -by (blast_tac (claset() addIs [leadsTo_Trans]) 2);
   4.632 -by (asm_simp_tac (simpset() addsimps [leadsTo_Basis, extend_ensures]) 1);
   4.633 -qed "leadsTo_imp_extend_leadsTo";
   4.634 -
   4.635 -(*** Proving the converse takes some doing! ***)
   4.636 -
   4.637 -Goal "(x : slice C y) = (h(x,y) : C)";
   4.638 -by (simp_tac (simpset() addsimps [slice_def]) 1);
   4.639 -qed "slice_iff";
   4.640 -
   4.641 -AddIffs [slice_iff];
   4.642 -
   4.643 -Goal "slice (Union S) y = (UN x:S. slice x y)";
   4.644 -by Auto_tac;
   4.645 -qed "slice_Union";
   4.646 -
   4.647 -Goal "slice (extend_set h A) y = A";
   4.648 -by Auto_tac;
   4.649 -qed "slice_extend_set";
   4.650 -
   4.651 -Goal "project_set h A = (UN y. slice A y)";
   4.652 -by Auto_tac;
   4.653 -qed "project_set_is_UN_slice";
   4.654 -
   4.655 -Goalw [transient_def] "extend h F : transient A ==> F : transient (slice A y)";
   4.656 -by Auto_tac;
   4.657 -by (rtac bexI 1);
   4.658 -by Auto_tac;
   4.659 -by (force_tac (claset(), simpset() addsimps [extend_act_def]) 1);
   4.660 -qed "extend_transient_slice";
   4.661 -
   4.662 -(*Converse?*)
   4.663 -Goal "extend h F : A co B ==> F : (slice A y) co (slice B y)";
   4.664 -by (auto_tac (claset(), simpset() addsimps [constrains_def]));
   4.665 -qed "extend_constrains_slice";
   4.666 -
   4.667 -Goal "extend h F : A ensures B ==> F : (slice A y) ensures (project_set h B)";
   4.668 -by (auto_tac (claset(), 
   4.669 -	      simpset() addsimps [ensures_def, extend_constrains, 
   4.670 -				  extend_transient]));
   4.671 -by (etac (extend_transient_slice RS transient_strengthen) 2);
   4.672 -by (etac (extend_constrains_slice RS constrains_weaken) 1);
   4.673 -by Auto_tac;
   4.674 -qed "extend_ensures_slice";
   4.675 -
   4.676 -Goal "ALL y. F : (slice B y) leadsTo CU ==> F : (project_set h B) leadsTo CU";
   4.677 -by (simp_tac (simpset() addsimps [project_set_is_UN_slice]) 1);
   4.678 -by (blast_tac (claset() addIs [leadsTo_UN]) 1);
   4.679 -qed "leadsTo_slice_project_set";
   4.680 -
   4.681 -Goal "extend h F : AU leadsTo BU \
   4.682 -\     ==> ALL y. F : (slice AU y) leadsTo (project_set h BU)";
   4.683 -by (etac leadsTo_induct 1);
   4.684 -by (asm_simp_tac (simpset() addsimps [leadsTo_UN, slice_Union]) 3);
   4.685 -by (blast_tac (claset() addIs [leadsTo_slice_project_set, leadsTo_Trans]) 2);
   4.686 -by (blast_tac (claset() addIs [extend_ensures_slice, leadsTo_Basis]) 1);
   4.687 -qed_spec_mp "extend_leadsTo_slice";
   4.688 -
   4.689 -Goal "(extend h F : (extend_set h A) leadsTo (extend_set h B)) = \
   4.690 -\     (F : A leadsTo B)";
   4.691 -by Safe_tac;
   4.692 -by (etac leadsTo_imp_extend_leadsTo 2);
   4.693 -by (dtac extend_leadsTo_slice 1);
   4.694 -by (full_simp_tac (simpset() addsimps [slice_extend_set]) 1);
   4.695 -qed "extend_leadsTo";
   4.696 -
   4.697 -Goal "(extend h F : (extend_set h A) LeadsTo (extend_set h B)) =  \
   4.698 -\     (F : A LeadsTo B)";
   4.699 -by (simp_tac
   4.700 -    (simpset() addsimps [LeadsTo_def, reachable_extend_eq, 
   4.701 -			 extend_leadsTo, extend_set_Int_distrib RS sym]) 1);
   4.702 -qed "extend_LeadsTo";
   4.703 -
   4.704 -
   4.705 -(*** preserves ***)
   4.706 -
   4.707 -Goal "G : preserves (v o f) ==> project h C G : preserves v";
   4.708 -by (auto_tac (claset(),
   4.709 -	      simpset() addsimps [preserves_def, project_stable_I,
   4.710 -				  extend_set_eq_Collect]));
   4.711 -qed "project_preserves_I";
   4.712 -
   4.713 -(*to preserve f is to preserve the whole original state*)
   4.714 -Goal "G : preserves f ==> project h C G : preserves id";
   4.715 -by (asm_simp_tac (simpset() addsimps [project_preserves_I]) 1);
   4.716 -qed "project_preserves_id_I";
   4.717 -
   4.718 -Goal "(extend h G : preserves (v o f)) = (G : preserves v)";
   4.719 -by (auto_tac (claset(),
   4.720 -	      simpset() addsimps [preserves_def, extend_stable RS sym,
   4.721 -				  extend_set_eq_Collect]));
   4.722 -qed "extend_preserves";
   4.723 -
   4.724 -Goal "inj h ==> (extend h G : preserves g)";
   4.725 -by (auto_tac (claset(),
   4.726 -	      simpset() addsimps [preserves_def, extend_def, extend_act_def, 
   4.727 -				  stable_def, constrains_def, g_def]));
   4.728 -qed "inj_extend_preserves";
   4.729 -
   4.730 -
   4.731 -(*** Guarantees ***)
   4.732 -
   4.733 -Goal "project h UNIV ((extend h F) Join G) = F Join (project h UNIV G)";
   4.734 -by (rtac program_equalityI 1);
   4.735 -by (simp_tac (simpset() addsimps [image_eq_UN, UN_Un]) 2);
   4.736 -by (simp_tac (simpset() addsimps [project_set_extend_set_Int]) 1);
   4.737 -by Auto_tac;  
   4.738 -qed "project_extend_Join";
   4.739 -
   4.740 -Goal "(extend h F) Join G = extend h H ==> H = F Join (project h UNIV G)";
   4.741 -by (dres_inst_tac [("f", "project h UNIV")] arg_cong 1);
   4.742 -by (asm_full_simp_tac (simpset() addsimps [project_extend_Join]) 1);
   4.743 -qed "extend_Join_eq_extend_D";
   4.744 -
   4.745 -(** Strong precondition and postcondition; only useful when
   4.746 -    the old and new state sets are in bijection **)
   4.747 -
   4.748 -
   4.749 -Goal "extend h F ok G ==> F ok project h UNIV G";
   4.750 -by (auto_tac (claset(), simpset() addsimps [ok_def]));
   4.751 -by (dtac subsetD 1);   
   4.752 -by (auto_tac (claset() addSIs [rev_image_eqI], simpset()));  
   4.753 -qed "ok_extend_imp_ok_project";
   4.754 -
   4.755 -Goal "(extend h F ok extend h G) = (F ok G)";
   4.756 -by (asm_full_simp_tac (simpset() addsimps [ok_def]) 1);
   4.757 -by Safe_tac;
   4.758 -by (REPEAT (Force_tac 1));
   4.759 -qed "ok_extend_iff";
   4.760 -
   4.761 -Goalw [OK_def] "OK I (%i. extend h (F i)) = (OK I F)";
   4.762 -by Safe_tac;
   4.763 -by (dres_inst_tac [("x","i")] bspec 1); 
   4.764 -by (dres_inst_tac [("x","j")] bspec 2);  
   4.765 -by (REPEAT (Force_tac 1));
   4.766 -qed "OK_extend_iff";
   4.767 -
   4.768 -Goal "F : X guarantees Y ==> \
   4.769 -\     extend h F : (extend h ` X) guarantees (extend h ` Y)";
   4.770 -by (rtac guaranteesI 1);
   4.771 -by (Clarify_tac 1);
   4.772 -by (blast_tac (claset() addDs [ok_extend_imp_ok_project, 
   4.773 -                               extend_Join_eq_extend_D, guaranteesD]) 1);
   4.774 -qed "guarantees_imp_extend_guarantees";
   4.775 -
   4.776 -Goal "extend h F : (extend h ` X) guarantees (extend h ` Y) \
   4.777 -\     ==> F : X guarantees Y";
   4.778 -by (auto_tac (claset(), simpset() addsimps [guar_def]));
   4.779 -by (dres_inst_tac [("x", "extend h G")] spec 1);
   4.780 -by (asm_full_simp_tac 
   4.781 -    (simpset() delsimps [extend_Join] 
   4.782 -               addsimps [extend_Join RS sym, ok_extend_iff, 
   4.783 -                         inj_extend RS inj_image_mem_iff]) 1);
   4.784 -qed "extend_guarantees_imp_guarantees";
   4.785 -
   4.786 -Goal "(extend h F : (extend h ` X) guarantees (extend h ` Y)) = \
   4.787 -\    (F : X guarantees Y)";
   4.788 -by (blast_tac (claset() addIs [guarantees_imp_extend_guarantees,
   4.789 -			       extend_guarantees_imp_guarantees]) 1);
   4.790 -qed "extend_guarantees_eq";
   4.791 -
   4.792 -
   4.793 -Close_locale "Extend";
   4.794 -
   4.795 -(*Close_locale should do this!
   4.796 -Delsimps [f_h_eq, extend_set_inverse, f_image_extend_set, extend_act_Image];
   4.797 -Delrules [make_elim h_inject1];
   4.798 -*)
     5.1 --- a/src/HOL/UNITY/Extend.thy	Tue Jan 28 22:53:39 2003 +0100
     5.2 +++ b/src/HOL/UNITY/Extend.thy	Wed Jan 29 11:02:08 2003 +0100
     5.3 @@ -8,7 +8,7 @@
     5.4    function g (forgotten) maps the extended state to the "extending part"
     5.5  *)
     5.6  
     5.7 -Extend = Guar +
     5.8 +theory Extend = Guar:
     5.9  
    5.10  constdefs
    5.11  
    5.12 @@ -46,17 +46,697 @@
    5.13  		         project_act h ` Restrict C ` AllowedActs F})"
    5.14  
    5.15  locale Extend =
    5.16 -  fixes 
    5.17 -    f       :: 'c => 'a
    5.18 -    g       :: 'c => 'b
    5.19 -    h       :: "'a*'b => 'c"    (*isomorphism between 'a * 'b and 'c *)
    5.20 -    slice   :: ['c set, 'b] => 'a set
    5.21 +  fixes f     :: "'c => 'a"
    5.22 +    and g     :: "'c => 'b"
    5.23 +    and h     :: "'a*'b => 'c"    (*isomorphism between 'a * 'b and 'c *)
    5.24 +    and slice :: "['c set, 'b] => 'a set"
    5.25 +  assumes
    5.26 +    good_h:  "good_map h"
    5.27 +  defines f_def: "f z == fst (inv h z)"
    5.28 +      and g_def: "g z == snd (inv h z)"
    5.29 +      and slice_def: "slice Z y == {x. h(x,y) : Z}"
    5.30 +
    5.31 +
    5.32 +(** These we prove OUTSIDE the locale. **)
    5.33 +
    5.34 +
    5.35 +(*** Restrict [MOVE to Relation.thy?] ***)
    5.36 +
    5.37 +lemma Restrict_iff [iff]: "((x,y): Restrict A r) = ((x,y): r & x: A)"
    5.38 +by (unfold Restrict_def, blast)
    5.39 +
    5.40 +lemma Restrict_UNIV [simp]: "Restrict UNIV = id"
    5.41 +apply (rule ext)
    5.42 +apply (auto simp add: Restrict_def)
    5.43 +done
    5.44 +
    5.45 +lemma Restrict_empty [simp]: "Restrict {} r = {}"
    5.46 +by (auto simp add: Restrict_def)
    5.47 +
    5.48 +lemma Restrict_Int [simp]: "Restrict A (Restrict B r) = Restrict (A Int B) r"
    5.49 +by (unfold Restrict_def, blast)
    5.50 +
    5.51 +lemma Restrict_triv: "Domain r <= A ==> Restrict A r = r"
    5.52 +by (unfold Restrict_def, auto)
    5.53 +
    5.54 +lemma Restrict_subset: "Restrict A r <= r"
    5.55 +by (unfold Restrict_def, auto)
    5.56 +
    5.57 +lemma Restrict_eq_mono: 
    5.58 +     "[| A <= B;  Restrict B r = Restrict B s |]  
    5.59 +      ==> Restrict A r = Restrict A s"
    5.60 +by (unfold Restrict_def, blast)
    5.61 +
    5.62 +lemma Restrict_imageI: 
    5.63 +     "[| s : RR;  Restrict A r = Restrict A s |]  
    5.64 +      ==> Restrict A r : Restrict A ` RR"
    5.65 +by (unfold Restrict_def image_def, auto)
    5.66 +
    5.67 +lemma Domain_Restrict [simp]: "Domain (Restrict A r) = A Int Domain r"
    5.68 +by blast
    5.69 +
    5.70 +lemma Image_Restrict [simp]: "(Restrict A r) `` B = r `` (A Int B)"
    5.71 +by blast
    5.72 +
    5.73 +lemma insert_Id_image_Acts: "f Id = Id ==> insert Id (f`Acts F) = f ` Acts F"
    5.74 +by (blast intro: sym [THEN image_eqI])
    5.75 +
    5.76 +(*Possibly easier than reasoning about "inv h"*)
    5.77 +lemma good_mapI: 
    5.78 +     assumes surj_h: "surj h"
    5.79 +	 and prem:   "!! x x' y y'. h(x,y) = h(x',y') ==> x=x'"
    5.80 +     shows "good_map h"
    5.81 +apply (simp add: good_map_def) 
    5.82 +apply (safe intro!: surj_h)
    5.83 +apply (rule prem)
    5.84 +apply (subst surjective_pairing [symmetric])
    5.85 +apply (subst surj_h [THEN surj_f_inv_f])
    5.86 +apply (rule refl)
    5.87 +done
    5.88 +
    5.89 +lemma good_map_is_surj: "good_map h ==> surj h"
    5.90 +by (unfold good_map_def, auto)
    5.91 +
    5.92 +(*A convenient way of finding a closed form for inv h*)
    5.93 +lemma fst_inv_equalityI: 
    5.94 +     assumes surj_h: "surj h"
    5.95 +	 and prem:   "!! x y. g (h(x,y)) = x"
    5.96 +     shows "fst (inv h z) = g z"
    5.97 +apply (unfold inv_def)
    5.98 +apply (rule_tac y1 = z in surj_h [THEN surjD, THEN exE])
    5.99 +apply (rule someI2)
   5.100 +apply (drule_tac [2] f = g in arg_cong)
   5.101 +apply (auto simp add: prem)
   5.102 +done
   5.103 +
   5.104 +
   5.105 +(*** Trivial properties of f, g, h ***)
   5.106 +
   5.107 +lemma (in Extend) f_h_eq [simp]: "f(h(x,y)) = x" 
   5.108 +by (simp add: f_def good_h [unfolded good_map_def, THEN conjunct2])
   5.109 +
   5.110 +lemma (in Extend) h_inject1 [dest]: "h(x,y) = h(x',y') ==> x=x'"
   5.111 +apply (drule_tac f = f in arg_cong)
   5.112 +apply (simp add: f_def good_h [unfolded good_map_def, THEN conjunct2])
   5.113 +done
   5.114 +
   5.115 +lemma (in Extend) h_f_g_equiv: "h(f z, g z) == z"
   5.116 +by (simp add: f_def g_def 
   5.117 +            good_h [unfolded good_map_def, THEN conjunct1, THEN surj_f_inv_f])
   5.118 +
   5.119 +lemma (in Extend) h_f_g_eq: "h(f z, g z) = z"
   5.120 +by (simp add: h_f_g_equiv)
   5.121 +
   5.122 +
   5.123 +lemma (in Extend) split_extended_all:
   5.124 +     "(!!z. PROP P z) == (!!u y. PROP P (h (u, y)))"
   5.125 +proof 
   5.126 +   assume allP: "\<And>z. PROP P z"
   5.127 +   fix u y
   5.128 +   show "PROP P (h (u, y))" by (rule allP)
   5.129 + next
   5.130 +   assume allPh: "\<And>u y. PROP P (h(u,y))"
   5.131 +   fix z
   5.132 +   have Phfgz: "PROP P (h (f z, g z))" by (rule allPh)
   5.133 +   show "PROP P z" by (rule Phfgz [unfolded h_f_g_equiv])
   5.134 +qed 
   5.135 +
   5.136 +
   5.137 +
   5.138 +(*** extend_set: basic properties ***)
   5.139 +
   5.140 +lemma project_set_iff [iff]:
   5.141 +     "(x : project_set h C) = (EX y. h(x,y) : C)"
   5.142 +by (simp add: project_set_def)
   5.143 +
   5.144 +lemma extend_set_mono: "A<=B ==> extend_set h A <= extend_set h B"
   5.145 +by (unfold extend_set_def, blast)
   5.146 +
   5.147 +lemma (in Extend) mem_extend_set_iff [iff]: "z : extend_set h A = (f z : A)"
   5.148 +apply (unfold extend_set_def)
   5.149 +apply (force intro: h_f_g_eq [symmetric])
   5.150 +done
   5.151 +
   5.152 +lemma (in Extend) extend_set_strict_mono [iff]:
   5.153 +     "(extend_set h A <= extend_set h B) = (A <= B)"
   5.154 +by (unfold extend_set_def, force)
   5.155 +
   5.156 +lemma extend_set_empty [simp]: "extend_set h {} = {}"
   5.157 +by (unfold extend_set_def, auto)
   5.158 +
   5.159 +lemma (in Extend) extend_set_eq_Collect: "extend_set h {s. P s} = {s. P(f s)}"
   5.160 +by auto
   5.161 +
   5.162 +lemma (in Extend) extend_set_sing: "extend_set h {x} = {s. f s = x}"
   5.163 +by auto
   5.164 +
   5.165 +lemma (in Extend) extend_set_inverse [simp]:
   5.166 +     "project_set h (extend_set h C) = C"
   5.167 +by (unfold extend_set_def, auto)
   5.168 +
   5.169 +lemma (in Extend) extend_set_project_set:
   5.170 +     "C <= extend_set h (project_set h C)"
   5.171 +apply (unfold extend_set_def)
   5.172 +apply (auto simp add: split_extended_all, blast)
   5.173 +done
   5.174 +
   5.175 +lemma (in Extend) inj_extend_set: "inj (extend_set h)"
   5.176 +apply (rule inj_on_inverseI)
   5.177 +apply (rule extend_set_inverse)
   5.178 +done
   5.179 +
   5.180 +lemma (in Extend) extend_set_UNIV_eq [simp]: "extend_set h UNIV = UNIV"
   5.181 +apply (unfold extend_set_def)
   5.182 +apply (auto simp add: split_extended_all)
   5.183 +done
   5.184 +
   5.185 +(*** project_set: basic properties ***)
   5.186 +
   5.187 +(*project_set is simply image!*)
   5.188 +lemma (in Extend) project_set_eq: "project_set h C = f ` C"
   5.189 +by (auto intro: f_h_eq [symmetric] simp add: split_extended_all)
   5.190 +
   5.191 +(*Converse appears to fail*)
   5.192 +lemma (in Extend) project_set_I: "!!z. z : C ==> f z : project_set h C"
   5.193 +by (auto simp add: split_extended_all)
   5.194 +
   5.195 +
   5.196 +(*** More laws ***)
   5.197 +
   5.198 +(*Because A and B could differ on the "other" part of the state, 
   5.199 +   cannot generalize to 
   5.200 +      project_set h (A Int B) = project_set h A Int project_set h B
   5.201 +*)
   5.202 +lemma (in Extend) project_set_extend_set_Int:
   5.203 +     "project_set h ((extend_set h A) Int B) = A Int (project_set h B)"
   5.204 +by auto
   5.205 +
   5.206 +(*Unused, but interesting?*)
   5.207 +lemma (in Extend) project_set_extend_set_Un:
   5.208 +     "project_set h ((extend_set h A) Un B) = A Un (project_set h B)"
   5.209 +by auto
   5.210 +
   5.211 +lemma project_set_Int_subset:
   5.212 +     "project_set h (A Int B) <= (project_set h A) Int (project_set h B)"
   5.213 +by auto
   5.214 +
   5.215 +lemma (in Extend) extend_set_Un_distrib:
   5.216 +     "extend_set h (A Un B) = extend_set h A Un extend_set h B"
   5.217 +by auto
   5.218 +
   5.219 +lemma (in Extend) extend_set_Int_distrib:
   5.220 +     "extend_set h (A Int B) = extend_set h A Int extend_set h B"
   5.221 +by auto
   5.222 +
   5.223 +lemma (in Extend) extend_set_INT_distrib:
   5.224 +     "extend_set h (INTER A B) = (INT x:A. extend_set h (B x))"
   5.225 +by auto
   5.226 +
   5.227 +lemma (in Extend) extend_set_Diff_distrib:
   5.228 +     "extend_set h (A - B) = extend_set h A - extend_set h B"
   5.229 +by auto
   5.230 +
   5.231 +lemma (in Extend) extend_set_Union:
   5.232 +     "extend_set h (Union A) = (UN X:A. extend_set h X)"
   5.233 +by blast
   5.234 +
   5.235 +lemma (in Extend) extend_set_subset_Compl_eq:
   5.236 +     "(extend_set h A <= - extend_set h B) = (A <= - B)"
   5.237 +by (unfold extend_set_def, auto)
   5.238 +
   5.239 +
   5.240 +(*** extend_act ***)
   5.241 +
   5.242 +(*Can't strengthen it to
   5.243 +  ((h(s,y), h(s',y')) : extend_act h act) = ((s, s') : act & y=y')
   5.244 +  because h doesn't have to be injective in the 2nd argument*)
   5.245 +lemma (in Extend) mem_extend_act_iff [iff]: 
   5.246 +     "((h(s,y), h(s',y)) : extend_act h act) = ((s, s') : act)"
   5.247 +by (unfold extend_act_def, auto)
   5.248 +
   5.249 +(*Converse fails: (z,z') would include actions that changed the g-part*)
   5.250 +lemma (in Extend) extend_act_D: 
   5.251 +     "(z, z') : extend_act h act ==> (f z, f z') : act"
   5.252 +by (unfold extend_act_def, auto)
   5.253 +
   5.254 +lemma (in Extend) extend_act_inverse [simp]: 
   5.255 +     "project_act h (extend_act h act) = act"
   5.256 +by (unfold extend_act_def project_act_def, blast)
   5.257 +
   5.258 +lemma (in Extend) project_act_extend_act_restrict [simp]: 
   5.259 +     "project_act h (Restrict C (extend_act h act)) =  
   5.260 +      Restrict (project_set h C) act"
   5.261 +by (unfold extend_act_def project_act_def, blast)
   5.262 +
   5.263 +lemma (in Extend) subset_extend_act_D: 
   5.264 +     "act' <= extend_act h act ==> project_act h act' <= act"
   5.265 +by (unfold extend_act_def project_act_def, force)
   5.266 +
   5.267 +lemma (in Extend) inj_extend_act: "inj (extend_act h)"
   5.268 +apply (rule inj_on_inverseI)
   5.269 +apply (rule extend_act_inverse)
   5.270 +done
   5.271 +
   5.272 +lemma (in Extend) extend_act_Image [simp]: 
   5.273 +     "extend_act h act `` (extend_set h A) = extend_set h (act `` A)"
   5.274 +by (unfold extend_set_def extend_act_def, force)
   5.275 +
   5.276 +lemma (in Extend) extend_act_strict_mono [iff]:
   5.277 +     "(extend_act h act' <= extend_act h act) = (act'<=act)"
   5.278 +by (unfold extend_act_def, auto)
   5.279 +
   5.280 +declare (in Extend) inj_extend_act [THEN inj_eq, iff]
   5.281 +(*This theorem is  (extend_act h act' = extend_act h act) = (act'=act) *)
   5.282 +
   5.283 +lemma Domain_extend_act: 
   5.284 +    "Domain (extend_act h act) = extend_set h (Domain act)"
   5.285 +by (unfold extend_set_def extend_act_def, force)
   5.286 +
   5.287 +lemma (in Extend) extend_act_Id [simp]: 
   5.288 +    "extend_act h Id = Id"
   5.289 +apply (unfold extend_act_def)
   5.290 +apply (force intro: h_f_g_eq [symmetric])
   5.291 +done
   5.292 +
   5.293 +lemma (in Extend) project_act_I: 
   5.294 +     "!!z z'. (z, z') : act ==> (f z, f z') : project_act h act"
   5.295 +apply (unfold project_act_def)
   5.296 +apply (force simp add: split_extended_all)
   5.297 +done
   5.298 +
   5.299 +lemma (in Extend) project_act_Id [simp]: "project_act h Id = Id"
   5.300 +by (unfold project_act_def, force)
   5.301 +
   5.302 +lemma (in Extend) Domain_project_act: 
   5.303 +  "Domain (project_act h act) = project_set h (Domain act)"
   5.304 +apply (unfold project_act_def)
   5.305 +apply (force simp add: split_extended_all)
   5.306 +done
   5.307 +
   5.308 +
   5.309 +
   5.310 +(**** extend ****)
   5.311 +
   5.312 +(*** Basic properties ***)
   5.313 +
   5.314 +lemma Init_extend [simp]:
   5.315 +     "Init (extend h F) = extend_set h (Init F)"
   5.316 +by (unfold extend_def, auto)
   5.317 +
   5.318 +lemma Init_project [simp]:
   5.319 +     "Init (project h C F) = project_set h (Init F)"
   5.320 +by (unfold project_def, auto)
   5.321 +
   5.322 +lemma (in Extend) Acts_extend [simp]:
   5.323 +     "Acts (extend h F) = (extend_act h ` Acts F)"
   5.324 +by (simp add: extend_def insert_Id_image_Acts)
   5.325 +
   5.326 +lemma (in Extend) AllowedActs_extend [simp]:
   5.327 +     "AllowedActs (extend h F) = project_act h -` AllowedActs F"
   5.328 +by (simp add: extend_def insert_absorb)
   5.329 +
   5.330 +lemma Acts_project [simp]:
   5.331 +     "Acts(project h C F) = insert Id (project_act h ` Restrict C ` Acts F)"
   5.332 +by (auto simp add: project_def image_iff)
   5.333 +
   5.334 +lemma (in Extend) AllowedActs_project [simp]:
   5.335 +     "AllowedActs(project h C F) =  
   5.336 +        {act. Restrict (project_set h C) act  
   5.337 +               : project_act h ` Restrict C ` AllowedActs F}"
   5.338 +apply (simp (no_asm) add: project_def image_iff)
   5.339 +apply (subst insert_absorb)
   5.340 +apply (auto intro!: bexI [of _ Id] simp add: project_act_def)
   5.341 +done
   5.342 +
   5.343 +lemma (in Extend) Allowed_extend:
   5.344 +     "Allowed (extend h F) = project h UNIV -` Allowed F"
   5.345 +apply (simp (no_asm) add: AllowedActs_extend Allowed_def)
   5.346 +apply blast
   5.347 +done
   5.348 +
   5.349 +lemma (in Extend) extend_SKIP [simp]: "extend h SKIP = SKIP"
   5.350 +apply (unfold SKIP_def)
   5.351 +apply (rule program_equalityI, auto)
   5.352 +done
   5.353 +
   5.354 +lemma project_set_UNIV [simp]: "project_set h UNIV = UNIV"
   5.355 +by auto
   5.356 +
   5.357 +lemma project_set_Union:
   5.358 +     "project_set h (Union A) = (UN X:A. project_set h X)"
   5.359 +by blast
   5.360 +
   5.361  
   5.362 -  assumes
   5.363 -    good_h  "good_map h"
   5.364 -  defines
   5.365 -    f_def       "f z == fst (inv h z)"
   5.366 -    g_def       "g z == snd (inv h z)"
   5.367 -    slice_def   "slice Z y == {x. h(x,y) : Z}"
   5.368 +(*Converse FAILS: the extended state contributing to project_set h C
   5.369 +  may not coincide with the one contributing to project_act h act*)
   5.370 +lemma (in Extend) project_act_Restrict_subset:
   5.371 +     "project_act h (Restrict C act) <=  
   5.372 +      Restrict (project_set h C) (project_act h act)"
   5.373 +by (auto simp add: project_act_def)
   5.374 +
   5.375 +lemma (in Extend) project_act_Restrict_Id_eq:
   5.376 +     "project_act h (Restrict C Id) = Restrict (project_set h C) Id"
   5.377 +by (auto simp add: project_act_def)
   5.378 +
   5.379 +lemma (in Extend) project_extend_eq:
   5.380 +     "project h C (extend h F) =  
   5.381 +      mk_program (Init F, Restrict (project_set h C) ` Acts F,  
   5.382 +                  {act. Restrict (project_set h C) act 
   5.383 +                          : project_act h ` Restrict C ` 
   5.384 +                                     (project_act h -` AllowedActs F)})"
   5.385 +apply (rule program_equalityI)
   5.386 +  apply simp
   5.387 + apply (simp add: image_eq_UN)
   5.388 +apply (simp add: project_def)
   5.389 +done
   5.390 +
   5.391 +lemma (in Extend) extend_inverse [simp]:
   5.392 +     "project h UNIV (extend h F) = F"
   5.393 +apply (simp (no_asm_simp) add: project_extend_eq image_eq_UN
   5.394 +          subset_UNIV [THEN subset_trans, THEN Restrict_triv])
   5.395 +apply (rule program_equalityI)
   5.396 +apply (simp_all (no_asm))
   5.397 +apply (subst insert_absorb)
   5.398 +apply (simp (no_asm) add: bexI [of _ Id])
   5.399 +apply auto
   5.400 +apply (rename_tac "act")
   5.401 +apply (rule_tac x = "extend_act h act" in bexI, auto)
   5.402 +done
   5.403 +
   5.404 +lemma (in Extend) inj_extend: "inj (extend h)"
   5.405 +apply (rule inj_on_inverseI)
   5.406 +apply (rule extend_inverse)
   5.407 +done
   5.408 +
   5.409 +lemma (in Extend) extend_Join [simp]:
   5.410 +     "extend h (F Join G) = extend h F Join extend h G"
   5.411 +apply (rule program_equalityI)
   5.412 +apply (simp (no_asm) add: extend_set_Int_distrib)
   5.413 +apply (simp add: image_Un, auto)
   5.414 +done
   5.415 +
   5.416 +lemma (in Extend) extend_JN [simp]:
   5.417 +     "extend h (JOIN I F) = (JN i:I. extend h (F i))"
   5.418 +apply (rule program_equalityI)
   5.419 +  apply (simp (no_asm) add: extend_set_INT_distrib)
   5.420 + apply (simp add: image_UN, auto)
   5.421 +done
   5.422 +
   5.423 +(** These monotonicity results look natural but are UNUSED **)
   5.424 +
   5.425 +lemma (in Extend) extend_mono: "F <= G ==> extend h F <= extend h G"
   5.426 +by (force simp add: component_eq_subset)
   5.427 +
   5.428 +lemma (in Extend) project_mono: "F <= G ==> project h C F <= project h C G"
   5.429 +by (simp add: component_eq_subset, blast)
   5.430 +
   5.431 +
   5.432 +(*** Safety: co, stable ***)
   5.433 +
   5.434 +lemma (in Extend) extend_constrains:
   5.435 +     "(extend h F : (extend_set h A) co (extend_set h B)) =  
   5.436 +      (F : A co B)"
   5.437 +by (simp add: constrains_def)
   5.438 +
   5.439 +lemma (in Extend) extend_stable:
   5.440 +     "(extend h F : stable (extend_set h A)) = (F : stable A)"
   5.441 +by (simp add: stable_def extend_constrains)
   5.442 +
   5.443 +lemma (in Extend) extend_invariant:
   5.444 +     "(extend h F : invariant (extend_set h A)) = (F : invariant A)"
   5.445 +by (simp add: invariant_def extend_stable)
   5.446 +
   5.447 +(*Projects the state predicates in the property satisfied by  extend h F.
   5.448 +  Converse fails: A and B may differ in their extra variables*)
   5.449 +lemma (in Extend) extend_constrains_project_set:
   5.450 +     "extend h F : A co B ==> F : (project_set h A) co (project_set h B)"
   5.451 +by (auto simp add: constrains_def, force)
   5.452 +
   5.453 +lemma (in Extend) extend_stable_project_set:
   5.454 +     "extend h F : stable A ==> F : stable (project_set h A)"
   5.455 +by (simp add: stable_def extend_constrains_project_set)
   5.456 +
   5.457 +
   5.458 +(*** Weak safety primitives: Co, Stable ***)
   5.459 +
   5.460 +lemma (in Extend) reachable_extend_f:
   5.461 +     "p : reachable (extend h F) ==> f p : reachable F"
   5.462 +apply (erule reachable.induct)
   5.463 +apply (auto intro: reachable.intros simp add: extend_act_def image_iff)
   5.464 +done
   5.465 +
   5.466 +lemma (in Extend) h_reachable_extend:
   5.467 +     "h(s,y) : reachable (extend h F) ==> s : reachable F"
   5.468 +by (force dest!: reachable_extend_f)
   5.469 +
   5.470 +lemma (in Extend) reachable_extend_eq: 
   5.471 +     "reachable (extend h F) = extend_set h (reachable F)"
   5.472 +apply (unfold extend_set_def)
   5.473 +apply (rule equalityI)
   5.474 +apply (force intro: h_f_g_eq [symmetric] dest!: reachable_extend_f, clarify)
   5.475 +apply (erule reachable.induct)
   5.476 +apply (force intro: reachable.intros)+
   5.477 +done
   5.478 +
   5.479 +lemma (in Extend) extend_Constrains:
   5.480 +     "(extend h F : (extend_set h A) Co (extend_set h B)) =   
   5.481 +      (F : A Co B)"
   5.482 +by (simp add: Constrains_def reachable_extend_eq extend_constrains 
   5.483 +              extend_set_Int_distrib [symmetric])
   5.484 +
   5.485 +lemma (in Extend) extend_Stable:
   5.486 +     "(extend h F : Stable (extend_set h A)) = (F : Stable A)"
   5.487 +by (simp add: Stable_def extend_Constrains)
   5.488 +
   5.489 +lemma (in Extend) extend_Always:
   5.490 +     "(extend h F : Always (extend_set h A)) = (F : Always A)"
   5.491 +by (simp (no_asm_simp) add: Always_def extend_Stable)
   5.492 +
   5.493 +
   5.494 +(** Safety and "project" **)
   5.495 +
   5.496 +(** projection: monotonicity for safety **)
   5.497 +
   5.498 +lemma project_act_mono:
   5.499 +     "D <= C ==>  
   5.500 +      project_act h (Restrict D act) <= project_act h (Restrict C act)"
   5.501 +by (auto simp add: project_act_def)
   5.502 +
   5.503 +lemma (in Extend) project_constrains_mono:
   5.504 +     "[| D <= C; project h C F : A co B |] ==> project h D F : A co B"
   5.505 +apply (auto simp add: constrains_def)
   5.506 +apply (drule project_act_mono, blast)
   5.507 +done
   5.508 +
   5.509 +lemma (in Extend) project_stable_mono:
   5.510 +     "[| D <= C;  project h C F : stable A |] ==> project h D F : stable A"
   5.511 +by (simp add: stable_def project_constrains_mono)
   5.512 +
   5.513 +(*Key lemma used in several proofs about project and co*)
   5.514 +lemma (in Extend) project_constrains: 
   5.515 +     "(project h C F : A co B)  =   
   5.516 +      (F : (C Int extend_set h A) co (extend_set h B) & A <= B)"
   5.517 +apply (unfold constrains_def)
   5.518 +apply (auto intro!: project_act_I simp add: ball_Un)
   5.519 +apply (force intro!: project_act_I dest!: subsetD)
   5.520 +(*the <== direction*)
   5.521 +apply (unfold project_act_def)
   5.522 +apply (force dest!: subsetD)
   5.523 +done
   5.524 +
   5.525 +lemma (in Extend) project_stable: 
   5.526 +     "(project h UNIV F : stable A) = (F : stable (extend_set h A))"
   5.527 +apply (unfold stable_def)
   5.528 +apply (simp (no_asm) add: project_constrains)
   5.529 +done
   5.530 +
   5.531 +lemma (in Extend) project_stable_I:
   5.532 +     "F : stable (extend_set h A) ==> project h C F : stable A"
   5.533 +apply (drule project_stable [THEN iffD2])
   5.534 +apply (blast intro: project_stable_mono)
   5.535 +done
   5.536 +
   5.537 +lemma (in Extend) Int_extend_set_lemma:
   5.538 +     "A Int extend_set h ((project_set h A) Int B) = A Int extend_set h B"
   5.539 +by (auto simp add: split_extended_all)
   5.540 +
   5.541 +(*Strange (look at occurrences of C) but used in leadsETo proofs*)
   5.542 +lemma project_constrains_project_set:
   5.543 +     "G : C co B ==> project h C G : project_set h C co project_set h B"
   5.544 +by (simp add: constrains_def project_def project_act_def, blast)
   5.545 +
   5.546 +lemma project_stable_project_set:
   5.547 +     "G : stable C ==> project h C G : stable (project_set h C)"
   5.548 +by (simp add: stable_def project_constrains_project_set)
   5.549 +
   5.550 +
   5.551 +(*** Progress: transient, ensures ***)
   5.552 +
   5.553 +lemma (in Extend) extend_transient:
   5.554 +     "(extend h F : transient (extend_set h A)) = (F : transient A)"
   5.555 +by (auto simp add: transient_def extend_set_subset_Compl_eq Domain_extend_act)
   5.556 +
   5.557 +lemma (in Extend) extend_ensures:
   5.558 +     "(extend h F : (extend_set h A) ensures (extend_set h B)) =  
   5.559 +      (F : A ensures B)"
   5.560 +by (simp add: ensures_def extend_constrains extend_transient 
   5.561 +        extend_set_Un_distrib [symmetric] extend_set_Diff_distrib [symmetric])
   5.562 +
   5.563 +lemma (in Extend) leadsTo_imp_extend_leadsTo:
   5.564 +     "F : A leadsTo B  
   5.565 +      ==> extend h F : (extend_set h A) leadsTo (extend_set h B)"
   5.566 +apply (erule leadsTo_induct)
   5.567 +  apply (simp add: leadsTo_Basis extend_ensures)
   5.568 + apply (blast intro: leadsTo_Trans)
   5.569 +apply (simp add: leadsTo_UN extend_set_Union)
   5.570 +done
   5.571 +
   5.572 +(*** Proving the converse takes some doing! ***)
   5.573 +
   5.574 +lemma (in Extend) slice_iff [iff]: "(x : slice C y) = (h(x,y) : C)"
   5.575 +by (simp (no_asm) add: slice_def)
   5.576 +
   5.577 +lemma (in Extend) slice_Union: "slice (Union S) y = (UN x:S. slice x y)"
   5.578 +by auto
   5.579 +
   5.580 +lemma (in Extend) slice_extend_set: "slice (extend_set h A) y = A"
   5.581 +by auto
   5.582 +
   5.583 +lemma (in Extend) project_set_is_UN_slice:
   5.584 +     "project_set h A = (UN y. slice A y)"
   5.585 +by auto
   5.586 +
   5.587 +lemma (in Extend) extend_transient_slice:
   5.588 +     "extend h F : transient A ==> F : transient (slice A y)"
   5.589 +apply (unfold transient_def, auto)
   5.590 +apply (rule bexI, auto)
   5.591 +apply (force simp add: extend_act_def)
   5.592 +done
   5.593 +
   5.594 +(*Converse?*)
   5.595 +lemma (in Extend) extend_constrains_slice:
   5.596 +     "extend h F : A co B ==> F : (slice A y) co (slice B y)"
   5.597 +by (auto simp add: constrains_def)
   5.598 +
   5.599 +lemma (in Extend) extend_ensures_slice:
   5.600 +     "extend h F : A ensures B ==> F : (slice A y) ensures (project_set h B)"
   5.601 +apply (auto simp add: ensures_def extend_constrains extend_transient)
   5.602 +apply (erule_tac [2] extend_transient_slice [THEN transient_strengthen])
   5.603 +apply (erule extend_constrains_slice [THEN constrains_weaken], auto)
   5.604 +done
   5.605 +
   5.606 +lemma (in Extend) leadsTo_slice_project_set:
   5.607 +     "ALL y. F : (slice B y) leadsTo CU ==> F : (project_set h B) leadsTo CU"
   5.608 +apply (simp (no_asm) add: project_set_is_UN_slice)
   5.609 +apply (blast intro: leadsTo_UN)
   5.610 +done
   5.611 +
   5.612 +lemma (in Extend) extend_leadsTo_slice [rule_format (no_asm)]:
   5.613 +     "extend h F : AU leadsTo BU  
   5.614 +      ==> ALL y. F : (slice AU y) leadsTo (project_set h BU)"
   5.615 +apply (erule leadsTo_induct)
   5.616 +  apply (blast intro: extend_ensures_slice leadsTo_Basis)
   5.617 + apply (blast intro: leadsTo_slice_project_set leadsTo_Trans)
   5.618 +apply (simp add: leadsTo_UN slice_Union)
   5.619 +done
   5.620 +
   5.621 +lemma (in Extend) extend_leadsTo:
   5.622 +     "(extend h F : (extend_set h A) leadsTo (extend_set h B)) =  
   5.623 +      (F : A leadsTo B)"
   5.624 +apply safe
   5.625 +apply (erule_tac [2] leadsTo_imp_extend_leadsTo)
   5.626 +apply (drule extend_leadsTo_slice)
   5.627 +apply (simp add: slice_extend_set)
   5.628 +done
   5.629 +
   5.630 +lemma (in Extend) extend_LeadsTo:
   5.631 +     "(extend h F : (extend_set h A) LeadsTo (extend_set h B)) =   
   5.632 +      (F : A LeadsTo B)"
   5.633 +by (simp add: LeadsTo_def reachable_extend_eq extend_leadsTo
   5.634 +              extend_set_Int_distrib [symmetric])
   5.635 +
   5.636 +
   5.637 +(*** preserves ***)
   5.638 +
   5.639 +lemma (in Extend) project_preserves_I:
   5.640 +     "G : preserves (v o f) ==> project h C G : preserves v"
   5.641 +by (auto simp add: preserves_def project_stable_I extend_set_eq_Collect)
   5.642 +
   5.643 +(*to preserve f is to preserve the whole original state*)
   5.644 +lemma (in Extend) project_preserves_id_I:
   5.645 +     "G : preserves f ==> project h C G : preserves id"
   5.646 +by (simp add: project_preserves_I)
   5.647 +
   5.648 +lemma (in Extend) extend_preserves:
   5.649 +     "(extend h G : preserves (v o f)) = (G : preserves v)"
   5.650 +by (auto simp add: preserves_def extend_stable [symmetric] 
   5.651 +                   extend_set_eq_Collect)
   5.652 +
   5.653 +lemma (in Extend) inj_extend_preserves: "inj h ==> (extend h G : preserves g)"
   5.654 +by (auto simp add: preserves_def extend_def extend_act_def stable_def 
   5.655 +                   constrains_def g_def)
   5.656 +
   5.657 +
   5.658 +(*** Guarantees ***)
   5.659 +
   5.660 +lemma (in Extend) project_extend_Join:
   5.661 +     "project h UNIV ((extend h F) Join G) = F Join (project h UNIV G)"
   5.662 +apply (rule program_equalityI)
   5.663 +  apply (simp add: project_set_extend_set_Int)
   5.664 + apply (simp add: image_eq_UN UN_Un, auto)
   5.665 +done
   5.666 +
   5.667 +lemma (in Extend) extend_Join_eq_extend_D:
   5.668 +     "(extend h F) Join G = extend h H ==> H = F Join (project h UNIV G)"
   5.669 +apply (drule_tac f = "project h UNIV" in arg_cong)
   5.670 +apply (simp add: project_extend_Join)
   5.671 +done
   5.672 +
   5.673 +(** Strong precondition and postcondition; only useful when
   5.674 +    the old and new state sets are in bijection **)
   5.675 +
   5.676 +
   5.677 +lemma (in Extend) ok_extend_imp_ok_project:
   5.678 +     "extend h F ok G ==> F ok project h UNIV G"
   5.679 +apply (auto simp add: ok_def)
   5.680 +apply (drule subsetD)
   5.681 +apply (auto intro!: rev_image_eqI)
   5.682 +done
   5.683 +
   5.684 +lemma (in Extend) ok_extend_iff: "(extend h F ok extend h G) = (F ok G)"
   5.685 +apply (simp add: ok_def, safe)
   5.686 +apply (force+)
   5.687 +done
   5.688 +
   5.689 +lemma (in Extend) OK_extend_iff: "OK I (%i. extend h (F i)) = (OK I F)"
   5.690 +apply (unfold OK_def, safe)
   5.691 +apply (drule_tac x = i in bspec)
   5.692 +apply (drule_tac [2] x = j in bspec)
   5.693 +apply (force+)
   5.694 +done
   5.695 +
   5.696 +lemma (in Extend) guarantees_imp_extend_guarantees:
   5.697 +     "F : X guarantees Y ==>  
   5.698 +      extend h F : (extend h ` X) guarantees (extend h ` Y)"
   5.699 +apply (rule guaranteesI, clarify)
   5.700 +apply (blast dest: ok_extend_imp_ok_project extend_Join_eq_extend_D 
   5.701 +                   guaranteesD)
   5.702 +done
   5.703 +
   5.704 +lemma (in Extend) extend_guarantees_imp_guarantees:
   5.705 +     "extend h F : (extend h ` X) guarantees (extend h ` Y)  
   5.706 +      ==> F : X guarantees Y"
   5.707 +apply (auto simp add: guar_def)
   5.708 +apply (drule_tac x = "extend h G" in spec)
   5.709 +apply (simp del: extend_Join 
   5.710 +            add: extend_Join [symmetric] ok_extend_iff 
   5.711 +                 inj_extend [THEN inj_image_mem_iff])
   5.712 +done
   5.713 +
   5.714 +lemma (in Extend) extend_guarantees_eq:
   5.715 +     "(extend h F : (extend h ` X) guarantees (extend h ` Y)) =  
   5.716 +      (F : X guarantees Y)"
   5.717 +by (blast intro: guarantees_imp_extend_guarantees 
   5.718 +                 extend_guarantees_imp_guarantees)
   5.719  
   5.720  end
     6.1 --- a/src/HOL/UNITY/Lift_prog.thy	Tue Jan 28 22:53:39 2003 +0100
     6.2 +++ b/src/HOL/UNITY/Lift_prog.thy	Wed Jan 29 11:02:08 2003 +0100
     6.3 @@ -348,13 +348,6 @@
     6.4  apply (blast dest: insert_map_eq_diff)
     6.5  done
     6.6  
     6.7 -
     6.8 -ML
     6.9 -{*
    6.10 -bind_thm ("export_mem_extend_act_iff", export mem_extend_act_iff)
    6.11 -*}
    6.12 -
    6.13 -
    6.14  lemma lift_transient_eq_disj:
    6.15       "F : preserves snd  
    6.16        ==> (lift i F : transient (lift_set j (A <*> UNIV))) =  
    6.17 @@ -362,8 +355,7 @@
    6.18  apply (case_tac "i=j")
    6.19  apply (auto simp add: lift_transient)
    6.20  apply (auto simp add: lift_set_def lift_def transient_def rename_def extend_def Domain_extend_act)
    6.21 -apply (drule subsetD, blast)
    6.22 -apply auto
    6.23 +apply (drule subsetD, blast, auto)
    6.24  apply (rename_tac s f uu s' f' uu')
    6.25  apply (subgoal_tac "f'=f & uu'=uu")
    6.26   prefer 2 apply (force dest!: preserves_imp_eq, auto)
    6.27 @@ -371,7 +363,8 @@
    6.28  apply (drule subsetD)
    6.29  apply (rule ImageI)
    6.30  apply (erule bij_lift_map [THEN good_map_bij, 
    6.31 -                           THEN export_mem_extend_act_iff [THEN iffD2]], force)
    6.32 +                           THEN Extend.intro, 
    6.33 +                           THEN Extend.mem_extend_act_iff [THEN iffD2]], force)
    6.34  apply (erule lift_map_eq_diff [THEN exE], auto)
    6.35  done
    6.36  
    6.37 @@ -445,19 +438,12 @@
    6.38  apply (auto simp add: preserves_def stable_def constrains_def)
    6.39  done
    6.40  
    6.41 -
    6.42 -ML
    6.43 -{*
    6.44 -bind_thm ("export_Acts_extend", export Acts_extend);
    6.45 -bind_thm ("export_AllowedActs_extend", export AllowedActs_extend)
    6.46 -*}
    6.47 -
    6.48  lemma UNION_OK_lift_I:
    6.49       "[| ALL i:I. F i : preserves snd;   
    6.50           ALL i:I. UNION (preserves fst) Acts <= AllowedActs (F i) |]  
    6.51        ==> OK I (%i. lift i (F i))"
    6.52 -apply (auto simp add: OK_def lift_def rename_def export_Acts_extend)
    6.53 -apply (simp (no_asm) add: export_AllowedActs_extend project_act_extend_act)
    6.54 +apply (auto simp add: OK_def lift_def rename_def Extend.Acts_extend)
    6.55 +apply (simp (no_asm) add: Extend.AllowedActs_extend project_act_extend_act)
    6.56  apply (rename_tac "act")
    6.57  apply (subgoal_tac
    6.58         "{(x, x'). \<exists>s f u s' f' u'. 
    6.59 @@ -477,12 +463,11 @@
    6.60        ==> OK I (%i. lift i (F i))"
    6.61  by (simp add: safety_prop_AllowedActs_iff_Allowed UNION_OK_lift_I)
    6.62  
    6.63 -
    6.64  lemma Allowed_lift [simp]: "Allowed (lift i F) = lift i ` (Allowed F)"
    6.65  by (simp add: lift_def Allowed_rename)
    6.66  
    6.67 -lemma lift_image_preserves: "lift i ` preserves v = preserves (v o drop_map i)"
    6.68 -apply (simp (no_asm) add: rename_image_preserves lift_def inv_lift_map_eq)
    6.69 -done
    6.70 +lemma lift_image_preserves:
    6.71 +     "lift i ` preserves v = preserves (v o drop_map i)"
    6.72 +by (simp (no_asm) add: rename_image_preserves lift_def inv_lift_map_eq)
    6.73  
    6.74  end
     7.1 --- a/src/HOL/UNITY/Project.ML	Tue Jan 28 22:53:39 2003 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,718 +0,0 @@
     7.4 -(*  Title:      HOL/UNITY/Project.ML
     7.5 -    ID:         $Id$
     7.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     7.7 -    Copyright   1999  University of Cambridge
     7.8 -
     7.9 -Projections of state sets (also of actions and programs)
    7.10 -
    7.11 -Inheritance of GUARANTEES properties under extension
    7.12 -*)
    7.13 -
    7.14 -Open_locale "Extend";
    7.15 -
    7.16 -Goal "F : A co B ==> project h C (extend h F) : A co B";
    7.17 -by (auto_tac (claset(), 
    7.18 -      simpset() addsimps [extend_act_def, project_act_def, constrains_def]));
    7.19 -qed "project_extend_constrains_I";
    7.20 -
    7.21 -
    7.22 -(** Safety **)
    7.23 -
    7.24 -(*used below to prove Join_project_ensures*)
    7.25 -Goal "[| G : stable C;  project h C G : A unless B |] \
    7.26 -\     ==> G : (C Int extend_set h A) unless (extend_set h B)";
    7.27 -by (asm_full_simp_tac
    7.28 -    (simpset() addsimps [unless_def, project_constrains]) 1);
    7.29 -by (blast_tac (claset() addDs [stable_constrains_Int]
    7.30 -			addIs [constrains_weaken]) 1);
    7.31 -qed_spec_mp "project_unless";
    7.32 -
    7.33 -(*Generalizes project_constrains to the program F Join project h C G;
    7.34 -  useful with guarantees reasoning*)
    7.35 -Goal "(F Join project h C G : A co B)  =  \
    7.36 -\       (extend h F Join G : (C Int extend_set h A) co (extend_set h B) &  \
    7.37 -\        F : A co B)";
    7.38 -by (simp_tac (simpset() addsimps [project_constrains]) 1);
    7.39 -by (blast_tac (claset() addIs [extend_constrains RS iffD2 RS constrains_weaken]
    7.40 -                        addDs [constrains_imp_subset]) 1);
    7.41 -qed "Join_project_constrains";
    7.42 -
    7.43 -(*The condition is required to prove the left-to-right direction;
    7.44 -  could weaken it to G : (C Int extend_set h A) co C*)
    7.45 -Goalw [stable_def]
    7.46 -     "extend h F Join G : stable C \
    7.47 -\     ==> (F Join project h C G : stable A)  =  \
    7.48 -\         (extend h F Join G : stable (C Int extend_set h A) &  \
    7.49 -\          F : stable A)";
    7.50 -by (simp_tac (HOL_ss addsimps [Join_project_constrains]) 1);
    7.51 -by (blast_tac (claset() addIs [constrains_weaken] addDs [constrains_Int]) 1);
    7.52 -qed "Join_project_stable";
    7.53 -
    7.54 -(*For using project_guarantees in particular cases*)
    7.55 -Goal "extend h F Join G : extend_set h A co extend_set h B \
    7.56 -\     ==> F Join project h C G : A co B";
    7.57 -by (asm_full_simp_tac
    7.58 -    (simpset() addsimps [project_constrains, extend_constrains]) 1);
    7.59 -by (blast_tac (claset() addIs [constrains_weaken]
    7.60 -			addDs [constrains_imp_subset]) 1);
    7.61 -qed "project_constrains_I";
    7.62 -
    7.63 -Goalw [increasing_def, stable_def]
    7.64 -     "extend h F Join G : increasing (func o f) \
    7.65 -\     ==> F Join project h C G : increasing func";
    7.66 -by (asm_full_simp_tac (simpset_of SubstAx.thy
    7.67 -		 addsimps [project_constrains_I, extend_set_eq_Collect]) 1);
    7.68 -qed "project_increasing_I";
    7.69 -
    7.70 -Goal "(F Join project h UNIV G : increasing func)  =  \
    7.71 -\     (extend h F Join G : increasing (func o f))";
    7.72 -by (rtac iffI 1);
    7.73 -by (etac project_increasing_I 2);
    7.74 -by (asm_full_simp_tac (simpset_of SubstAx.thy
    7.75 -		         addsimps [increasing_def, Join_project_stable]) 1);
    7.76 -by (auto_tac (claset(),
    7.77 -	      simpset() addsimps [extend_set_eq_Collect,
    7.78 -				  extend_stable RS iffD1]));
    7.79 -qed "Join_project_increasing";
    7.80 -
    7.81 -(*The UNIV argument is essential*)
    7.82 -Goal "F Join project h UNIV G : A co B \
    7.83 -\     ==> extend h F Join G : extend_set h A co extend_set h B";
    7.84 -by (asm_full_simp_tac
    7.85 -    (simpset() addsimps [project_constrains, extend_constrains]) 1);
    7.86 -qed "project_constrains_D";
    7.87 -
    7.88 -
    7.89 -(*** "projecting" and union/intersection (no converses) ***)
    7.90 -
    7.91 -Goalw [projecting_def]
    7.92 -     "[| projecting C h F XA' XA;  projecting C h F XB' XB |] \
    7.93 -\     ==> projecting C h F (XA' Int XB') (XA Int XB)";
    7.94 -by (Blast_tac 1);
    7.95 -qed "projecting_Int";
    7.96 -
    7.97 -Goalw [projecting_def]
    7.98 -     "[| projecting C h F XA' XA;  projecting C h F XB' XB |] \
    7.99 -\     ==> projecting C h F (XA' Un XB') (XA Un XB)";
   7.100 -by (Blast_tac 1);
   7.101 -qed "projecting_Un";
   7.102 -
   7.103 -val [prem] = Goalw [projecting_def]
   7.104 -     "[| !!i. i:I ==> projecting C h F (X' i) (X i) |] \
   7.105 -\     ==> projecting C h F (INT i:I. X' i) (INT i:I. X i)";
   7.106 -by (blast_tac (claset() addDs [prem RS spec RS mp]) 1);
   7.107 -qed "projecting_INT";
   7.108 -
   7.109 -val [prem] = Goalw [projecting_def]
   7.110 -     "[| !!i. i:I ==> projecting C h F (X' i) (X i) |] \
   7.111 -\     ==> projecting C h F (UN i:I. X' i) (UN i:I. X i)";
   7.112 -by (blast_tac (claset() addDs [prem RS spec RS mp]) 1);
   7.113 -qed "projecting_UN";
   7.114 -
   7.115 -Goalw [projecting_def]
   7.116 -     "[| projecting C h F X' X;  U'<=X';  X<=U |] ==> projecting C h F U' U";
   7.117 -by Auto_tac;
   7.118 -qed "projecting_weaken";
   7.119 -
   7.120 -Goalw [projecting_def]
   7.121 -     "[| projecting C h F X' X;  U'<=X' |] ==> projecting C h F U' X";
   7.122 -by Auto_tac;
   7.123 -qed "projecting_weaken_L";
   7.124 -
   7.125 -Goalw [extending_def]
   7.126 -     "[| extending C h F YA' YA;  extending C h F YB' YB |] \
   7.127 -\     ==> extending C h F (YA' Int YB') (YA Int YB)";
   7.128 -by (Blast_tac 1);
   7.129 -qed "extending_Int";
   7.130 -
   7.131 -Goalw [extending_def]
   7.132 -     "[| extending C h F YA' YA;  extending C h F YB' YB |] \
   7.133 -\     ==> extending C h F (YA' Un YB') (YA Un YB)";
   7.134 -by (Blast_tac 1);
   7.135 -qed "extending_Un";
   7.136 -
   7.137 -val [prem] = Goalw [extending_def]
   7.138 -     "[| !!i. i:I ==> extending C h F (Y' i) (Y i) |] \
   7.139 -\     ==> extending C h F (INT i:I. Y' i) (INT i:I. Y i)";
   7.140 -by (blast_tac (claset() addDs [prem RS spec RS mp]) 1);
   7.141 -qed "extending_INT";
   7.142 -
   7.143 -val [prem] = Goalw [extending_def]
   7.144 -     "[| !!i. i:I ==> extending C h F (Y' i) (Y i) |] \
   7.145 -\     ==> extending C h F (UN i:I. Y' i) (UN i:I. Y i)";
   7.146 -by (blast_tac (claset() addDs [prem RS spec RS mp]) 1);
   7.147 -qed "extending_UN";
   7.148 -
   7.149 -Goalw [extending_def]
   7.150 -     "[| extending C h F Y' Y;  Y'<=V';  V<=Y |] ==> extending C h F V' V";
   7.151 -by Auto_tac;
   7.152 -qed "extending_weaken";
   7.153 -
   7.154 -Goalw [extending_def]
   7.155 -     "[| extending C h F Y' Y;  Y'<=V' |] ==> extending C h F V' Y";
   7.156 -by Auto_tac;
   7.157 -qed "extending_weaken_L";
   7.158 -
   7.159 -Goal "projecting C h F X' UNIV";
   7.160 -by (simp_tac (simpset() addsimps [projecting_def]) 1);
   7.161 -qed "projecting_UNIV";
   7.162 -
   7.163 -Goalw [projecting_def]
   7.164 -     "projecting C h F (extend_set h A co extend_set h B) (A co B)";
   7.165 -by (blast_tac (claset() addIs [project_constrains_I]) 1);
   7.166 -qed "projecting_constrains";
   7.167 -
   7.168 -Goalw [stable_def]
   7.169 -     "projecting C h F (stable (extend_set h A)) (stable A)";
   7.170 -by (rtac projecting_constrains 1);
   7.171 -qed "projecting_stable";
   7.172 -
   7.173 -Goalw [projecting_def]
   7.174 -     "projecting C h F (increasing (func o f)) (increasing func)";
   7.175 -by (blast_tac (claset() addIs [project_increasing_I]) 1);
   7.176 -qed "projecting_increasing";
   7.177 -
   7.178 -Goal "extending C h F UNIV Y";
   7.179 -by (simp_tac (simpset() addsimps [extending_def]) 1);
   7.180 -qed "extending_UNIV";
   7.181 -
   7.182 -Goalw [extending_def]
   7.183 -     "extending (%G. UNIV) h F (extend_set h A co extend_set h B) (A co B)";
   7.184 -by (blast_tac (claset() addIs [project_constrains_D]) 1);
   7.185 -qed "extending_constrains";
   7.186 -
   7.187 -Goalw [stable_def]
   7.188 -     "extending (%G. UNIV) h F (stable (extend_set h A)) (stable A)";
   7.189 -by (rtac extending_constrains 1);
   7.190 -qed "extending_stable";
   7.191 -
   7.192 -Goalw [extending_def]
   7.193 -     "extending (%G. UNIV) h F (increasing (func o f)) (increasing func)";
   7.194 -by (simp_tac (HOL_ss addsimps [Join_project_increasing]) 1);
   7.195 -qed "extending_increasing";
   7.196 -
   7.197 -
   7.198 -(** Reachability and project **)
   7.199 -
   7.200 -(*In practice, C = reachable(...): the inclusion is equality*)
   7.201 -Goal "[| reachable (extend h F Join G) <= C;  \
   7.202 -\        z : reachable (extend h F Join G) |] \
   7.203 -\     ==> f z : reachable (F Join project h C G)";
   7.204 -by (etac reachable.induct 1);
   7.205 -by (force_tac (claset() addSIs [reachable.Init],
   7.206 -	       simpset() addsimps [split_extended_all]) 1);
   7.207 -by Auto_tac;
   7.208 -by (force_tac (claset() delSWrapper "split_all_tac" addSbefore 
   7.209 -   ("unsafe_split_all_tac", unsafe_split_all_tac) 
   7.210 -   addIs [project_act_I RSN (3,reachable.Acts)], simpset()) 2);
   7.211 -by (res_inst_tac [("act","x")] reachable.Acts 1);
   7.212 -by Auto_tac;
   7.213 -by (etac extend_act_D 1);
   7.214 -qed "reachable_imp_reachable_project";
   7.215 -
   7.216 -Goalw [Constrains_def]
   7.217 -     "F Join project h (reachable (extend h F Join G)) G : A Co B  \
   7.218 -\     ==> extend h F Join G : (extend_set h A) Co (extend_set h B)";
   7.219 -by (full_simp_tac (simpset_of SubstAx.thy addsimps [Join_project_constrains]) 1);
   7.220 -by (Clarify_tac 1);
   7.221 -by (etac constrains_weaken 1);
   7.222 -by (auto_tac (claset() addIs [reachable_imp_reachable_project], simpset()));
   7.223 -qed "project_Constrains_D";
   7.224 -
   7.225 -Goalw [Stable_def]
   7.226 -     "F Join project h (reachable (extend h F Join G)) G : Stable A  \
   7.227 -\     ==> extend h F Join G : Stable (extend_set h A)";
   7.228 -by (asm_simp_tac (simpset() addsimps [project_Constrains_D]) 1);
   7.229 -qed "project_Stable_D";
   7.230 -
   7.231 -Goalw [Always_def]
   7.232 -     "F Join project h (reachable (extend h F Join G)) G : Always A  \
   7.233 -\     ==> extend h F Join G : Always (extend_set h A)";
   7.234 -by (force_tac (claset() addIs [reachable.Init],
   7.235 -               simpset() addsimps [project_Stable_D, split_extended_all]) 1);
   7.236 -qed "project_Always_D";
   7.237 -
   7.238 -Goalw [Increasing_def]
   7.239 -     "F Join project h (reachable (extend h F Join G)) G : Increasing func  \
   7.240 -\     ==> extend h F Join G : Increasing (func o f)";
   7.241 -by Auto_tac;
   7.242 -by (stac (extend_set_eq_Collect RS sym) 1);
   7.243 -by (asm_simp_tac (simpset() addsimps [project_Stable_D]) 1); 
   7.244 -qed "project_Increasing_D";
   7.245 -
   7.246 -
   7.247 -(** Converse results for weak safety: benefits of the argument C *)
   7.248 -
   7.249 -(*In practice, C = reachable(...): the inclusion is equality*)
   7.250 -Goal "[| C <= reachable(extend h F Join G);   \
   7.251 -\        x : reachable (F Join project h C G) |] \
   7.252 -\     ==> EX y. h(x,y) : reachable (extend h F Join G)";
   7.253 -by (etac reachable.induct 1);
   7.254 -by  (force_tac (claset() addIs [reachable.Init], simpset()) 1);
   7.255 -by (auto_tac (claset(), simpset()addsimps [project_act_def]));
   7.256 -by (ALLGOALS (force_tac (claset() delrules [Id_in_Acts]
   7.257 -		        addIs [reachable.Acts, extend_act_D], simpset())));
   7.258 -qed "reachable_project_imp_reachable";
   7.259 -
   7.260 -Goal "project_set h (reachable (extend h F Join G)) = \
   7.261 -\     reachable (F Join project h (reachable (extend h F Join G)) G)";
   7.262 -by (auto_tac (claset() addDs [subset_refl RS reachable_imp_reachable_project,
   7.263 -			      subset_refl RS reachable_project_imp_reachable], 
   7.264 -	      simpset()));
   7.265 -qed "project_set_reachable_extend_eq";
   7.266 -
   7.267 -(*UNUSED*)
   7.268 -Goal "reachable (extend h F Join G) <= C  \
   7.269 -\     ==> reachable (extend h F Join G) <= \
   7.270 -\         extend_set h (reachable (F Join project h C G))";
   7.271 -by (auto_tac (claset() addDs [reachable_imp_reachable_project], 
   7.272 -	      simpset()));
   7.273 -qed "reachable_extend_Join_subset";
   7.274 -
   7.275 -Goalw [Constrains_def]
   7.276 -     "extend h F Join G : (extend_set h A) Co (extend_set h B)  \
   7.277 -\     ==> F Join project h (reachable (extend h F Join G)) G : A Co B";
   7.278 -by (full_simp_tac (simpset_of SubstAx.thy addsimps [Join_project_constrains, 
   7.279 -				       extend_set_Int_distrib]) 1);
   7.280 -by (rtac conjI 1);
   7.281 -by (force_tac
   7.282 -    (claset() addEs [constrains_weaken_L]
   7.283 -              addSDs [extend_constrains_project_set,
   7.284 -		      subset_refl RS reachable_project_imp_reachable], 
   7.285 -     simpset()) 2);
   7.286 -by (blast_tac (claset() addIs [constrains_weaken_L]) 1);
   7.287 -qed "project_Constrains_I";
   7.288 -
   7.289 -Goalw [Stable_def]
   7.290 -     "extend h F Join G : Stable (extend_set h A)  \
   7.291 -\     ==> F Join project h (reachable (extend h F Join G)) G : Stable A";
   7.292 -by (asm_simp_tac (simpset() addsimps [project_Constrains_I]) 1);
   7.293 -qed "project_Stable_I";
   7.294 -
   7.295 -Goalw [Always_def]
   7.296 -     "extend h F Join G : Always (extend_set h A)  \
   7.297 -\     ==> F Join project h (reachable (extend h F Join G)) G : Always A";
   7.298 -by (auto_tac (claset(), simpset() addsimps [project_Stable_I]));
   7.299 -by (rewtac extend_set_def);
   7.300 -by (Blast_tac 1);
   7.301 -qed "project_Always_I";
   7.302 -
   7.303 -Goalw [Increasing_def]
   7.304 -    "extend h F Join G : Increasing (func o f)  \
   7.305 -\    ==> F Join project h (reachable (extend h F Join G)) G : Increasing func";
   7.306 -by Auto_tac;
   7.307 -by (asm_simp_tac (simpset() addsimps [extend_set_eq_Collect,
   7.308 -				      project_Stable_I]) 1); 
   7.309 -qed "project_Increasing_I";
   7.310 -
   7.311 -Goal "(F Join project h (reachable (extend h F Join G)) G : A Co B)  =  \
   7.312 -\     (extend h F Join G : (extend_set h A) Co (extend_set h B))";
   7.313 -by (blast_tac (claset() addIs [project_Constrains_I, project_Constrains_D]) 1);
   7.314 -qed "project_Constrains";
   7.315 -
   7.316 -Goalw [Stable_def]
   7.317 -     "(F Join project h (reachable (extend h F Join G)) G : Stable A)  =  \
   7.318 -\     (extend h F Join G : Stable (extend_set h A))";
   7.319 -by (rtac project_Constrains 1);
   7.320 -qed "project_Stable";
   7.321 -
   7.322 -Goal
   7.323 -   "(F Join project h (reachable (extend h F Join G)) G : Increasing func)  = \
   7.324 -\   (extend h F Join G : Increasing (func o f))";
   7.325 -by (asm_simp_tac (simpset() addsimps [Increasing_def, project_Stable,
   7.326 -				      extend_set_eq_Collect]) 1);
   7.327 -qed "project_Increasing";
   7.328 -
   7.329 -(** A lot of redundant theorems: all are proved to facilitate reasoning
   7.330 -    about guarantees. **)
   7.331 -
   7.332 -Goalw [projecting_def]
   7.333 -     "projecting (%G. reachable (extend h F Join G)) h F \
   7.334 -\                (extend_set h A Co extend_set h B) (A Co B)";
   7.335 -by (blast_tac (claset() addIs [project_Constrains_I]) 1);
   7.336 -qed "projecting_Constrains";
   7.337 -
   7.338 -Goalw [Stable_def]
   7.339 -     "projecting (%G. reachable (extend h F Join G)) h F \
   7.340 -\                (Stable (extend_set h A)) (Stable A)";
   7.341 -by (rtac projecting_Constrains 1);
   7.342 -qed "projecting_Stable";
   7.343 -
   7.344 -Goalw [projecting_def]
   7.345 -     "projecting (%G. reachable (extend h F Join G)) h F \
   7.346 -\                (Always (extend_set h A)) (Always A)";
   7.347 -by (blast_tac (claset() addIs [project_Always_I]) 1);
   7.348 -qed "projecting_Always";
   7.349 -
   7.350 -Goalw [projecting_def]
   7.351 -     "projecting (%G. reachable (extend h F Join G)) h F \
   7.352 -\                (Increasing (func o f)) (Increasing func)";
   7.353 -by (blast_tac (claset() addIs [project_Increasing_I]) 1);
   7.354 -qed "projecting_Increasing";
   7.355 -
   7.356 -Goalw [extending_def]
   7.357 -     "extending (%G. reachable (extend h F Join G)) h F \
   7.358 -\                 (extend_set h A Co extend_set h B) (A Co B)";
   7.359 -by (blast_tac (claset() addIs [project_Constrains_D]) 1);
   7.360 -qed "extending_Constrains";
   7.361 -
   7.362 -Goalw [extending_def]
   7.363 -     "extending (%G. reachable (extend h F Join G)) h F \
   7.364 -\                 (Stable (extend_set h A)) (Stable A)";
   7.365 -by (blast_tac (claset() addIs [project_Stable_D]) 1);
   7.366 -qed "extending_Stable";
   7.367 -
   7.368 -Goalw [extending_def]
   7.369 -     "extending (%G. reachable (extend h F Join G)) h F \
   7.370 -\                 (Always (extend_set h A)) (Always A)";
   7.371 -by (blast_tac (claset() addIs [project_Always_D]) 1);
   7.372 -qed "extending_Always";
   7.373 -
   7.374 -Goalw [extending_def]
   7.375 -     "extending (%G. reachable (extend h F Join G)) h F \
   7.376 -\                 (Increasing (func o f)) (Increasing func)";
   7.377 -by (blast_tac (claset() addIs [project_Increasing_D]) 1);
   7.378 -qed "extending_Increasing";
   7.379 -
   7.380 -
   7.381 -(*** leadsETo in the precondition (??) ***)
   7.382 -
   7.383 -(** transient **)
   7.384 -
   7.385 -Goalw [transient_def]
   7.386 -     "[| G : transient (C Int extend_set h A);  G : stable C |]  \
   7.387 -\     ==> project h C G : transient (project_set h C Int A)";
   7.388 -by (auto_tac (claset(), simpset() addsimps [Domain_project_act]));
   7.389 -by (subgoal_tac "act `` (C Int extend_set h A) <= - extend_set h A" 1);
   7.390 -by (asm_full_simp_tac 
   7.391 -    (simpset() addsimps [stable_def, constrains_def]) 2);
   7.392 -by (Blast_tac 2);
   7.393 -(*back to main goal*)
   7.394 -by (thin_tac "?AA <= -C Un ?BB" 1);
   7.395 -by (ball_tac 1);
   7.396 -by (asm_full_simp_tac 
   7.397 -    (simpset() addsimps [extend_set_def, project_act_def]) 1);
   7.398 -by (Blast_tac 1);
   7.399 -qed "transient_extend_set_imp_project_transient";
   7.400 -
   7.401 -(*converse might hold too?*)
   7.402 -Goalw [transient_def]
   7.403 -     "project h C (extend h F) : transient (project_set h C Int D) \
   7.404 -\     ==> F : transient (project_set h C Int D)";
   7.405 -by (auto_tac (claset(), simpset() addsimps [Domain_project_act]));
   7.406 -by (rtac bexI 1);
   7.407 -by (assume_tac 2);
   7.408 -by Auto_tac;
   7.409 -by (rewtac extend_act_def);
   7.410 -by (Blast_tac 1);
   7.411 -qed "project_extend_transient_D";
   7.412 -
   7.413 -
   7.414 -(** ensures -- a primitive combining progress with safety **)
   7.415 -
   7.416 -(*Used to prove project_leadsETo_I*)
   7.417 -Goal "[| extend h F : stable C;  G : stable C;  \
   7.418 -\        extend h F Join G : A ensures B;  A-B = C Int extend_set h D |]  \
   7.419 -\     ==> F Join project h C G  \
   7.420 -\           : (project_set h C Int project_set h A) ensures (project_set h B)";
   7.421 -by (asm_full_simp_tac
   7.422 -    (simpset() addsimps [ensures_def, project_constrains, 
   7.423 -			 Join_transient, extend_transient]) 1);
   7.424 -by (Clarify_tac 1);
   7.425 -by (REPEAT_FIRST (rtac conjI));
   7.426 -(*first subgoal*)
   7.427 -by (blast_tac (claset() addIs [extend_stable_project_set RS stableD RS 
   7.428 -			       constrains_Int RS constrains_weaken]
   7.429 -	                addSDs [extend_constrains_project_set]
   7.430 -			addSDs [equalityD1]) 1);
   7.431 -(*2nd subgoal*)
   7.432 -by (etac (stableD RS constrains_Int RS constrains_weaken) 1);
   7.433 -by (assume_tac 1);
   7.434 -by (Blast_tac 3);
   7.435 -by (full_simp_tac (simpset() addsimps [extend_set_Int_distrib,
   7.436 -				       extend_set_Un_distrib]) 2);
   7.437 -by (blast_tac (claset() addSIs [impOfSubs extend_set_project_set]) 2);
   7.438 -by (full_simp_tac (simpset() addsimps [extend_set_def]) 1);
   7.439 -by (Blast_tac 1);
   7.440 -(*The transient part*)
   7.441 -by Auto_tac;
   7.442 -by (force_tac (claset() addSDs [equalityD1]
   7.443 -	                addIs [transient_extend_set_imp_project_transient RS
   7.444 -			       transient_strengthen], 
   7.445 -              simpset()) 2);
   7.446 -by (full_simp_tac (simpset() addsimps [Int_Diff]) 1);
   7.447 -by (force_tac (claset() addSDs [equalityD1]
   7.448 -	                addIs [transient_extend_set_imp_project_transient RS 
   7.449 -			 project_extend_transient_D RS transient_strengthen], 
   7.450 -              simpset()) 1);
   7.451 -qed "ensures_extend_set_imp_project_ensures";
   7.452 -
   7.453 -(*Used to prove project_leadsETo_D*)
   7.454 -Goal "[| project h C G ~: transient (A-B) | A<=B;  \
   7.455 -\        extend h F Join G : stable C;  \
   7.456 -\        F Join project h C G : A ensures B |] \
   7.457 -\     ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)";
   7.458 -by (etac disjE 1);
   7.459 -by (blast_tac (claset() addIs [subset_imp_ensures]) 2);
   7.460 -by (auto_tac (claset() addDs [extend_transient RS iffD2] 
   7.461 -                       addIs [transient_strengthen, project_set_I,
   7.462 -			      project_unless RS unlessD, unlessI, 
   7.463 -			      project_extend_constrains_I], 
   7.464 -	      simpset() addsimps [ensures_def, Join_transient]));
   7.465 -qed_spec_mp "Join_project_ensures";
   7.466 -
   7.467 -(** Lemma useful for both STRONG and WEAK progress, but the transient
   7.468 -    condition's very strong **)
   7.469 -
   7.470 -(*The strange induction formula allows induction over the leadsTo
   7.471 -  assumption's non-atomic precondition*)
   7.472 -Goal "[| ALL D. project h C G : transient D --> D={};  \
   7.473 -\        extend h F Join G : stable C;  \
   7.474 -\        F Join project h C G : (project_set h C Int A) leadsTo B |] \
   7.475 -\     ==> extend h F Join G : \
   7.476 -\         C Int extend_set h (project_set h C Int A) leadsTo (extend_set h B)";
   7.477 -by (etac leadsTo_induct 1);
   7.478 -by (asm_simp_tac (simpset() delsimps UN_simps
   7.479 -		  addsimps [Int_UN_distrib, leadsTo_UN, extend_set_Union]) 3);
   7.480 -by (blast_tac (claset() addIs [psp_stable2 RS leadsTo_weaken_L, 
   7.481 -			       leadsTo_Trans]) 2);
   7.482 -by (blast_tac (claset() addIs [leadsTo_Basis, Join_project_ensures]) 1);
   7.483 -val lemma = result();
   7.484 -
   7.485 -Goal "[| ALL D. project h C G : transient D --> D={};  \
   7.486 -\        extend h F Join G : stable C;  \
   7.487 -\        F Join project h C G : (project_set h C Int A) leadsTo B |] \
   7.488 -\     ==> extend h F Join G : (C Int extend_set h A) leadsTo (extend_set h B)";
   7.489 -by (rtac (lemma RS leadsTo_weaken) 1);
   7.490 -by (auto_tac (claset(), simpset() addsimps [split_extended_all]));
   7.491 -qed "project_leadsTo_D_lemma";
   7.492 -
   7.493 -Goal "[| C = (reachable (extend h F Join G)); \
   7.494 -\        ALL D. project h C G : transient D --> D={};  \
   7.495 -\        F Join project h C G : A LeadsTo B |] \
   7.496 -\     ==> extend h F Join G : (extend_set h A) LeadsTo (extend_set h B)";
   7.497 -by (asm_full_simp_tac 
   7.498 -    (simpset_of SubstAx.thy addsimps [LeadsTo_def, project_leadsTo_D_lemma, 
   7.499 -			 project_set_reachable_extend_eq]) 1);
   7.500 -qed "Join_project_LeadsTo";
   7.501 -
   7.502 -
   7.503 -(*** Towards project_Ensures_D ***)
   7.504 -
   7.505 -
   7.506 -Goalw [project_set_def, extend_set_def, project_act_def]
   7.507 -     "act `` (C Int extend_set h A) <= B \
   7.508 -\     ==> project_act h (Restrict C act) `` (project_set h C Int A) \
   7.509 -\         <= project_set h B";
   7.510 -by (Blast_tac 1);
   7.511 -qed "act_subset_imp_project_act_subset";
   7.512 -
   7.513 -(*This trivial proof is the complementation part of transferring a transient
   7.514 -  property upwards.  The hard part would be to 
   7.515 -  show that G's action has a big enough domain.*)
   7.516 -Goal "[| act: Acts G;       \
   7.517 -\        (project_act h (Restrict C act))`` \
   7.518 -\             (project_set h C Int A - B) <= -(project_set h C Int A - B) |] \
   7.519 -\     ==> act``(C Int extend_set h A - extend_set h B) \
   7.520 -\           <= -(C Int extend_set h A - extend_set h B)"; 
   7.521 -by (auto_tac (claset(), 
   7.522 -     simpset() addsimps [project_set_def, extend_set_def, project_act_def]));  
   7.523 -result();
   7.524 -
   7.525 -Goal "[| G : stable ((C Int extend_set h A) - (extend_set h B));  \
   7.526 -\        project h C G : transient (project_set h C Int A - B) |]  \
   7.527 -\     ==> (C Int extend_set h A) - extend_set h B = {}";
   7.528 -by (auto_tac (claset(), 
   7.529 -	      simpset() addsimps [transient_def, subset_Compl_self_eq,
   7.530 -				  Domain_project_act, split_extended_all]));
   7.531 -by (Blast_tac 1);
   7.532 -by (auto_tac (claset(), 
   7.533 -	      simpset() addsimps [stable_def, constrains_def]));
   7.534 -by (ball_tac 1);
   7.535 -by (auto_tac (claset(), 
   7.536 -	      simpset() addsimps [Int_Diff,
   7.537 -				  extend_set_Diff_distrib RS sym]));
   7.538 -by (dtac act_subset_imp_project_act_subset 1);
   7.539 -by (subgoal_tac
   7.540 -    "project_act h (Restrict C act) `` (project_set h C Int (A - B)) = {}" 1);
   7.541 -by (REPEAT (thin_tac "?r``?A <= ?B" 1));
   7.542 -by (rewrite_goals_tac [project_set_def, extend_set_def, project_act_def]);
   7.543 -by (Blast_tac 2);
   7.544 -by (rtac ccontr 1);
   7.545 -by (dtac subsetD 1);
   7.546 -by (Blast_tac 1);
   7.547 -by (force_tac (claset(), simpset() addsimps [split_extended_all]) 1);
   7.548 -qed "stable_project_transient";
   7.549 -
   7.550 -Goal "[| G : stable C;  project h C G : (project_set h C Int A) unless B |] \
   7.551 -\     ==> G : (C Int extend_set h A) unless (extend_set h B)";
   7.552 -by (auto_tac
   7.553 -    (claset() addDs [stable_constrains_Int]
   7.554 -              addIs [constrains_weaken],
   7.555 -     simpset() addsimps [unless_def, project_constrains, Diff_eq, 
   7.556 -			 Int_assoc, Int_extend_set_lemma]));
   7.557 -qed_spec_mp "project_unless2";
   7.558 -
   7.559 -Goal "[| G : stable ((C Int extend_set h A) - (extend_set h B));  \
   7.560 -\        F Join project h C G : (project_set h C Int A) ensures B;  \
   7.561 -\        extend h F Join G : stable C |] \
   7.562 -\     ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)";
   7.563 -(*unless*)
   7.564 -by (auto_tac (claset() addSIs [rewrite_rule [unless_def] project_unless2] 
   7.565 -                       addIs [project_extend_constrains_I], 
   7.566 -	      simpset() addsimps [ensures_def]));
   7.567 -(*transient*)
   7.568 -(*A G-action cannot occur*)
   7.569 -by (force_tac (claset() addDs [stable_project_transient], 
   7.570 -                        simpset() delsimps [Diff_eq_empty_iff]
   7.571 -				 addsimps [Diff_eq_empty_iff RS sym]) 2); 
   7.572 -(*An F-action*)
   7.573 -by (force_tac (claset() addSEs [extend_transient RS iffD2 RS 
   7.574 -				transient_strengthen], 
   7.575 -	       simpset() addsimps [split_extended_all]) 1);
   7.576 -qed "project_ensures_D_lemma";
   7.577 -
   7.578 -Goal "[| F Join project h UNIV G : A ensures B;  \
   7.579 -\        G : stable (extend_set h A - extend_set h B) |] \
   7.580 -\     ==> extend h F Join G : (extend_set h A) ensures (extend_set h B)";
   7.581 -by (rtac (project_ensures_D_lemma RS revcut_rl) 1);
   7.582 -by (stac stable_UNIV 3);
   7.583 -by Auto_tac;
   7.584 -qed "project_ensures_D";
   7.585 -
   7.586 -Goalw [Ensures_def]
   7.587 -     "[| F Join project h (reachable (extend h F Join G)) G : A Ensures B;  \
   7.588 -\        G : stable (reachable (extend h F Join G) Int extend_set h A - \
   7.589 -\                    extend_set h B) |] \
   7.590 -\     ==> extend h F Join G : (extend_set h A) Ensures (extend_set h B)";
   7.591 -by (rtac (project_ensures_D_lemma RS revcut_rl) 1);
   7.592 -by (auto_tac (claset(), 
   7.593 -	      simpset() addsimps [project_set_reachable_extend_eq RS sym]));
   7.594 -qed "project_Ensures_D";
   7.595 -
   7.596 -
   7.597 -(*** Guarantees ***)
   7.598 -
   7.599 -Goal "project_act h (Restrict C act) <= project_act h act";
   7.600 -by (auto_tac (claset(), simpset() addsimps [project_act_def]));
   7.601 -qed "project_act_Restrict_subset_project_act";
   7.602 -					   
   7.603 -							   
   7.604 -Goal "[| extend h F ok G; subset_closed (AllowedActs F) |] \
   7.605 -\     ==> F ok project h C G";
   7.606 -by (auto_tac (claset(), simpset() addsimps [ok_def]));
   7.607 -by (dtac subsetD 1);
   7.608 -by (Blast_tac 1);
   7.609 -by (force_tac (claset() delSWrapper "split_all_tac" addSbefore 
   7.610 -                    ("unsafe_split_all_tac", unsafe_split_all_tac) 
   7.611 -                     addSIs [rev_image_eqI], simpset()) 1);
   7.612 -by (cut_facts_tac [project_act_Restrict_subset_project_act] 1);
   7.613 -by (auto_tac (claset(), simpset() addsimps [subset_closed_def]));
   7.614 -qed "subset_closed_ok_extend_imp_ok_project";
   7.615 -
   7.616 -
   7.617 -(*Weak precondition and postcondition
   7.618 -  Not clear that it has a converse [or that we want one!]*)
   7.619 -
   7.620 -(*The raw version; 3rd premise could be weakened by adding the
   7.621 -  precondition extend h F Join G : X' *)
   7.622 -val [xguary,closed,project,extend] =
   7.623 -Goal "[| F : X guarantees Y;  subset_closed (AllowedActs F);  \
   7.624 -\        !!G. extend h F Join G : X' ==> F Join project h (C G) G : X;  \
   7.625 -\        !!G. [| F Join project h (C G) G : Y |] \
   7.626 -\             ==> extend h F Join G : Y' |] \
   7.627 -\     ==> extend h F : X' guarantees Y'";
   7.628 -by (rtac (xguary RS guaranteesD RS extend RS guaranteesI) 1);
   7.629 -by (blast_tac (claset() addIs [closed, 
   7.630 -          subset_closed_ok_extend_imp_ok_project]) 1); 
   7.631 -by (etac project 1);
   7.632 -qed "project_guarantees_raw";
   7.633 -
   7.634 -Goal "[| F : X guarantees Y;  subset_closed (AllowedActs F); \
   7.635 -\        projecting C h F X' X;  extending C h F Y' Y |] \
   7.636 -\     ==> extend h F : X' guarantees Y'";
   7.637 -by (rtac guaranteesI 1);
   7.638 -by (auto_tac (claset(), 
   7.639 -        simpset() addsimps [guaranteesD, projecting_def, 
   7.640 -                    extending_def, subset_closed_ok_extend_imp_ok_project]));
   7.641 -qed "project_guarantees";
   7.642 -
   7.643 -
   7.644 -(*It seems that neither "guarantees" law can be proved from the other.*)
   7.645 -
   7.646 -
   7.647 -(*** guarantees corollaries ***)
   7.648 -
   7.649 -(** Some could be deleted: the required versions are easy to prove **)
   7.650 -
   7.651 -Goal "[| F : UNIV guarantees increasing func;  \
   7.652 -\        subset_closed (AllowedActs F) |] \
   7.653 -\     ==> extend h F : X' guarantees increasing (func o f)";
   7.654 -by (etac project_guarantees 1);
   7.655 -by (rtac extending_increasing 3);
   7.656 -by (rtac projecting_UNIV 2);
   7.657 -by Auto_tac;
   7.658 -qed "extend_guar_increasing";
   7.659 -
   7.660 -Goal "[| F : UNIV guarantees Increasing func;  \
   7.661 -\        subset_closed (AllowedActs F) |] \
   7.662 -\     ==> extend h F : X' guarantees Increasing (func o f)";
   7.663 -by (etac project_guarantees 1);
   7.664 -by (rtac extending_Increasing 3);
   7.665 -by (rtac projecting_UNIV 2);
   7.666 -by Auto_tac;
   7.667 -qed "extend_guar_Increasing";
   7.668 -
   7.669 -Goal "[| F : Always A guarantees Always B;  \
   7.670 -\        subset_closed (AllowedActs F) |] \
   7.671 -\     ==> extend h F                   \
   7.672 -\           : Always(extend_set h A) guarantees Always(extend_set h B)";
   7.673 -by (etac project_guarantees 1);
   7.674 -by (rtac extending_Always 3);
   7.675 -by (rtac projecting_Always 2);
   7.676 -by Auto_tac;
   7.677 -qed "extend_guar_Always";
   7.678 -
   7.679 -Goal "[| G : preserves f;  project h C G : transient D |] ==> D={}";
   7.680 -by (rtac stable_transient_empty 1);
   7.681 -by (assume_tac 2);
   7.682 -by (blast_tac (claset() addIs [project_preserves_id_I,
   7.683 -			 impOfSubs preserves_id_subset_stable]) 1);
   7.684 -qed "preserves_project_transient_empty";
   7.685 -
   7.686 -
   7.687 -(** Guarantees with a leadsTo postcondition 
   7.688 -    THESE ARE ALL TOO WEAK because G can't affect F's variables at all**)
   7.689 -
   7.690 -Goal "[| F Join project h UNIV G : A leadsTo B;    \
   7.691 -\        G : preserves f |]  \
   7.692 -\     ==> extend h F Join G : (extend_set h A) leadsTo (extend_set h B)";
   7.693 -by (res_inst_tac [("C1", "UNIV")] 
   7.694 -    (project_leadsTo_D_lemma RS leadsTo_weaken) 1);
   7.695 -by (auto_tac (claset() addDs [preserves_project_transient_empty], 
   7.696 -	      simpset()));
   7.697 -qed "project_leadsTo_D";
   7.698 -
   7.699 -Goal "[| F Join project h (reachable (extend h F Join G)) G : A LeadsTo B;    \
   7.700 -\        G : preserves f |]  \
   7.701 -\      ==> extend h F Join G : (extend_set h A) LeadsTo (extend_set h B)";
   7.702 -by (rtac (refl RS Join_project_LeadsTo) 1);
   7.703 -by (auto_tac (claset() addDs [preserves_project_transient_empty], 
   7.704 -	      simpset()));
   7.705 -qed "project_LeadsTo_D";
   7.706 -
   7.707 -Goalw [extending_def]
   7.708 -     "(ALL G. extend h F ok G --> G : preserves f) \
   7.709 -\     ==> extending (%G. UNIV) h F \
   7.710 -\                 (extend_set h A leadsTo extend_set h B) (A leadsTo B)";
   7.711 -by (blast_tac (claset() addIs [project_leadsTo_D]) 1);
   7.712 -qed "extending_leadsTo";
   7.713 -
   7.714 -Goalw [extending_def]
   7.715 -     "(ALL G. extend h F ok G --> G : preserves f) \
   7.716 -\     ==> extending (%G. reachable (extend h F Join G)) h F \
   7.717 -\                 (extend_set h A LeadsTo extend_set h B) (A LeadsTo B)";
   7.718 -by (blast_tac (claset() addIs [project_LeadsTo_D]) 1);
   7.719 -qed "extending_LeadsTo";
   7.720 -
   7.721 -Close_locale "Extend";
     8.1 --- a/src/HOL/UNITY/Project.thy	Tue Jan 28 22:53:39 2003 +0100
     8.2 +++ b/src/HOL/UNITY/Project.thy	Wed Jan 29 11:02:08 2003 +0100
     8.3 @@ -8,7 +8,7 @@
     8.4  Inheritance of GUARANTEES properties under extension
     8.5  *)
     8.6  
     8.7 -Project = Extend +
     8.8 +theory Project = Extend:
     8.9  
    8.10  constdefs
    8.11    projecting :: "['c program => 'c set, 'a*'b => 'c, 
    8.12 @@ -25,4 +25,713 @@
    8.13    subset_closed :: "'a set set => bool"
    8.14      "subset_closed U == ALL A: U. Pow A <= U"  
    8.15  
    8.16 +
    8.17 +lemma (in Extend) project_extend_constrains_I:
    8.18 +     "F : A co B ==> project h C (extend h F) : A co B"
    8.19 +apply (auto simp add: extend_act_def project_act_def constrains_def)
    8.20 +done
    8.21 +
    8.22 +
    8.23 +(** Safety **)
    8.24 +
    8.25 +(*used below to prove Join_project_ensures*)
    8.26 +lemma (in Extend) project_unless [rule_format (no_asm)]:
    8.27 +     "[| G : stable C;  project h C G : A unless B |]  
    8.28 +      ==> G : (C Int extend_set h A) unless (extend_set h B)"
    8.29 +apply (simp add: unless_def project_constrains)
    8.30 +apply (blast dest: stable_constrains_Int intro: constrains_weaken)
    8.31 +done
    8.32 +
    8.33 +(*Generalizes project_constrains to the program F Join project h C G
    8.34 +  useful with guarantees reasoning*)
    8.35 +lemma (in Extend) Join_project_constrains:
    8.36 +     "(F Join project h C G : A co B)  =   
    8.37 +        (extend h F Join G : (C Int extend_set h A) co (extend_set h B) &   
    8.38 +         F : A co B)"
    8.39 +apply (simp (no_asm) add: project_constrains)
    8.40 +apply (blast intro: extend_constrains [THEN iffD2, THEN constrains_weaken] 
    8.41 +             dest: constrains_imp_subset)
    8.42 +done
    8.43 +
    8.44 +(*The condition is required to prove the left-to-right direction
    8.45 +  could weaken it to G : (C Int extend_set h A) co C*)
    8.46 +lemma (in Extend) Join_project_stable: 
    8.47 +     "extend h F Join G : stable C  
    8.48 +      ==> (F Join project h C G : stable A)  =   
    8.49 +          (extend h F Join G : stable (C Int extend_set h A) &   
    8.50 +           F : stable A)"
    8.51 +apply (unfold stable_def)
    8.52 +apply (simp only: Join_project_constrains)
    8.53 +apply (blast intro: constrains_weaken dest: constrains_Int)
    8.54 +done
    8.55 +
    8.56 +(*For using project_guarantees in particular cases*)
    8.57 +lemma (in Extend) project_constrains_I:
    8.58 +     "extend h F Join G : extend_set h A co extend_set h B  
    8.59 +      ==> F Join project h C G : A co B"
    8.60 +apply (simp add: project_constrains extend_constrains)
    8.61 +apply (blast intro: constrains_weaken dest: constrains_imp_subset)
    8.62 +done
    8.63 +
    8.64 +lemma (in Extend) project_increasing_I: 
    8.65 +     "extend h F Join G : increasing (func o f)  
    8.66 +      ==> F Join project h C G : increasing func"
    8.67 +apply (unfold increasing_def stable_def)
    8.68 +apply (simp del: Join_constrains
    8.69 +            add: project_constrains_I extend_set_eq_Collect)
    8.70 +done
    8.71 +
    8.72 +lemma (in Extend) Join_project_increasing:
    8.73 +     "(F Join project h UNIV G : increasing func)  =   
    8.74 +      (extend h F Join G : increasing (func o f))"
    8.75 +apply (rule iffI)
    8.76 +apply (erule_tac [2] project_increasing_I)
    8.77 +apply (simp del: Join_stable
    8.78 +            add: increasing_def Join_project_stable)
    8.79 +apply (auto simp add: extend_set_eq_Collect extend_stable [THEN iffD1])
    8.80 +done
    8.81 +
    8.82 +(*The UNIV argument is essential*)
    8.83 +lemma (in Extend) project_constrains_D:
    8.84 +     "F Join project h UNIV G : A co B  
    8.85 +      ==> extend h F Join G : extend_set h A co extend_set h B"
    8.86 +by (simp add: project_constrains extend_constrains)
    8.87 +
    8.88 +
    8.89 +(*** "projecting" and union/intersection (no converses) ***)
    8.90 +
    8.91 +lemma projecting_Int: 
    8.92 +     "[| projecting C h F XA' XA;  projecting C h F XB' XB |]  
    8.93 +      ==> projecting C h F (XA' Int XB') (XA Int XB)"
    8.94 +by (unfold projecting_def, blast)
    8.95 +
    8.96 +lemma projecting_Un: 
    8.97 +     "[| projecting C h F XA' XA;  projecting C h F XB' XB |]  
    8.98 +      ==> projecting C h F (XA' Un XB') (XA Un XB)"
    8.99 +by (unfold projecting_def, blast)
   8.100 +
   8.101 +lemma projecting_INT: 
   8.102 +     "[| !!i. i:I ==> projecting C h F (X' i) (X i) |]  
   8.103 +      ==> projecting C h F (INT i:I. X' i) (INT i:I. X i)"
   8.104 +by (unfold projecting_def, blast)
   8.105 +
   8.106 +lemma projecting_UN: 
   8.107 +     "[| !!i. i:I ==> projecting C h F (X' i) (X i) |]  
   8.108 +      ==> projecting C h F (UN i:I. X' i) (UN i:I. X i)"
   8.109 +by (unfold projecting_def, blast)
   8.110 +
   8.111 +lemma projecting_weaken: 
   8.112 +     "[| projecting C h F X' X;  U'<=X';  X<=U |] ==> projecting C h F U' U"
   8.113 +by (unfold projecting_def, auto)
   8.114 +
   8.115 +lemma projecting_weaken_L: 
   8.116 +     "[| projecting C h F X' X;  U'<=X' |] ==> projecting C h F U' X"
   8.117 +by (unfold projecting_def, auto)
   8.118 +
   8.119 +lemma extending_Int: 
   8.120 +     "[| extending C h F YA' YA;  extending C h F YB' YB |]  
   8.121 +      ==> extending C h F (YA' Int YB') (YA Int YB)"
   8.122 +by (unfold extending_def, blast)
   8.123 +
   8.124 +lemma extending_Un: 
   8.125 +     "[| extending C h F YA' YA;  extending C h F YB' YB |]  
   8.126 +      ==> extending C h F (YA' Un YB') (YA Un YB)"
   8.127 +by (unfold extending_def, blast)
   8.128 +
   8.129 +lemma extending_INT: 
   8.130 +     "[| !!i. i:I ==> extending C h F (Y' i) (Y i) |]  
   8.131 +      ==> extending C h F (INT i:I. Y' i) (INT i:I. Y i)"
   8.132 +by (unfold extending_def, blast)
   8.133 +
   8.134 +lemma extending_UN: 
   8.135 +     "[| !!i. i:I ==> extending C h F (Y' i) (Y i) |]  
   8.136 +      ==> extending C h F (UN i:I. Y' i) (UN i:I. Y i)"
   8.137 +by (unfold extending_def, blast)
   8.138 +
   8.139 +lemma extending_weaken: 
   8.140 +     "[| extending C h F Y' Y;  Y'<=V';  V<=Y |] ==> extending C h F V' V"
   8.141 +by (unfold extending_def, auto)
   8.142 +
   8.143 +lemma extending_weaken_L: 
   8.144 +     "[| extending C h F Y' Y;  Y'<=V' |] ==> extending C h F V' Y"
   8.145 +by (unfold extending_def, auto)
   8.146 +
   8.147 +lemma projecting_UNIV: "projecting C h F X' UNIV"
   8.148 +by (simp add: projecting_def)
   8.149 +
   8.150 +lemma (in Extend) projecting_constrains: 
   8.151 +     "projecting C h F (extend_set h A co extend_set h B) (A co B)"
   8.152 +apply (unfold projecting_def)
   8.153 +apply (blast intro: project_constrains_I)
   8.154 +done
   8.155 +
   8.156 +lemma (in Extend) projecting_stable: 
   8.157 +     "projecting C h F (stable (extend_set h A)) (stable A)"
   8.158 +apply (unfold stable_def)
   8.159 +apply (rule projecting_constrains)
   8.160 +done
   8.161 +
   8.162 +lemma (in Extend) projecting_increasing: 
   8.163 +     "projecting C h F (increasing (func o f)) (increasing func)"
   8.164 +apply (unfold projecting_def)
   8.165 +apply (blast intro: project_increasing_I)
   8.166 +done
   8.167 +
   8.168 +lemma (in Extend) extending_UNIV: "extending C h F UNIV Y"
   8.169 +apply (simp (no_asm) add: extending_def)
   8.170 +done
   8.171 +
   8.172 +lemma (in Extend) extending_constrains: 
   8.173 +     "extending (%G. UNIV) h F (extend_set h A co extend_set h B) (A co B)"
   8.174 +apply (unfold extending_def)
   8.175 +apply (blast intro: project_constrains_D)
   8.176 +done
   8.177 +
   8.178 +lemma (in Extend) extending_stable: 
   8.179 +     "extending (%G. UNIV) h F (stable (extend_set h A)) (stable A)"
   8.180 +apply (unfold stable_def)
   8.181 +apply (rule extending_constrains)
   8.182 +done
   8.183 +
   8.184 +lemma (in Extend) extending_increasing: 
   8.185 +     "extending (%G. UNIV) h F (increasing (func o f)) (increasing func)"
   8.186 +by (force simp only: extending_def Join_project_increasing)
   8.187 +
   8.188 +
   8.189 +(** Reachability and project **)
   8.190 +
   8.191 +(*In practice, C = reachable(...): the inclusion is equality*)
   8.192 +lemma (in Extend) reachable_imp_reachable_project:
   8.193 +     "[| reachable (extend h F Join G) <= C;   
   8.194 +         z : reachable (extend h F Join G) |]  
   8.195 +      ==> f z : reachable (F Join project h C G)"
   8.196 +apply (erule reachable.induct)
   8.197 +apply (force intro!: reachable.Init simp add: split_extended_all, auto)
   8.198 + apply (rule_tac act = x in reachable.Acts)
   8.199 + apply auto
   8.200 + apply (erule extend_act_D)
   8.201 +apply (rule_tac act1 = "Restrict C act"
   8.202 +       in project_act_I [THEN [3] reachable.Acts], auto) 
   8.203 +done
   8.204 +
   8.205 +lemma (in Extend) project_Constrains_D: 
   8.206 +     "F Join project h (reachable (extend h F Join G)) G : A Co B   
   8.207 +      ==> extend h F Join G : (extend_set h A) Co (extend_set h B)"
   8.208 +apply (unfold Constrains_def)
   8.209 +apply (simp del: Join_constrains
   8.210 +            add: Join_project_constrains, clarify)
   8.211 +apply (erule constrains_weaken)
   8.212 +apply (auto intro: reachable_imp_reachable_project)
   8.213 +done
   8.214 +
   8.215 +lemma (in Extend) project_Stable_D: 
   8.216 +     "F Join project h (reachable (extend h F Join G)) G : Stable A   
   8.217 +      ==> extend h F Join G : Stable (extend_set h A)"
   8.218 +apply (unfold Stable_def)
   8.219 +apply (simp (no_asm_simp) add: project_Constrains_D)
   8.220 +done
   8.221 +
   8.222 +lemma (in Extend) project_Always_D: 
   8.223 +     "F Join project h (reachable (extend h F Join G)) G : Always A   
   8.224 +      ==> extend h F Join G : Always (extend_set h A)"
   8.225 +apply (unfold Always_def)
   8.226 +apply (force intro: reachable.Init simp add: project_Stable_D split_extended_all)
   8.227 +done
   8.228 +
   8.229 +lemma (in Extend) project_Increasing_D: 
   8.230 +     "F Join project h (reachable (extend h F Join G)) G : Increasing func   
   8.231 +      ==> extend h F Join G : Increasing (func o f)"
   8.232 +apply (unfold Increasing_def, auto)
   8.233 +apply (subst extend_set_eq_Collect [symmetric])
   8.234 +apply (simp (no_asm_simp) add: project_Stable_D)
   8.235 +done
   8.236 +
   8.237 +
   8.238 +(** Converse results for weak safety: benefits of the argument C *)
   8.239 +
   8.240 +(*In practice, C = reachable(...): the inclusion is equality*)
   8.241 +lemma (in Extend) reachable_project_imp_reachable:
   8.242 +     "[| C <= reachable(extend h F Join G);    
   8.243 +         x : reachable (F Join project h C G) |]  
   8.244 +      ==> EX y. h(x,y) : reachable (extend h F Join G)"
   8.245 +apply (erule reachable.induct)
   8.246 +apply  (force intro: reachable.Init)
   8.247 +apply (auto simp add: project_act_def)
   8.248 +apply (force del: Id_in_Acts intro: reachable.Acts extend_act_D)+
   8.249 +done
   8.250 +
   8.251 +lemma (in Extend) project_set_reachable_extend_eq:
   8.252 +     "project_set h (reachable (extend h F Join G)) =  
   8.253 +      reachable (F Join project h (reachable (extend h F Join G)) G)"
   8.254 +by (auto dest: subset_refl [THEN reachable_imp_reachable_project] 
   8.255 +               subset_refl [THEN reachable_project_imp_reachable])
   8.256 +
   8.257 +(*UNUSED*)
   8.258 +lemma (in Extend) reachable_extend_Join_subset:
   8.259 +     "reachable (extend h F Join G) <= C   
   8.260 +      ==> reachable (extend h F Join G) <=  
   8.261 +          extend_set h (reachable (F Join project h C G))"
   8.262 +apply (auto dest: reachable_imp_reachable_project)
   8.263 +done
   8.264 +
   8.265 +lemma (in Extend) project_Constrains_I: 
   8.266 +     "extend h F Join G : (extend_set h A) Co (extend_set h B)   
   8.267 +      ==> F Join project h (reachable (extend h F Join G)) G : A Co B"
   8.268 +apply (unfold Constrains_def)
   8.269 +apply (simp del: Join_constrains
   8.270 +            add: Join_project_constrains extend_set_Int_distrib)
   8.271 +apply (rule conjI)
   8.272 + prefer 2 
   8.273 + apply (force elim: constrains_weaken_L
   8.274 +              dest!: extend_constrains_project_set
   8.275 +                     subset_refl [THEN reachable_project_imp_reachable])
   8.276 +apply (blast intro: constrains_weaken_L)
   8.277 +done
   8.278 +
   8.279 +lemma (in Extend) project_Stable_I: 
   8.280 +     "extend h F Join G : Stable (extend_set h A)   
   8.281 +      ==> F Join project h (reachable (extend h F Join G)) G : Stable A"
   8.282 +apply (unfold Stable_def)
   8.283 +apply (simp (no_asm_simp) add: project_Constrains_I)
   8.284 +done
   8.285 +
   8.286 +lemma (in Extend) project_Always_I: 
   8.287 +     "extend h F Join G : Always (extend_set h A)   
   8.288 +      ==> F Join project h (reachable (extend h F Join G)) G : Always A"
   8.289 +apply (unfold Always_def)
   8.290 +apply (auto simp add: project_Stable_I)
   8.291 +apply (unfold extend_set_def, blast)
   8.292 +done
   8.293 +
   8.294 +lemma (in Extend) project_Increasing_I: 
   8.295 +    "extend h F Join G : Increasing (func o f)   
   8.296 +     ==> F Join project h (reachable (extend h F Join G)) G : Increasing func"
   8.297 +apply (unfold Increasing_def, auto)
   8.298 +apply (simp (no_asm_simp) add: extend_set_eq_Collect project_Stable_I)
   8.299 +done
   8.300 +
   8.301 +lemma (in Extend) project_Constrains:
   8.302 +     "(F Join project h (reachable (extend h F Join G)) G : A Co B)  =   
   8.303 +      (extend h F Join G : (extend_set h A) Co (extend_set h B))"
   8.304 +apply (blast intro: project_Constrains_I project_Constrains_D)
   8.305 +done
   8.306 +
   8.307 +lemma (in Extend) project_Stable: 
   8.308 +     "(F Join project h (reachable (extend h F Join G)) G : Stable A)  =   
   8.309 +      (extend h F Join G : Stable (extend_set h A))"
   8.310 +apply (unfold Stable_def)
   8.311 +apply (rule project_Constrains)
   8.312 +done
   8.313 +
   8.314 +lemma (in Extend) project_Increasing: 
   8.315 +   "(F Join project h (reachable (extend h F Join G)) G : Increasing func)  =  
   8.316 +    (extend h F Join G : Increasing (func o f))"
   8.317 +apply (simp (no_asm_simp) add: Increasing_def project_Stable extend_set_eq_Collect)
   8.318 +done
   8.319 +
   8.320 +(** A lot of redundant theorems: all are proved to facilitate reasoning
   8.321 +    about guarantees. **)
   8.322 +
   8.323 +lemma (in Extend) projecting_Constrains: 
   8.324 +     "projecting (%G. reachable (extend h F Join G)) h F  
   8.325 +                 (extend_set h A Co extend_set h B) (A Co B)"
   8.326 +
   8.327 +apply (unfold projecting_def)
   8.328 +apply (blast intro: project_Constrains_I)
   8.329 +done
   8.330 +
   8.331 +lemma (in Extend) projecting_Stable: 
   8.332 +     "projecting (%G. reachable (extend h F Join G)) h F  
   8.333 +                 (Stable (extend_set h A)) (Stable A)"
   8.334 +apply (unfold Stable_def)
   8.335 +apply (rule projecting_Constrains)
   8.336 +done
   8.337 +
   8.338 +lemma (in Extend) projecting_Always: 
   8.339 +     "projecting (%G. reachable (extend h F Join G)) h F  
   8.340 +                 (Always (extend_set h A)) (Always A)"
   8.341 +apply (unfold projecting_def)
   8.342 +apply (blast intro: project_Always_I)
   8.343 +done
   8.344 +
   8.345 +lemma (in Extend) projecting_Increasing: 
   8.346 +     "projecting (%G. reachable (extend h F Join G)) h F  
   8.347 +                 (Increasing (func o f)) (Increasing func)"
   8.348 +apply (unfold projecting_def)
   8.349 +apply (blast intro: project_Increasing_I)
   8.350 +done
   8.351 +
   8.352 +lemma (in Extend) extending_Constrains: 
   8.353 +     "extending (%G. reachable (extend h F Join G)) h F  
   8.354 +                  (extend_set h A Co extend_set h B) (A Co B)"
   8.355 +apply (unfold extending_def)
   8.356 +apply (blast intro: project_Constrains_D)
   8.357 +done
   8.358 +
   8.359 +lemma (in Extend) extending_Stable: 
   8.360 +     "extending (%G. reachable (extend h F Join G)) h F  
   8.361 +                  (Stable (extend_set h A)) (Stable A)"
   8.362 +apply (unfold extending_def)
   8.363 +apply (blast intro: project_Stable_D)
   8.364 +done
   8.365 +
   8.366 +lemma (in Extend) extending_Always: 
   8.367 +     "extending (%G. reachable (extend h F Join G)) h F  
   8.368 +                  (Always (extend_set h A)) (Always A)"
   8.369 +apply (unfold extending_def)
   8.370 +apply (blast intro: project_Always_D)
   8.371 +done
   8.372 +
   8.373 +lemma (in Extend) extending_Increasing: 
   8.374 +     "extending (%G. reachable (extend h F Join G)) h F  
   8.375 +                  (Increasing (func o f)) (Increasing func)"
   8.376 +apply (unfold extending_def)
   8.377 +apply (blast intro: project_Increasing_D)
   8.378 +done
   8.379 +
   8.380 +
   8.381 +(*** leadsETo in the precondition (??) ***)
   8.382 +
   8.383 +(** transient **)
   8.384 +
   8.385 +lemma (in Extend) transient_extend_set_imp_project_transient: 
   8.386 +     "[| G : transient (C Int extend_set h A);  G : stable C |]   
   8.387 +      ==> project h C G : transient (project_set h C Int A)"
   8.388 +
   8.389 +apply (unfold transient_def)
   8.390 +apply (auto simp add: Domain_project_act)
   8.391 +apply (subgoal_tac "act `` (C Int extend_set h A) <= - extend_set h A")
   8.392 +prefer 2
   8.393 + apply (simp add: stable_def constrains_def, blast) 
   8.394 +(*back to main goal*)
   8.395 +apply (erule_tac V = "?AA <= -C Un ?BB" in thin_rl)
   8.396 +apply (drule bspec, assumption) 
   8.397 +apply (simp add: extend_set_def project_act_def, blast)
   8.398 +done
   8.399 +
   8.400 +(*converse might hold too?*)
   8.401 +lemma (in Extend) project_extend_transient_D: 
   8.402 +     "project h C (extend h F) : transient (project_set h C Int D)  
   8.403 +      ==> F : transient (project_set h C Int D)"
   8.404 +apply (unfold transient_def)
   8.405 +apply (auto simp add: Domain_project_act)
   8.406 +apply (rule bexI)
   8.407 +prefer 2 apply assumption
   8.408 +apply auto
   8.409 +apply (unfold extend_act_def, blast)
   8.410 +done
   8.411 +
   8.412 +
   8.413 +(** ensures -- a primitive combining progress with safety **)
   8.414 +
   8.415 +(*Used to prove project_leadsETo_I*)
   8.416 +lemma (in Extend) ensures_extend_set_imp_project_ensures:
   8.417 +     "[| extend h F : stable C;  G : stable C;   
   8.418 +         extend h F Join G : A ensures B;  A-B = C Int extend_set h D |]   
   8.419 +      ==> F Join project h C G   
   8.420 +            : (project_set h C Int project_set h A) ensures (project_set h B)"
   8.421 +apply (simp add: ensures_def project_constrains Join_transient extend_transient, clarify)
   8.422 +apply (intro conjI) 
   8.423 +(*first subgoal*)
   8.424 +apply (blast intro: extend_stable_project_set 
   8.425 +                  [THEN stableD, THEN constrains_Int, THEN constrains_weaken] 
   8.426 +             dest!: extend_constrains_project_set equalityD1)
   8.427 +(*2nd subgoal*)
   8.428 +apply (erule stableD [THEN constrains_Int, THEN constrains_weaken])
   8.429 +    apply assumption
   8.430 +   apply (simp (no_asm_use) add: extend_set_def)
   8.431 +   apply blast
   8.432 + apply (simp add: extend_set_Int_distrib extend_set_Un_distrib)
   8.433 + apply (blast intro!: extend_set_project_set [THEN subsetD], blast)
   8.434 +(*The transient part*)
   8.435 +apply auto
   8.436 + prefer 2
   8.437 + apply (force dest!: equalityD1
   8.438 +              intro: transient_extend_set_imp_project_transient
   8.439 +                         [THEN transient_strengthen])
   8.440 +apply (simp (no_asm_use) add: Int_Diff)
   8.441 +apply (force dest!: equalityD1 
   8.442 +             intro: transient_extend_set_imp_project_transient 
   8.443 +               [THEN project_extend_transient_D, THEN transient_strengthen])
   8.444 +done
   8.445 +
   8.446 +(*Used to prove project_leadsETo_D*)
   8.447 +lemma (in Extend) Join_project_ensures [rule_format (no_asm)]:
   8.448 +     "[| project h C G ~: transient (A-B) | A<=B;   
   8.449 +         extend h F Join G : stable C;   
   8.450 +         F Join project h C G : A ensures B |]  
   8.451 +      ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)"
   8.452 +apply (erule disjE)
   8.453 +prefer 2 apply (blast intro: subset_imp_ensures)
   8.454 +apply (auto dest: extend_transient [THEN iffD2]
   8.455 +            intro: transient_strengthen project_set_I
   8.456 +                   project_unless [THEN unlessD] unlessI 
   8.457 +                   project_extend_constrains_I 
   8.458 +            simp add: ensures_def Join_transient)
   8.459 +done
   8.460 +
   8.461 +(** Lemma useful for both STRONG and WEAK progress, but the transient
   8.462 +    condition's very strong **)
   8.463 +
   8.464 +(*The strange induction formula allows induction over the leadsTo
   8.465 +  assumption's non-atomic precondition*)
   8.466 +lemma (in Extend) PLD_lemma:
   8.467 +     "[| ALL D. project h C G : transient D --> D={};   
   8.468 +         extend h F Join G : stable C;   
   8.469 +         F Join project h C G : (project_set h C Int A) leadsTo B |]  
   8.470 +      ==> extend h F Join G :  
   8.471 +          C Int extend_set h (project_set h C Int A) leadsTo (extend_set h B)"
   8.472 +apply (erule leadsTo_induct)
   8.473 +  apply (blast intro: leadsTo_Basis Join_project_ensures)
   8.474 + apply (blast intro: psp_stable2 [THEN leadsTo_weaken_L] leadsTo_Trans)
   8.475 +apply (simp del: UN_simps add: Int_UN_distrib leadsTo_UN extend_set_Union)
   8.476 +done
   8.477 +
   8.478 +lemma (in Extend) project_leadsTo_D_lemma:
   8.479 +     "[| ALL D. project h C G : transient D --> D={};   
   8.480 +         extend h F Join G : stable C;   
   8.481 +         F Join project h C G : (project_set h C Int A) leadsTo B |]  
   8.482 +      ==> extend h F Join G : (C Int extend_set h A) leadsTo (extend_set h B)"
   8.483 +apply (rule PLD_lemma [THEN leadsTo_weaken])
   8.484 +apply (auto simp add: split_extended_all)
   8.485 +done
   8.486 +
   8.487 +lemma (in Extend) Join_project_LeadsTo:
   8.488 +     "[| C = (reachable (extend h F Join G));  
   8.489 +         ALL D. project h C G : transient D --> D={};   
   8.490 +         F Join project h C G : A LeadsTo B |]  
   8.491 +      ==> extend h F Join G : (extend_set h A) LeadsTo (extend_set h B)"
   8.492 +by (simp del: Join_stable    add: LeadsTo_def project_leadsTo_D_lemma
   8.493 +                                  project_set_reachable_extend_eq)
   8.494 +
   8.495 +
   8.496 +(*** Towards project_Ensures_D ***)
   8.497 +
   8.498 +
   8.499 +lemma (in Extend) act_subset_imp_project_act_subset: 
   8.500 +     "act `` (C Int extend_set h A) <= B  
   8.501 +      ==> project_act h (Restrict C act) `` (project_set h C Int A)  
   8.502 +          <= project_set h B"
   8.503 +apply (unfold project_set_def extend_set_def project_act_def, blast)
   8.504 +done
   8.505 +
   8.506 +(*This trivial proof is the complementation part of transferring a transient
   8.507 +  property upwards.  The hard part would be to 
   8.508 +  show that G's action has a big enough domain.*)
   8.509 +lemma (in Extend) 
   8.510 +     "[| act: Acts G;        
   8.511 +         (project_act h (Restrict C act))``  
   8.512 +              (project_set h C Int A - B) <= -(project_set h C Int A - B) |]  
   8.513 +      ==> act``(C Int extend_set h A - extend_set h B)  
   8.514 +            <= -(C Int extend_set h A - extend_set h B)"
   8.515 +by (auto simp add: project_set_def extend_set_def project_act_def)
   8.516 +
   8.517 +lemma (in Extend) stable_project_transient:
   8.518 +     "[| G : stable ((C Int extend_set h A) - (extend_set h B));   
   8.519 +         project h C G : transient (project_set h C Int A - B) |]   
   8.520 +      ==> (C Int extend_set h A) - extend_set h B = {}"
   8.521 +apply (auto simp add: transient_def subset_Compl_self_eq Domain_project_act split_extended_all, blast)
   8.522 +apply (auto simp add: stable_def constrains_def)
   8.523 +apply (drule bspec, assumption) 
   8.524 +apply (auto simp add: Int_Diff extend_set_Diff_distrib [symmetric])
   8.525 +apply (drule act_subset_imp_project_act_subset)
   8.526 +apply (subgoal_tac "project_act h (Restrict C act) `` (project_set h C Int (A - B)) = {}")
   8.527 +apply (erule_tac V = "?r``?A <= ?B" in thin_rl)+
   8.528 +apply (unfold project_set_def extend_set_def project_act_def)
   8.529 +prefer 2 apply blast
   8.530 +apply (rule ccontr)
   8.531 +apply (drule subsetD, blast)
   8.532 +apply (force simp add: split_extended_all)
   8.533 +done
   8.534 +
   8.535 +lemma (in Extend) project_unless2 [rule_format (no_asm)]:
   8.536 +     "[| G : stable C;  project h C G : (project_set h C Int A) unless B |]  
   8.537 +      ==> G : (C Int extend_set h A) unless (extend_set h B)"
   8.538 +by (auto dest: stable_constrains_Int intro: constrains_weaken
   8.539 +         simp add: unless_def project_constrains Diff_eq Int_assoc 
   8.540 +                   Int_extend_set_lemma)
   8.541 +
   8.542 +lemma (in Extend) project_ensures_D_lemma:
   8.543 +     "[| G : stable ((C Int extend_set h A) - (extend_set h B));   
   8.544 +         F Join project h C G : (project_set h C Int A) ensures B;   
   8.545 +         extend h F Join G : stable C |]  
   8.546 +      ==> extend h F Join G : (C Int extend_set h A) ensures (extend_set h B)"
   8.547 +(*unless*)
   8.548 +apply (auto intro!: project_unless2 [unfolded unless_def] 
   8.549 +            intro: project_extend_constrains_I 
   8.550 +            simp add: ensures_def)
   8.551 +(*transient*)
   8.552 +(*A G-action cannot occur*)
   8.553 + prefer 2
   8.554 + apply (force dest: stable_project_transient 
   8.555 +              simp del: Diff_eq_empty_iff
   8.556 +              simp add: Diff_eq_empty_iff [symmetric])
   8.557 +(*An F-action*)
   8.558 +apply (force elim!: extend_transient [THEN iffD2, THEN transient_strengthen]
   8.559 +             simp add: split_extended_all)
   8.560 +done
   8.561 +
   8.562 +lemma (in Extend) project_ensures_D:
   8.563 +     "[| F Join project h UNIV G : A ensures B;   
   8.564 +         G : stable (extend_set h A - extend_set h B) |]  
   8.565 +      ==> extend h F Join G : (extend_set h A) ensures (extend_set h B)"
   8.566 +apply (rule project_ensures_D_lemma [of _ UNIV, THEN revcut_rl], auto)
   8.567 +done
   8.568 +
   8.569 +lemma (in Extend) project_Ensures_D: 
   8.570 +     "[| F Join project h (reachable (extend h F Join G)) G : A Ensures B;   
   8.571 +         G : stable (reachable (extend h F Join G) Int extend_set h A -  
   8.572 +                     extend_set h B) |]  
   8.573 +      ==> extend h F Join G : (extend_set h A) Ensures (extend_set h B)"
   8.574 +apply (unfold Ensures_def)
   8.575 +apply (rule project_ensures_D_lemma [THEN revcut_rl])
   8.576 +apply (auto simp add: project_set_reachable_extend_eq [symmetric])
   8.577 +done
   8.578 +
   8.579 +
   8.580 +(*** Guarantees ***)
   8.581 +
   8.582 +lemma (in Extend) project_act_Restrict_subset_project_act:
   8.583 +     "project_act h (Restrict C act) <= project_act h act"
   8.584 +apply (auto simp add: project_act_def)
   8.585 +done
   8.586 +					   
   8.587 +							   
   8.588 +lemma (in Extend) subset_closed_ok_extend_imp_ok_project:
   8.589 +     "[| extend h F ok G; subset_closed (AllowedActs F) |]  
   8.590 +      ==> F ok project h C G"
   8.591 +apply (auto simp add: ok_def)
   8.592 +apply (rename_tac act) 
   8.593 +apply (drule subsetD, blast)
   8.594 +apply (rule_tac x = "Restrict C  (extend_act h act)" in rev_image_eqI)
   8.595 +apply simp +
   8.596 +apply (cut_tac project_act_Restrict_subset_project_act)
   8.597 +apply (auto simp add: subset_closed_def)
   8.598 +done
   8.599 +
   8.600 +
   8.601 +(*Weak precondition and postcondition
   8.602 +  Not clear that it has a converse [or that we want one!]*)
   8.603 +
   8.604 +(*The raw version; 3rd premise could be weakened by adding the
   8.605 +  precondition extend h F Join G : X' *)
   8.606 +lemma (in Extend) project_guarantees_raw:
   8.607 + assumes xguary:  "F : X guarantees Y"
   8.608 +     and closed:  "subset_closed (AllowedActs F)"
   8.609 +     and project: "!!G. extend h F Join G : X' 
   8.610 +                        ==> F Join project h (C G) G : X"
   8.611 +     and extend:  "!!G. [| F Join project h (C G) G : Y |]  
   8.612 +                        ==> extend h F Join G : Y'"
   8.613 + shows "extend h F : X' guarantees Y'"
   8.614 +apply (rule xguary [THEN guaranteesD, THEN extend, THEN guaranteesI])
   8.615 +apply (blast intro: closed subset_closed_ok_extend_imp_ok_project)
   8.616 +apply (erule project)
   8.617 +done
   8.618 +
   8.619 +lemma (in Extend) project_guarantees:
   8.620 +     "[| F : X guarantees Y;  subset_closed (AllowedActs F);  
   8.621 +         projecting C h F X' X;  extending C h F Y' Y |]  
   8.622 +      ==> extend h F : X' guarantees Y'"
   8.623 +apply (rule guaranteesI)
   8.624 +apply (auto simp add: guaranteesD projecting_def extending_def
   8.625 +                      subset_closed_ok_extend_imp_ok_project)
   8.626 +done
   8.627 +
   8.628 +
   8.629 +(*It seems that neither "guarantees" law can be proved from the other.*)
   8.630 +
   8.631 +
   8.632 +(*** guarantees corollaries ***)
   8.633 +
   8.634 +(** Some could be deleted: the required versions are easy to prove **)
   8.635 +
   8.636 +lemma (in Extend) extend_guar_increasing:
   8.637 +     "[| F : UNIV guarantees increasing func;   
   8.638 +         subset_closed (AllowedActs F) |]  
   8.639 +      ==> extend h F : X' guarantees increasing (func o f)"
   8.640 +apply (erule project_guarantees)
   8.641 +apply (rule_tac [3] extending_increasing)
   8.642 +apply (rule_tac [2] projecting_UNIV, auto)
   8.643 +done
   8.644 +
   8.645 +lemma (in Extend) extend_guar_Increasing:
   8.646 +     "[| F : UNIV guarantees Increasing func;   
   8.647 +         subset_closed (AllowedActs F) |]  
   8.648 +      ==> extend h F : X' guarantees Increasing (func o f)"
   8.649 +apply (erule project_guarantees)
   8.650 +apply (rule_tac [3] extending_Increasing)
   8.651 +apply (rule_tac [2] projecting_UNIV, auto)
   8.652 +done
   8.653 +
   8.654 +lemma (in Extend) extend_guar_Always:
   8.655 +     "[| F : Always A guarantees Always B;   
   8.656 +         subset_closed (AllowedActs F) |]  
   8.657 +      ==> extend h F                    
   8.658 +            : Always(extend_set h A) guarantees Always(extend_set h B)"
   8.659 +apply (erule project_guarantees)
   8.660 +apply (rule_tac [3] extending_Always)
   8.661 +apply (rule_tac [2] projecting_Always, auto)
   8.662 +done
   8.663 +
   8.664 +lemma (in Extend) preserves_project_transient_empty:
   8.665 +     "[| G : preserves f;  project h C G : transient D |] ==> D={}"
   8.666 +apply (rule stable_transient_empty)
   8.667 + prefer 2 apply assumption
   8.668 +apply (blast intro: project_preserves_id_I 
   8.669 +                    preserves_id_subset_stable [THEN subsetD])
   8.670 +done
   8.671 +
   8.672 +
   8.673 +(** Guarantees with a leadsTo postcondition 
   8.674 +    THESE ARE ALL TOO WEAK because G can't affect F's variables at all**)
   8.675 +
   8.676 +lemma (in Extend) project_leadsTo_D:
   8.677 +     "[| F Join project h UNIV G : A leadsTo B;     
   8.678 +         G : preserves f |]   
   8.679 +      ==> extend h F Join G : (extend_set h A) leadsTo (extend_set h B)"
   8.680 +apply (rule_tac C1 = UNIV in project_leadsTo_D_lemma [THEN leadsTo_weaken])
   8.681 +apply (auto dest: preserves_project_transient_empty)
   8.682 +done
   8.683 +
   8.684 +lemma (in Extend) project_LeadsTo_D:
   8.685 +     "[| F Join project h (reachable (extend h F Join G)) G : A LeadsTo B;
   8.686 +         G : preserves f |]   
   8.687 +       ==> extend h F Join G : (extend_set h A) LeadsTo (extend_set h B)"
   8.688 +apply (rule refl [THEN Join_project_LeadsTo])
   8.689 +apply (auto dest: preserves_project_transient_empty)
   8.690 +done
   8.691 +
   8.692 +lemma (in Extend) extending_leadsTo: 
   8.693 +     "(ALL G. extend h F ok G --> G : preserves f)  
   8.694 +      ==> extending (%G. UNIV) h F  
   8.695 +                  (extend_set h A leadsTo extend_set h B) (A leadsTo B)"
   8.696 +apply (unfold extending_def)
   8.697 +apply (blast intro: project_leadsTo_D)
   8.698 +done
   8.699 +
   8.700 +lemma (in Extend) extending_LeadsTo: 
   8.701 +     "(ALL G. extend h F ok G --> G : preserves f)  
   8.702 +      ==> extending (%G. reachable (extend h F Join G)) h F  
   8.703 +                  (extend_set h A LeadsTo extend_set h B) (A LeadsTo B)"
   8.704 +apply (unfold extending_def)
   8.705 +apply (blast intro: project_LeadsTo_D)
   8.706 +done
   8.707 +
   8.708 +ML
   8.709 +{*
   8.710 +val projecting_Int = thm "projecting_Int";
   8.711 +val projecting_Un = thm "projecting_Un";
   8.712 +val projecting_INT = thm "projecting_INT";
   8.713 +val projecting_UN = thm "projecting_UN";
   8.714 +val projecting_weaken = thm "projecting_weaken";
   8.715 +val projecting_weaken_L = thm "projecting_weaken_L";
   8.716 +val extending_Int = thm "extending_Int";
   8.717 +val extending_Un = thm "extending_Un";
   8.718 +val extending_INT = thm "extending_INT";
   8.719 +val extending_UN = thm "extending_UN";
   8.720 +val extending_weaken = thm "extending_weaken";
   8.721 +val extending_weaken_L = thm "extending_weaken_L";
   8.722 +val projecting_UNIV = thm "projecting_UNIV";
   8.723 +*}
   8.724 +
   8.725  end
     9.1 --- a/src/HOL/UNITY/ROOT.ML	Tue Jan 28 22:53:39 2003 +0100
     9.2 +++ b/src/HOL/UNITY/ROOT.ML	Wed Jan 29 11:02:08 2003 +0100
     9.3 @@ -24,7 +24,6 @@
     9.4    time_use_thy"Simple/NSP_Bad";
     9.5  
     9.6  (*Example of composition*)
     9.7 -time_use_thy "Comp";
     9.8  time_use_thy "Comp/Handshake";
     9.9  
    9.10  (*Universal properties examples*)
    9.11 @@ -32,10 +31,9 @@
    9.12  time_use_thy "Comp/Counterc";
    9.13  time_use_thy "Comp/Priority";
    9.14  
    9.15 -(*Allocator example*)
    9.16 -time_use_thy "PPROD";
    9.17  time_use_thy "Comp/TimerArray";
    9.18  
    9.19 +(*Allocator example*)
    9.20  time_use_thy "Comp/Alloc";
    9.21  time_use_thy "Comp/AllocImpl";
    9.22  time_use_thy "Comp/Client";
    10.1 --- a/src/HOL/UNITY/Rename.ML	Tue Jan 28 22:53:39 2003 +0100
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,383 +0,0 @@
    10.4 -(*  Title:      HOL/UNITY/Rename.ML
    10.5 -    ID:         $Id$
    10.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    10.7 -    Copyright   2000  University of Cambridge
    10.8 -
    10.9 -*)
   10.10 -
   10.11 -Addsimps [image_inv_f_f, image_surj_f_inv_f];
   10.12 -
   10.13 -Goal "bij h ==> good_map (%(x,u). h x)";
   10.14 -by (rtac good_mapI 1);
   10.15 -by (rewrite_goals_tac [bij_def, inj_on_def, surj_def]);
   10.16 -by Auto_tac;
   10.17 -qed "good_map_bij";
   10.18 -Addsimps [good_map_bij];
   10.19 -AddIs    [good_map_bij];
   10.20 -
   10.21 -fun bij_export th = good_map_bij RS export th |> simplify (simpset());
   10.22 -
   10.23 -Goalw [bij_def, split_def] "bij h ==> fst (inv (%(x,u). h x) s) = inv h s";
   10.24 -by (Clarify_tac 1);
   10.25 -by (subgoal_tac "surj (%p. h (fst p))" 1);
   10.26 -by (asm_full_simp_tac (simpset() addsimps [surj_def]) 2);
   10.27 -by (etac injD 1);
   10.28 -by (asm_simp_tac (simpset() addsimps [surj_f_inv_f]) 1);
   10.29 -by (etac surj_f_inv_f 1);
   10.30 -qed "fst_o_inv_eq_inv";
   10.31 -
   10.32 -Goal "bij h ==> z : h`A = (inv h z : A)";
   10.33 -by (auto_tac (claset() addSIs [image_eqI],
   10.34 -	      simpset() addsimps [bij_is_inj, bij_is_surj RS surj_f_inv_f]));
   10.35 -qed "mem_rename_set_iff";
   10.36 -
   10.37 -Goal "extend_set (%(x,u). h x) A = h`A";
   10.38 -by (auto_tac (claset() addSIs [image_eqI],
   10.39 -	      simpset() addsimps [extend_set_def]));
   10.40 -qed "extend_set_eq_image";
   10.41 -Addsimps [extend_set_eq_image];
   10.42 -
   10.43 -Goalw [rename_def] "Init (rename h F) = h`(Init F)";
   10.44 -by (Simp_tac 1);
   10.45 -qed "Init_rename";
   10.46 -
   10.47 -Addsimps [Init_rename];
   10.48 -
   10.49 -
   10.50 -(*** inverse properties ***)
   10.51 -
   10.52 -Goalw [bij_def]
   10.53 -     "bij h \
   10.54 -\     ==> extend_set (%(x,u::'c). inv h x) = project_set (%(x,u::'c). h x)";
   10.55 -by (rtac ext 1);
   10.56 -by (auto_tac (claset() addSIs [image_eqI], 
   10.57 -	      simpset() addsimps [extend_set_def, project_set_def,
   10.58 -				  surj_f_inv_f]));
   10.59 -qed "extend_set_inv";
   10.60 -
   10.61 -(** for "rename" (programs) **)
   10.62 -
   10.63 -Goal "bij h \
   10.64 -\     ==> extend_act (%(x,u::'c). h x) = project_act (%(x,u::'c). inv h x)";
   10.65 -by (rtac ext 1);
   10.66 -by (auto_tac (claset() addSIs [image_eqI], 
   10.67 -	      simpset() addsimps [extend_act_def, project_act_def, bij_def,
   10.68 -				  surj_f_inv_f]));
   10.69 -qed "bij_extend_act_eq_project_act";
   10.70 -
   10.71 -Goal "bij h ==> bij (extend_act (%(x,u::'c). h x))";
   10.72 -by (rtac bijI 1);
   10.73 -by (rtac (export inj_extend_act) 1);
   10.74 -by (auto_tac (claset(), simpset() addsimps [bij_extend_act_eq_project_act]));  
   10.75 -by (rtac surjI 1); 
   10.76 -by (rtac (export extend_act_inverse) 1); 
   10.77 -by (blast_tac (claset() addIs [bij_imp_bij_inv, good_map_bij]) 1); 
   10.78 -qed "bij_extend_act";
   10.79 -
   10.80 -Goal "bij h ==> bij (project_act (%(x,u::'c). h x))";
   10.81 -by (ftac (bij_imp_bij_inv RS bij_extend_act) 1);
   10.82 -by (asm_full_simp_tac (simpset() addsimps [bij_extend_act_eq_project_act,
   10.83 -                                    bij_imp_bij_inv, inv_inv_eq]) 1);  
   10.84 -qed "bij_project_act";
   10.85 -
   10.86 -Goal "bij h ==> inv (project_act (%(x,u::'c). inv h x)) = \
   10.87 -\               project_act (%(x,u::'c). h x)";
   10.88 -by (asm_simp_tac
   10.89 -    (simpset() addsimps [bij_extend_act_eq_project_act RS sym]) 1); 
   10.90 -by (rtac surj_imp_inv_eq 1);
   10.91 -by (blast_tac (claset() addIs [bij_extend_act, bij_is_surj]) 1);  
   10.92 -by (asm_simp_tac (simpset() addsimps [export extend_act_inverse]) 1); 
   10.93 -qed "bij_inv_project_act_eq";
   10.94 -
   10.95 -Goal "bij h  \
   10.96 -\     ==> extend (%(x,u::'c). inv h x) = project (%(x,u::'c). h x) UNIV";
   10.97 -by (ftac bij_imp_bij_inv 1);
   10.98 -by (rtac ext 1);
   10.99 -by (rtac program_equalityI 1);
  10.100 -by (asm_simp_tac
  10.101 -    (simpset() addsimps [export project_act_Id, export Acts_extend,
  10.102 -			 insert_Id_image_Acts, bij_extend_act_eq_project_act, 
  10.103 -                         inv_inv_eq]) 2);
  10.104 -by (asm_simp_tac (simpset() addsimps [extend_set_inv]) 1);
  10.105 -by (asm_simp_tac
  10.106 -    (simpset() addsimps [export AllowedActs_extend,
  10.107 -			 export AllowedActs_project,
  10.108 -			 bij_project_act, bij_vimage_eq_inv_image,
  10.109 -                         bij_inv_project_act_eq]) 1);
  10.110 -qed "extend_inv";
  10.111 -
  10.112 -Goal "bij h ==> rename (inv h) (rename h F) = F";
  10.113 -by (asm_simp_tac (simpset() addsimps [rename_def, extend_inv, 
  10.114 -				      export extend_inverse]) 1);
  10.115 -qed "rename_inv_rename";
  10.116 -Addsimps [rename_inv_rename];
  10.117 -
  10.118 -Goal "bij h ==> rename h (rename (inv h) F) = F";
  10.119 -by (ftac bij_imp_bij_inv 1);
  10.120 -by (etac (inv_inv_eq RS subst) 1 THEN etac rename_inv_rename 1);
  10.121 -qed "rename_rename_inv";
  10.122 -Addsimps [rename_rename_inv];
  10.123 -
  10.124 -Goal "bij h ==> rename (inv h) = inv (rename h)";
  10.125 -by (rtac (inv_equality RS sym) 1);
  10.126 -by Auto_tac;
  10.127 -qed "rename_inv_eq";
  10.128 -
  10.129 -(** (rename h) is bijective <=> h is bijective **)
  10.130 -
  10.131 -Goal "bij h ==> bij (extend (%(x,u::'c). h x))";
  10.132 -by (rtac bijI 1);
  10.133 -by (blast_tac (claset() addIs [export inj_extend]) 1);
  10.134 -by (res_inst_tac [("f","extend (%(x,u). inv h x)")] surjI 1); 
  10.135 -by (stac ((inst "f" "h" inv_inv_eq) RS sym) 1
  10.136 -    THEN stac extend_inv 2 THEN stac (export extend_inverse) 3);
  10.137 -by (auto_tac (claset(), simpset() addsimps [bij_imp_bij_inv, inv_inv_eq]));
  10.138 -qed "bij_extend";
  10.139 -
  10.140 -Goal "bij h ==> bij (project (%(x,u::'c). h x) UNIV)";
  10.141 -by (stac (extend_inv RS sym) 1); 
  10.142 -by (auto_tac (claset(), simpset() addsimps [bij_imp_bij_inv, bij_extend]));
  10.143 -qed "bij_project";
  10.144 -
  10.145 -Goal "bij h  \
  10.146 -\     ==> inv (project (%(x,u::'c). h x) UNIV) = extend (%(x,u::'c). h x)";
  10.147 -by (rtac inj_imp_inv_eq 1); 
  10.148 -by (etac (bij_project RS bij_is_inj) 1); 
  10.149 -by (asm_simp_tac (simpset() addsimps [export extend_inverse]) 1); 
  10.150 -qed "inv_project_eq";
  10.151 -
  10.152 -Goal "bij h ==> Allowed (rename h F) = rename h ` Allowed F";
  10.153 -by (asm_simp_tac (simpset() addsimps [rename_def, export Allowed_extend]) 1);
  10.154 -by (stac bij_vimage_eq_inv_image 1); 
  10.155 -by (rtac bij_project 1); 
  10.156 -by (Blast_tac 1); 
  10.157 -by (asm_simp_tac (simpset() addsimps [inv_project_eq]) 1);
  10.158 -qed "Allowed_rename"; 
  10.159 -Addsimps [Allowed_rename];
  10.160 -
  10.161 -Goal "bij h ==> bij (rename h)";
  10.162 -by (asm_simp_tac (simpset() addsimps [rename_def, bij_extend]) 1); 
  10.163 -qed "bij_rename";
  10.164 -bind_thm ("surj_rename", bij_rename RS bij_is_surj);
  10.165 -
  10.166 -Goalw [inj_on_def] "inj (rename h) ==> inj h";
  10.167 -by Auto_tac;
  10.168 -by (dres_inst_tac [("x", "mk_program ({x}, {}, {})")] spec 1);
  10.169 -by (dres_inst_tac [("x", "mk_program ({y}, {}, {})")] spec 1);
  10.170 -by (auto_tac (claset(), 
  10.171 -	      simpset() addsimps [program_equality_iff, 
  10.172 -                                  rename_def, extend_def]));
  10.173 -qed "inj_rename_imp_inj";
  10.174 -
  10.175 -Goalw [surj_def] "surj (rename h) ==> surj h";
  10.176 -by Auto_tac;
  10.177 -by (dres_inst_tac [("x", "mk_program ({y}, {}, {})")] spec 1);
  10.178 -by (auto_tac (claset(), 
  10.179 -	      simpset() addsimps [program_equality_iff, 
  10.180 -                                  rename_def, extend_def]));
  10.181 -qed "surj_rename_imp_surj";
  10.182 -
  10.183 -Goalw [bij_def] "bij (rename h) ==> bij h";
  10.184 -by (asm_simp_tac
  10.185 -    (simpset() addsimps [inj_rename_imp_inj, surj_rename_imp_surj]) 1);
  10.186 -qed "bij_rename_imp_bij";
  10.187 -
  10.188 -Goal "bij (rename h) = bij h";
  10.189 -by (blast_tac (claset() addIs [bij_rename, bij_rename_imp_bij]) 1);
  10.190 -qed "bij_rename_iff";
  10.191 -AddIffs [bij_rename_iff];
  10.192 -
  10.193 -
  10.194 -(*** the lattice operations ***)
  10.195 -
  10.196 -Goalw [rename_def] "bij h ==> rename h SKIP = SKIP";
  10.197 -by (Asm_simp_tac 1);
  10.198 -qed "rename_SKIP";
  10.199 -Addsimps [rename_SKIP];
  10.200 -
  10.201 -Goalw [rename_def]
  10.202 -     "bij h ==> rename h (F Join G) = rename h F Join rename h G";
  10.203 -by (asm_simp_tac (simpset() addsimps [export extend_Join]) 1);
  10.204 -qed "rename_Join";
  10.205 -Addsimps [rename_Join];
  10.206 -
  10.207 -Goalw [rename_def] "bij h ==> rename h (JOIN I F) = (JN i:I. rename h (F i))";
  10.208 -by (asm_simp_tac (simpset() addsimps [export extend_JN]) 1);
  10.209 -qed "rename_JN";
  10.210 -Addsimps [rename_JN];
  10.211 -
  10.212 -
  10.213 -(*** Strong Safety: co, stable ***)
  10.214 -
  10.215 -Goalw [rename_def]
  10.216 -     "bij h ==> (rename h F : (h`A) co (h`B)) = (F : A co B)";
  10.217 -by (REPEAT (stac (extend_set_eq_image RS sym) 1));
  10.218 -by (etac (good_map_bij RS export extend_constrains) 1);
  10.219 -qed "rename_constrains";
  10.220 -
  10.221 -Goalw [stable_def]
  10.222 -     "bij h ==> (rename h F : stable (h`A)) = (F : stable A)";
  10.223 -by (asm_simp_tac (simpset() addsimps [rename_constrains]) 1);
  10.224 -qed "rename_stable";
  10.225 -
  10.226 -Goal "bij h ==> (rename h F : invariant (h`A)) = (F : invariant A)";
  10.227 -by (asm_simp_tac (simpset() addsimps [invariant_def, rename_stable,
  10.228 -				      bij_is_inj RS inj_image_subset_iff]) 1);
  10.229 -qed "rename_invariant";
  10.230 -
  10.231 -Goal "bij h ==> (rename h F : increasing func) = (F : increasing (func o h))";
  10.232 -by (asm_simp_tac 
  10.233 -    (simpset() addsimps [increasing_def, rename_stable RS sym,
  10.234 -  		 bij_image_Collect_eq, bij_is_surj RS surj_f_inv_f]) 1);
  10.235 -qed "rename_increasing";
  10.236 -
  10.237 -
  10.238 -(*** Weak Safety: Co, Stable ***)
  10.239 -
  10.240 -Goalw [rename_def]
  10.241 -     "bij h ==> reachable (rename h F) = h ` (reachable F)";
  10.242 -by (asm_simp_tac (simpset() addsimps [export reachable_extend_eq]) 1);
  10.243 -qed "reachable_rename_eq";
  10.244 -
  10.245 -Goal "bij h ==> (rename h F : (h`A) Co (h`B)) = (F : A Co B)";
  10.246 -by (asm_simp_tac
  10.247 -    (simpset() addsimps [Constrains_def, reachable_rename_eq, 
  10.248 -			 rename_constrains, bij_is_inj, image_Int RS sym]) 1);
  10.249 -qed "rename_Constrains";
  10.250 -
  10.251 -Goalw [Stable_def]
  10.252 -     "bij h ==> (rename h F : Stable (h`A)) = (F : Stable A)";
  10.253 -by (asm_simp_tac (simpset() addsimps [rename_Constrains]) 1);
  10.254 -qed "rename_Stable";
  10.255 -
  10.256 -Goal "bij h ==> (rename h F : Always (h`A)) = (F : Always A)";
  10.257 -by (asm_simp_tac (simpset() addsimps [Always_def, rename_Stable,
  10.258 -				      bij_is_inj RS inj_image_subset_iff]) 1);
  10.259 -qed "rename_Always";
  10.260 -
  10.261 -Goal "bij h ==> (rename h F : Increasing func) = (F : Increasing (func o h))";
  10.262 -by (asm_simp_tac 
  10.263 -    (simpset() addsimps [Increasing_def, rename_Stable RS sym,
  10.264 -  		 bij_image_Collect_eq, bij_is_surj RS surj_f_inv_f]) 1);
  10.265 -qed "rename_Increasing";
  10.266 -
  10.267 -
  10.268 -(*** Progress: transient, ensures ***)
  10.269 -
  10.270 -Goalw [rename_def]
  10.271 -     "bij h ==> (rename h F : transient (h`A)) = (F : transient A)";
  10.272 -by (stac (extend_set_eq_image RS sym) 1);
  10.273 -by (etac (good_map_bij RS export extend_transient) 1);
  10.274 -qed "rename_transient";
  10.275 -
  10.276 -Goalw [rename_def]
  10.277 -     "bij h ==> (rename h F : (h`A) ensures (h`B)) = (F : A ensures B)";
  10.278 -by (REPEAT (stac (extend_set_eq_image RS sym) 1));
  10.279 -by (etac (good_map_bij RS export extend_ensures) 1);
  10.280 -qed "rename_ensures";
  10.281 -
  10.282 -Goalw [rename_def]
  10.283 -     "bij h ==> (rename h F : (h`A) leadsTo (h`B)) = (F : A leadsTo B)";
  10.284 -by (REPEAT (stac (extend_set_eq_image RS sym) 1));
  10.285 -by (etac (good_map_bij RS export extend_leadsTo) 1);
  10.286 -qed "rename_leadsTo";
  10.287 -
  10.288 -Goalw [rename_def]
  10.289 -     "bij h ==> (rename h F : (h`A) LeadsTo (h`B)) = (F : A LeadsTo B)";
  10.290 -by (REPEAT (stac (extend_set_eq_image RS sym) 1));
  10.291 -by (etac (good_map_bij RS export extend_LeadsTo) 1);
  10.292 -qed "rename_LeadsTo";
  10.293 -
  10.294 -Goalw [rename_def]
  10.295 -     "bij h ==> (rename h F : (rename h ` X) guarantees \
  10.296 -\                             (rename h ` Y)) = \
  10.297 -\               (F : X guarantees Y)";
  10.298 -by (stac (good_map_bij RS export extend_guarantees_eq RS sym) 1);
  10.299 -by (assume_tac 1);
  10.300 -by (asm_simp_tac (simpset() addsimps [fst_o_inv_eq_inv, o_def]) 1);
  10.301 -qed "rename_rename_guarantees_eq";
  10.302 -
  10.303 -Goal "bij h ==> (rename h F : X guarantees Y) = \
  10.304 -\               (F : (rename (inv h) ` X) guarantees \
  10.305 -\                    (rename (inv h) ` Y))";
  10.306 -by (stac (rename_rename_guarantees_eq RS sym) 1);
  10.307 -by (assume_tac 1);
  10.308 -by (asm_simp_tac
  10.309 -    (simpset() addsimps [image_eq_UN, o_def, bij_is_surj RS surj_f_inv_f]) 1);
  10.310 -qed "rename_guarantees_eq_rename_inv";
  10.311 -
  10.312 -Goal "bij h ==> (rename h G : preserves v) = (G : preserves (v o h))";
  10.313 -by (stac (good_map_bij RS export extend_preserves RS sym) 1);
  10.314 -by (assume_tac 1);
  10.315 -by (asm_simp_tac (simpset() addsimps [o_def, fst_o_inv_eq_inv, rename_def,
  10.316 -				      bij_is_surj RS surj_f_inv_f]) 1);
  10.317 -qed "rename_preserves";
  10.318 -
  10.319 -Goal "bij h ==> (rename h F ok rename h G) = (F ok G)";
  10.320 -by (asm_simp_tac (simpset() addsimps [export ok_extend_iff, rename_def]) 1); 
  10.321 -qed "ok_rename_iff";
  10.322 -Addsimps [ok_rename_iff];
  10.323 -
  10.324 -Goal "bij h ==> OK I (%i. rename h (F i)) = (OK I F)";
  10.325 -by (asm_simp_tac (simpset() addsimps [export OK_extend_iff, rename_def]) 1); 
  10.326 -qed "OK_rename_iff";
  10.327 -Addsimps [OK_rename_iff];
  10.328 -
  10.329 -
  10.330 -(*** "image" versions of the rules, for lifting "guarantees" properties ***)
  10.331 -
  10.332 -
  10.333 -(*Tactic used in all the proofs.  Better would have been to prove one 
  10.334 -  meta-theorem, but how can we handle the polymorphism?  E.g. in 
  10.335 -  rename_constrains the two appearances of "co" have different types!*)
  10.336 -fun rename_image_tac ths =
  10.337 -  EVERY [Auto_tac,
  10.338 -	 (rename_tac "F" 2),
  10.339 -	 (subgoal_tac "EX G. F = rename h G" 2),
  10.340 -	 (auto_tac (claset() addSIs [surj_rename RS surj_f_inv_f RS sym],
  10.341 -	      simpset() addsimps ths))];
  10.342 -
  10.343 -Goal "bij h ==> rename h ` (A co B) = (h ` A) co (h`B)";
  10.344 -by (rename_image_tac [rename_constrains]);
  10.345 -qed "rename_image_constrains";
  10.346 -
  10.347 -Goal "bij h ==> rename h ` stable A = stable (h ` A)";
  10.348 -by (rename_image_tac [rename_stable]);
  10.349 -qed "rename_image_stable";
  10.350 -
  10.351 -Goal "bij h ==> rename h ` increasing func = increasing (func o inv h)";
  10.352 -by (rename_image_tac [rename_increasing, o_def, bij_is_inj]);
  10.353 -qed "rename_image_increasing";
  10.354 -
  10.355 -Goal "bij h ==> rename h ` invariant A = invariant (h ` A)";
  10.356 -by (rename_image_tac [rename_invariant]);
  10.357 -qed "rename_image_invariant";
  10.358 -
  10.359 -Goal "bij h ==> rename h ` (A Co B) = (h ` A) Co (h`B)";
  10.360 -by (rename_image_tac [rename_Constrains]);
  10.361 -qed "rename_image_Constrains";
  10.362 -
  10.363 -Goal "bij h ==> rename h ` preserves v = preserves (v o inv h)";
  10.364 -by (asm_simp_tac (simpset() addsimps [o_def, rename_image_stable,
  10.365 -                    preserves_def, bij_image_INT, bij_image_Collect_eq]) 1); 
  10.366 -qed "rename_image_preserves";
  10.367 -
  10.368 -Goal "bij h ==> rename h ` Stable A = Stable (h ` A)";
  10.369 -by (rename_image_tac [rename_Stable]);
  10.370 -qed "rename_image_Stable";
  10.371 -
  10.372 -Goal "bij h ==> rename h ` Increasing func = Increasing (func o inv h)";
  10.373 -by (rename_image_tac [rename_Increasing, o_def, bij_is_inj]);
  10.374 -qed "rename_image_Increasing";
  10.375 -
  10.376 -Goal "bij h ==> rename h ` Always A = Always (h ` A)";
  10.377 -by (rename_image_tac [rename_Always]);
  10.378 -qed "rename_image_Always";
  10.379 -
  10.380 -Goal "bij h ==> rename h ` (A leadsTo B) = (h ` A) leadsTo (h`B)";
  10.381 -by (rename_image_tac [rename_leadsTo]);
  10.382 -qed "rename_image_leadsTo";
  10.383 -
  10.384 -Goal "bij h ==> rename h ` (A LeadsTo B) = (h ` A) LeadsTo (h`B)";
  10.385 -by (rename_image_tac [rename_LeadsTo]);
  10.386 -qed "rename_image_LeadsTo";
    11.1 --- a/src/HOL/UNITY/Rename.thy	Tue Jan 28 22:53:39 2003 +0100
    11.2 +++ b/src/HOL/UNITY/Rename.thy	Wed Jan 29 11:02:08 2003 +0100
    11.3 @@ -6,11 +6,388 @@
    11.4  Renaming of state sets
    11.5  *)
    11.6  
    11.7 -Rename = Extend +
    11.8 +theory Rename = Extend:
    11.9  
   11.10  constdefs
   11.11    
   11.12    rename :: "['a => 'b, 'a program] => 'b program"
   11.13      "rename h == extend (%(x,u::unit). h x)"
   11.14  
   11.15 +declare image_inv_f_f [simp] image_surj_f_inv_f [simp]
   11.16 +
   11.17 +declare Extend.intro [simp,intro]
   11.18 +
   11.19 +lemma good_map_bij [simp,intro]: "bij h ==> good_map (%(x,u). h x)"
   11.20 +apply (rule good_mapI)
   11.21 +apply (unfold bij_def inj_on_def surj_def, auto)
   11.22 +done
   11.23 +
   11.24 +lemma fst_o_inv_eq_inv: "bij h ==> fst (inv (%(x,u). h x) s) = inv h s"
   11.25 +apply (unfold bij_def split_def, clarify)
   11.26 +apply (subgoal_tac "surj (%p. h (fst p))")
   11.27 + prefer 2 apply (simp add: surj_def)
   11.28 +apply (erule injD)
   11.29 +apply (simp (no_asm_simp) add: surj_f_inv_f)
   11.30 +apply (erule surj_f_inv_f)
   11.31 +done
   11.32 +
   11.33 +lemma mem_rename_set_iff: "bij h ==> z : h`A = (inv h z : A)"
   11.34 +by (force simp add: bij_is_inj bij_is_surj [THEN surj_f_inv_f])
   11.35 +
   11.36 +
   11.37 +lemma extend_set_eq_image [simp]: "extend_set (%(x,u). h x) A = h`A"
   11.38 +by (force simp add: extend_set_def)
   11.39 +
   11.40 +lemma Init_rename [simp]: "Init (rename h F) = h`(Init F)"
   11.41 +by (simp add: rename_def)
   11.42 +
   11.43 +
   11.44 +(*** inverse properties ***)
   11.45 +
   11.46 +lemma extend_set_inv: 
   11.47 +     "bij h  
   11.48 +      ==> extend_set (%(x,u::'c). inv h x) = project_set (%(x,u::'c). h x)"
   11.49 +apply (unfold bij_def)
   11.50 +apply (rule ext)
   11.51 +apply (force simp add: extend_set_def project_set_def surj_f_inv_f)
   11.52 +done
   11.53 +
   11.54 +(** for "rename" (programs) **)
   11.55 +
   11.56 +lemma bij_extend_act_eq_project_act: "bij h  
   11.57 +      ==> extend_act (%(x,u::'c). h x) = project_act (%(x,u::'c). inv h x)"
   11.58 +apply (rule ext)
   11.59 +apply (force simp add: extend_act_def project_act_def bij_def surj_f_inv_f)
   11.60 +done
   11.61 +
   11.62 +lemma bij_extend_act: "bij h ==> bij (extend_act (%(x,u::'c). h x))"
   11.63 +apply (rule bijI)
   11.64 +apply (rule Extend.inj_extend_act)
   11.65 +apply (auto simp add: bij_extend_act_eq_project_act)
   11.66 +apply (rule surjI)
   11.67 +apply (rule Extend.extend_act_inverse)
   11.68 +apply (blast intro: bij_imp_bij_inv good_map_bij)
   11.69 +done
   11.70 +
   11.71 +lemma bij_project_act: "bij h ==> bij (project_act (%(x,u::'c). h x))"
   11.72 +apply (frule bij_imp_bij_inv [THEN bij_extend_act])
   11.73 +apply (simp add: bij_extend_act_eq_project_act bij_imp_bij_inv inv_inv_eq)
   11.74 +done
   11.75 +
   11.76 +lemma bij_inv_project_act_eq: "bij h ==> inv (project_act (%(x,u::'c). inv h x)) =  
   11.77 +                project_act (%(x,u::'c). h x)"
   11.78 +apply (simp (no_asm_simp) add: bij_extend_act_eq_project_act [symmetric])
   11.79 +apply (rule surj_imp_inv_eq)
   11.80 +apply (blast intro: bij_extend_act bij_is_surj)
   11.81 +apply (simp (no_asm_simp) add: Extend.extend_act_inverse)
   11.82 +done
   11.83 +
   11.84 +lemma extend_inv: "bij h   
   11.85 +      ==> extend (%(x,u::'c). inv h x) = project (%(x,u::'c). h x) UNIV"
   11.86 +apply (frule bij_imp_bij_inv)
   11.87 +apply (rule ext)
   11.88 +apply (rule program_equalityI)
   11.89 +  apply (simp (no_asm_simp) add: extend_set_inv)
   11.90 + apply (simp add: Extend.project_act_Id Extend.Acts_extend 
   11.91 +          insert_Id_image_Acts bij_extend_act_eq_project_act inv_inv_eq) 
   11.92 +apply (simp add: Extend.AllowedActs_extend Extend.AllowedActs_project 
   11.93 +             bij_project_act bij_vimage_eq_inv_image bij_inv_project_act_eq)
   11.94 +done
   11.95 +
   11.96 +lemma rename_inv_rename [simp]: "bij h ==> rename (inv h) (rename h F) = F"
   11.97 +by (simp add: rename_def extend_inv Extend.extend_inverse)
   11.98 +
   11.99 +lemma rename_rename_inv [simp]: "bij h ==> rename h (rename (inv h) F) = F"
  11.100 +apply (frule bij_imp_bij_inv)
  11.101 +apply (erule inv_inv_eq [THEN subst], erule rename_inv_rename)
  11.102 +done
  11.103 +
  11.104 +lemma rename_inv_eq: "bij h ==> rename (inv h) = inv (rename h)"
  11.105 +by (rule inv_equality [symmetric], auto)
  11.106 +
  11.107 +(** (rename h) is bijective <=> h is bijective **)
  11.108 +
  11.109 +lemma bij_extend: "bij h ==> bij (extend (%(x,u::'c). h x))"
  11.110 +apply (rule bijI)
  11.111 +apply (blast intro: Extend.inj_extend)
  11.112 +apply (rule_tac f = "extend (% (x,u) . inv h x) " in surjI)
  11.113 +apply (subst inv_inv_eq [of h, symmetric], assumption) 
  11.114 +apply (subst extend_inv, simp add: bij_imp_bij_inv) 
  11.115 +apply (simp add: inv_inv_eq) 
  11.116 +apply (rule Extend.extend_inverse) 
  11.117 +apply (simp add: bij_imp_bij_inv) 
  11.118 +done
  11.119 +
  11.120 +lemma bij_project: "bij h ==> bij (project (%(x,u::'c). h x) UNIV)"
  11.121 +apply (subst extend_inv [symmetric])
  11.122 +apply (auto simp add: bij_imp_bij_inv bij_extend)
  11.123 +done
  11.124 +
  11.125 +lemma inv_project_eq:
  11.126 +     "bij h   
  11.127 +      ==> inv (project (%(x,u::'c). h x) UNIV) = extend (%(x,u::'c). h x)"
  11.128 +apply (rule inj_imp_inv_eq)
  11.129 +apply (erule bij_project [THEN bij_is_inj])
  11.130 +apply (simp (no_asm_simp) add: Extend.extend_inverse)
  11.131 +done
  11.132 +
  11.133 +lemma Allowed_rename [simp]:
  11.134 +     "bij h ==> Allowed (rename h F) = rename h ` Allowed F"
  11.135 +apply (simp (no_asm_simp) add: rename_def Extend.Allowed_extend)
  11.136 +apply (subst bij_vimage_eq_inv_image)
  11.137 +apply (rule bij_project, blast)
  11.138 +apply (simp (no_asm_simp) add: inv_project_eq)
  11.139 +done
  11.140 +
  11.141 +lemma bij_rename: "bij h ==> bij (rename h)"
  11.142 +apply (simp (no_asm_simp) add: rename_def bij_extend)
  11.143 +done
  11.144 +lemmas surj_rename = bij_rename [THEN bij_is_surj, standard]
  11.145 +
  11.146 +lemma inj_rename_imp_inj: "inj (rename h) ==> inj h"
  11.147 +apply (unfold inj_on_def, auto)
  11.148 +apply (drule_tac x = "mk_program ({x}, {}, {}) " in spec)
  11.149 +apply (drule_tac x = "mk_program ({y}, {}, {}) " in spec)
  11.150 +apply (auto simp add: program_equality_iff rename_def extend_def)
  11.151 +done
  11.152 +
  11.153 +lemma surj_rename_imp_surj: "surj (rename h) ==> surj h"
  11.154 +apply (unfold surj_def, auto)
  11.155 +apply (drule_tac x = "mk_program ({y}, {}, {}) " in spec)
  11.156 +apply (auto simp add: program_equality_iff rename_def extend_def)
  11.157 +done
  11.158 +
  11.159 +lemma bij_rename_imp_bij: "bij (rename h) ==> bij h"
  11.160 +apply (unfold bij_def)
  11.161 +apply (simp (no_asm_simp) add: inj_rename_imp_inj surj_rename_imp_surj)
  11.162 +done
  11.163 +
  11.164 +lemma bij_rename_iff [simp]: "bij (rename h) = bij h"
  11.165 +by (blast intro: bij_rename bij_rename_imp_bij)
  11.166 +
  11.167 +
  11.168 +(*** the lattice operations ***)
  11.169 +
  11.170 +lemma rename_SKIP [simp]: "bij h ==> rename h SKIP = SKIP"
  11.171 +by (simp add: rename_def Extend.extend_SKIP)
  11.172 +
  11.173 +lemma rename_Join [simp]: 
  11.174 +     "bij h ==> rename h (F Join G) = rename h F Join rename h G"
  11.175 +by (simp add: rename_def Extend.extend_Join)
  11.176 +
  11.177 +lemma rename_JN [simp]:
  11.178 +     "bij h ==> rename h (JOIN I F) = (JN i:I. rename h (F i))"
  11.179 +by (simp add: rename_def Extend.extend_JN)
  11.180 +
  11.181 +
  11.182 +(*** Strong Safety: co, stable ***)
  11.183 +
  11.184 +lemma rename_constrains: 
  11.185 +     "bij h ==> (rename h F : (h`A) co (h`B)) = (F : A co B)"
  11.186 +apply (unfold rename_def)
  11.187 +apply (subst extend_set_eq_image [symmetric])+
  11.188 +apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_constrains])
  11.189 +done
  11.190 +
  11.191 +lemma rename_stable: 
  11.192 +     "bij h ==> (rename h F : stable (h`A)) = (F : stable A)"
  11.193 +apply (simp add: stable_def rename_constrains)
  11.194 +done
  11.195 +
  11.196 +lemma rename_invariant:
  11.197 +     "bij h ==> (rename h F : invariant (h`A)) = (F : invariant A)"
  11.198 +apply (simp add: invariant_def rename_stable bij_is_inj [THEN inj_image_subset_iff])
  11.199 +done
  11.200 +
  11.201 +lemma rename_increasing:
  11.202 +     "bij h ==> (rename h F : increasing func) = (F : increasing (func o h))"
  11.203 +apply (simp add: increasing_def rename_stable [symmetric] bij_image_Collect_eq bij_is_surj [THEN surj_f_inv_f])
  11.204 +done
  11.205 +
  11.206 +
  11.207 +(*** Weak Safety: Co, Stable ***)
  11.208 +
  11.209 +lemma reachable_rename_eq: 
  11.210 +     "bij h ==> reachable (rename h F) = h ` (reachable F)"
  11.211 +apply (simp add: rename_def Extend.reachable_extend_eq)
  11.212 +done
  11.213 +
  11.214 +lemma rename_Constrains:
  11.215 +     "bij h ==> (rename h F : (h`A) Co (h`B)) = (F : A Co B)"
  11.216 +by (simp add: Constrains_def reachable_rename_eq rename_constrains
  11.217 +               bij_is_inj image_Int [symmetric])
  11.218 +
  11.219 +lemma rename_Stable: 
  11.220 +     "bij h ==> (rename h F : Stable (h`A)) = (F : Stable A)"
  11.221 +by (simp add: Stable_def rename_Constrains)
  11.222 +
  11.223 +lemma rename_Always: "bij h ==> (rename h F : Always (h`A)) = (F : Always A)"
  11.224 +by (simp add: Always_def rename_Stable bij_is_inj [THEN inj_image_subset_iff])
  11.225 +
  11.226 +lemma rename_Increasing:
  11.227 +     "bij h ==> (rename h F : Increasing func) = (F : Increasing (func o h))"
  11.228 +by (simp add: Increasing_def rename_Stable [symmetric] bij_image_Collect_eq 
  11.229 +              bij_is_surj [THEN surj_f_inv_f])
  11.230 +
  11.231 +
  11.232 +(*** Progress: transient, ensures ***)
  11.233 +
  11.234 +lemma rename_transient: 
  11.235 +     "bij h ==> (rename h F : transient (h`A)) = (F : transient A)"
  11.236 +apply (unfold rename_def)
  11.237 +apply (subst extend_set_eq_image [symmetric])
  11.238 +apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_transient])
  11.239 +done
  11.240 +
  11.241 +lemma rename_ensures: 
  11.242 +     "bij h ==> (rename h F : (h`A) ensures (h`B)) = (F : A ensures B)"
  11.243 +apply (unfold rename_def)
  11.244 +apply (subst extend_set_eq_image [symmetric])+
  11.245 +apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_ensures])
  11.246 +done
  11.247 +
  11.248 +lemma rename_leadsTo: 
  11.249 +     "bij h ==> (rename h F : (h`A) leadsTo (h`B)) = (F : A leadsTo B)"
  11.250 +apply (unfold rename_def)
  11.251 +apply (subst extend_set_eq_image [symmetric])+
  11.252 +apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_leadsTo])
  11.253 +done
  11.254 +
  11.255 +lemma rename_LeadsTo: 
  11.256 +     "bij h ==> (rename h F : (h`A) LeadsTo (h`B)) = (F : A LeadsTo B)"
  11.257 +apply (unfold rename_def)
  11.258 +apply (subst extend_set_eq_image [symmetric])+
  11.259 +apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_LeadsTo])
  11.260 +done
  11.261 +
  11.262 +lemma rename_rename_guarantees_eq: 
  11.263 +     "bij h ==> (rename h F : (rename h ` X) guarantees  
  11.264 +                              (rename h ` Y)) =  
  11.265 +                (F : X guarantees Y)"
  11.266 +apply (unfold rename_def)
  11.267 +apply (subst good_map_bij [THEN Extend.intro, THEN Extend.extend_guarantees_eq [symmetric]], assumption)
  11.268 +apply (simp (no_asm_simp) add: fst_o_inv_eq_inv o_def)
  11.269 +done
  11.270 +
  11.271 +lemma rename_guarantees_eq_rename_inv:
  11.272 +     "bij h ==> (rename h F : X guarantees Y) =  
  11.273 +                (F : (rename (inv h) ` X) guarantees  
  11.274 +                     (rename (inv h) ` Y))"
  11.275 +apply (subst rename_rename_guarantees_eq [symmetric], assumption)
  11.276 +apply (simp add: image_eq_UN o_def bij_is_surj [THEN surj_f_inv_f])
  11.277 +done
  11.278 +
  11.279 +lemma rename_preserves:
  11.280 +     "bij h ==> (rename h G : preserves v) = (G : preserves (v o h))"
  11.281 +apply (subst good_map_bij [THEN Extend.intro, THEN Extend.extend_preserves [symmetric]], assumption)
  11.282 +apply (simp add: o_def fst_o_inv_eq_inv rename_def bij_is_surj [THEN surj_f_inv_f])
  11.283 +done
  11.284 +
  11.285 +lemma ok_rename_iff [simp]: "bij h ==> (rename h F ok rename h G) = (F ok G)"
  11.286 +by (simp add: Extend.ok_extend_iff rename_def)
  11.287 +
  11.288 +lemma OK_rename_iff [simp]: "bij h ==> OK I (%i. rename h (F i)) = (OK I F)"
  11.289 +by (simp add: Extend.OK_extend_iff rename_def)
  11.290 +
  11.291 +
  11.292 +(*** "image" versions of the rules, for lifting "guarantees" properties ***)
  11.293 +
  11.294 +(*All the proofs are similar.  Better would have been to prove one 
  11.295 +  meta-theorem, but how can we handle the polymorphism?  E.g. in 
  11.296 +  rename_constrains the two appearances of "co" have different types!*)
  11.297 +lemmas bij_eq_rename = surj_rename [THEN surj_f_inv_f, symmetric]
  11.298 +
  11.299 +lemma rename_image_constrains:
  11.300 +     "bij h ==> rename h ` (A co B) = (h ` A) co (h`B)" 
  11.301 +apply auto 
  11.302 + defer 1
  11.303 + apply (rename_tac F) 
  11.304 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.305 + apply (auto intro!: bij_eq_rename simp add: rename_constrains) 
  11.306 +done
  11.307 +
  11.308 +lemma rename_image_stable: "bij h ==> rename h ` stable A = stable (h ` A)"
  11.309 +apply auto 
  11.310 + defer 1
  11.311 + apply (rename_tac F) 
  11.312 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.313 + apply (auto intro!: bij_eq_rename simp add: rename_stable)
  11.314 +done
  11.315 +
  11.316 +lemma rename_image_increasing:
  11.317 +     "bij h ==> rename h ` increasing func = increasing (func o inv h)"
  11.318 +apply auto 
  11.319 + defer 1
  11.320 + apply (rename_tac F) 
  11.321 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.322 + apply (auto intro!: bij_eq_rename simp add: rename_increasing o_def bij_is_inj) 
  11.323 +done
  11.324 +
  11.325 +lemma rename_image_invariant:
  11.326 +     "bij h ==> rename h ` invariant A = invariant (h ` A)"
  11.327 +apply auto 
  11.328 + defer 1
  11.329 + apply (rename_tac F) 
  11.330 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.331 + apply (auto intro!: bij_eq_rename simp add: rename_invariant) 
  11.332 +done
  11.333 +
  11.334 +lemma rename_image_Constrains:
  11.335 +     "bij h ==> rename h ` (A Co B) = (h ` A) Co (h`B)"
  11.336 +apply auto 
  11.337 + defer 1
  11.338 + apply (rename_tac F) 
  11.339 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.340 + apply (auto intro!: bij_eq_rename simp add: rename_Constrains)
  11.341 +done
  11.342 +
  11.343 +lemma rename_image_preserves:
  11.344 +     "bij h ==> rename h ` preserves v = preserves (v o inv h)"
  11.345 +by (simp add: o_def rename_image_stable preserves_def bij_image_INT 
  11.346 +              bij_image_Collect_eq)
  11.347 +
  11.348 +lemma rename_image_Stable:
  11.349 +     "bij h ==> rename h ` Stable A = Stable (h ` A)"
  11.350 +apply auto 
  11.351 + defer 1
  11.352 + apply (rename_tac F) 
  11.353 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.354 + apply (auto intro!: bij_eq_rename simp add: rename_Stable) 
  11.355 +done
  11.356 +
  11.357 +lemma rename_image_Increasing:
  11.358 +     "bij h ==> rename h ` Increasing func = Increasing (func o inv h)"
  11.359 +apply auto 
  11.360 + defer 1
  11.361 + apply (rename_tac F) 
  11.362 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.363 + apply (auto intro!: bij_eq_rename simp add: rename_Increasing o_def bij_is_inj)
  11.364 +done
  11.365 +
  11.366 +lemma rename_image_Always: "bij h ==> rename h ` Always A = Always (h ` A)"
  11.367 +apply auto 
  11.368 + defer 1
  11.369 + apply (rename_tac F) 
  11.370 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.371 + apply (auto intro!: bij_eq_rename simp add: rename_Always)
  11.372 +done
  11.373 +
  11.374 +lemma rename_image_leadsTo:
  11.375 +     "bij h ==> rename h ` (A leadsTo B) = (h ` A) leadsTo (h`B)"
  11.376 +apply auto 
  11.377 + defer 1
  11.378 + apply (rename_tac F) 
  11.379 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.380 + apply (auto intro!: bij_eq_rename simp add: rename_leadsTo) 
  11.381 +done
  11.382 +
  11.383 +lemma rename_image_LeadsTo:
  11.384 +     "bij h ==> rename h ` (A LeadsTo B) = (h ` A) LeadsTo (h`B)"
  11.385 +apply auto 
  11.386 + defer 1
  11.387 + apply (rename_tac F) 
  11.388 + apply (subgoal_tac "\<exists>G. F = rename h G") 
  11.389 + apply (auto intro!: bij_eq_rename simp add: rename_LeadsTo) 
  11.390 +done
  11.391 +
  11.392  end
    12.1 --- a/src/HOL/UNITY/UNITY_tactics.ML	Tue Jan 28 22:53:39 2003 +0100
    12.2 +++ b/src/HOL/UNITY/UNITY_tactics.ML	Wed Jan 29 11:02:08 2003 +0100
    12.3 @@ -6,6 +6,96 @@
    12.4  Specialized UNITY tactics, and ML bindings of theorems
    12.5  *)
    12.6  
    12.7 +(*Extend*)
    12.8 +val Restrict_iff = thm "Restrict_iff";
    12.9 +val Restrict_UNIV = thm "Restrict_UNIV";
   12.10 +val Restrict_empty = thm "Restrict_empty";
   12.11 +val Restrict_Int = thm "Restrict_Int";
   12.12 +val Restrict_triv = thm "Restrict_triv";
   12.13 +val Restrict_subset = thm "Restrict_subset";
   12.14 +val Restrict_eq_mono = thm "Restrict_eq_mono";
   12.15 +val Restrict_imageI = thm "Restrict_imageI";
   12.16 +val Domain_Restrict = thm "Domain_Restrict";
   12.17 +val Image_Restrict = thm "Image_Restrict";
   12.18 +val insert_Id_image_Acts = thm "insert_Id_image_Acts";
   12.19 +val good_mapI = thm "good_mapI";
   12.20 +val good_map_is_surj = thm "good_map_is_surj";
   12.21 +val fst_inv_equalityI = thm "fst_inv_equalityI";
   12.22 +val project_set_iff = thm "project_set_iff";
   12.23 +val extend_set_mono = thm "extend_set_mono";
   12.24 +val extend_set_empty = thm "extend_set_empty";
   12.25 +val project_set_Int_subset = thm "project_set_Int_subset";
   12.26 +val Init_extend = thm "Init_extend";
   12.27 +val Init_project = thm "Init_project";
   12.28 +val Acts_project = thm "Acts_project";
   12.29 +val project_set_UNIV = thm "project_set_UNIV";
   12.30 +val project_set_Union = thm "project_set_Union";
   12.31 +val project_act_mono = thm "project_act_mono";
   12.32 +val project_constrains_project_set = thm "project_constrains_project_set";
   12.33 +val project_stable_project_set = thm "project_stable_project_set";
   12.34 +
   12.35 +
   12.36 +(*Rename*)
   12.37 +val good_map_bij = thm "good_map_bij";
   12.38 +val fst_o_inv_eq_inv = thm "fst_o_inv_eq_inv";
   12.39 +val mem_rename_set_iff = thm "mem_rename_set_iff";
   12.40 +val extend_set_eq_image = thm "extend_set_eq_image";
   12.41 +val Init_rename = thm "Init_rename";
   12.42 +val extend_set_inv = thm "extend_set_inv";
   12.43 +val bij_extend_act_eq_project_act = thm "bij_extend_act_eq_project_act";
   12.44 +val bij_extend_act = thm "bij_extend_act";
   12.45 +val bij_project_act = thm "bij_project_act";
   12.46 +val bij_inv_project_act_eq = thm "bij_inv_project_act_eq";
   12.47 +val Acts_project = thm "Acts_project";
   12.48 +val extend_inv = thm "extend_inv";
   12.49 +val rename_inv_rename = thm "rename_inv_rename";
   12.50 +val rename_rename_inv = thm "rename_rename_inv";
   12.51 +val rename_inv_eq = thm "rename_inv_eq";
   12.52 +val bij_extend = thm "bij_extend";
   12.53 +val bij_project = thm "bij_project";
   12.54 +val inv_project_eq = thm "inv_project_eq";
   12.55 +val Allowed_rename = thm "Allowed_rename";
   12.56 +val bij_rename = thm "bij_rename";
   12.57 +val surj_rename = thm "surj_rename";
   12.58 +val inj_rename_imp_inj = thm "inj_rename_imp_inj";
   12.59 +val surj_rename_imp_surj = thm "surj_rename_imp_surj";
   12.60 +val bij_rename_imp_bij = thm "bij_rename_imp_bij";
   12.61 +val bij_rename_iff = thm "bij_rename_iff";
   12.62 +val rename_SKIP = thm "rename_SKIP";
   12.63 +val rename_Join = thm "rename_Join";
   12.64 +val rename_JN = thm "rename_JN";
   12.65 +val rename_constrains = thm "rename_constrains";
   12.66 +val rename_stable = thm "rename_stable";
   12.67 +val rename_invariant = thm "rename_invariant";
   12.68 +val rename_increasing = thm "rename_increasing";
   12.69 +val reachable_rename_eq = thm "reachable_rename_eq";
   12.70 +val rename_Constrains = thm "rename_Constrains";
   12.71 +val rename_Stable = thm "rename_Stable";
   12.72 +val rename_Always = thm "rename_Always";
   12.73 +val rename_Increasing = thm "rename_Increasing";
   12.74 +val rename_transient = thm "rename_transient";
   12.75 +val rename_ensures = thm "rename_ensures";
   12.76 +val rename_leadsTo = thm "rename_leadsTo";
   12.77 +val rename_LeadsTo = thm "rename_LeadsTo";
   12.78 +val rename_rename_guarantees_eq = thm "rename_rename_guarantees_eq";
   12.79 +val rename_guarantees_eq_rename_inv = thm "rename_guarantees_eq_rename_inv";
   12.80 +val rename_preserves = thm "rename_preserves";
   12.81 +val ok_rename_iff = thm "ok_rename_iff";
   12.82 +val OK_rename_iff = thm "OK_rename_iff";
   12.83 +val bij_eq_rename = thm "bij_eq_rename";
   12.84 +val rename_image_constrains = thm "rename_image_constrains";
   12.85 +val rename_image_stable = thm "rename_image_stable";
   12.86 +val rename_image_increasing = thm "rename_image_increasing";
   12.87 +val rename_image_invariant = thm "rename_image_invariant";
   12.88 +val rename_image_Constrains = thm "rename_image_Constrains";
   12.89 +val rename_image_preserves = thm "rename_image_preserves";
   12.90 +val rename_image_Stable = thm "rename_image_Stable";
   12.91 +val rename_image_Increasing = thm "rename_image_Increasing";
   12.92 +val rename_image_Always = thm "rename_image_Always";
   12.93 +val rename_image_leadsTo = thm "rename_image_leadsTo";
   12.94 +val rename_image_LeadsTo = thm "rename_image_LeadsTo";
   12.95 +
   12.96 +
   12.97  
   12.98  (*Lift_prog*)
   12.99  val sub_def = thm "sub_def";