reorganization of HOL/UNITY, moving examples to subdirectories Simple and Comp
authorpaulson
Mon Mar 05 15:25:11 2001 +0100 (2001-03-05)
changeset 11193851c90b23a9e
parent 11192 5fd02b905a9a
child 11194 ea13ff5a26d1
reorganization of HOL/UNITY, moving examples to subdirectories Simple and Comp
src/HOL/IsaMakefile
src/HOL/UNITY/Alloc.ML
src/HOL/UNITY/Alloc.thy
src/HOL/UNITY/AllocBase.ML
src/HOL/UNITY/AllocBase.thy
src/HOL/UNITY/AllocImpl.ML
src/HOL/UNITY/AllocImpl.thy
src/HOL/UNITY/Channel.ML
src/HOL/UNITY/Channel.thy
src/HOL/UNITY/Client.ML
src/HOL/UNITY/Client.thy
src/HOL/UNITY/Common.ML
src/HOL/UNITY/Common.thy
src/HOL/UNITY/Counter.ML
src/HOL/UNITY/Counter.thy
src/HOL/UNITY/Counterc.ML
src/HOL/UNITY/Counterc.thy
src/HOL/UNITY/Deadlock.ML
src/HOL/UNITY/Deadlock.thy
src/HOL/UNITY/Handshake.ML
src/HOL/UNITY/Handshake.thy
src/HOL/UNITY/Lift.ML
src/HOL/UNITY/Lift.thy
src/HOL/UNITY/Mutex.ML
src/HOL/UNITY/Mutex.thy
src/HOL/UNITY/NSP_Bad.ML
src/HOL/UNITY/NSP_Bad.thy
src/HOL/UNITY/Network.ML
src/HOL/UNITY/Network.thy
src/HOL/UNITY/Priority.ML
src/HOL/UNITY/Priority.thy
src/HOL/UNITY/PriorityAux.ML
src/HOL/UNITY/PriorityAux.thy
src/HOL/UNITY/README.html
src/HOL/UNITY/ROOT.ML
src/HOL/UNITY/Reach.ML
src/HOL/UNITY/Reach.thy
src/HOL/UNITY/Reachability.ML
src/HOL/UNITY/Reachability.thy
src/HOL/UNITY/TimerArray.ML
src/HOL/UNITY/TimerArray.thy
src/HOL/UNITY/Token.ML
src/HOL/UNITY/Token.thy
     1.1 --- a/src/HOL/IsaMakefile	Mon Mar 05 12:31:31 2001 +0100
     1.2 +++ b/src/HOL/IsaMakefile	Mon Mar 05 15:25:11 2001 +0100
     1.3 @@ -320,28 +320,39 @@
     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/Alloc.ML UNITY/Alloc.thy UNITY/AllocBase.ML UNITY/AllocBase.thy \
     1.8 -  UNITY/Channel.ML UNITY/Channel.thy UNITY/Client.ML UNITY/Client.thy \
     1.9 -  UNITY/Common.ML UNITY/Common.thy UNITY/Comp.ML UNITY/Comp.thy \
    1.10 -  UNITY/Counter.ML UNITY/Counter.thy UNITY/Counterc.ML UNITY/Counterc.thy \
    1.11 -  UNITY/Deadlock.ML UNITY/Deadlock.thy UNITY/Detects.ML \
    1.12 -  UNITY/Detects.thy UNITY/ELT.ML UNITY/ELT.thy UNITY/Extend.ML \
    1.13 +  UNITY/Comp.ML UNITY/Comp.thy \
    1.14 +  UNITY/Detects.ML UNITY/Detects.thy \
    1.15 +  UNITY/ELT.ML UNITY/ELT.thy UNITY/Extend.ML \
    1.16    UNITY/Extend.thy UNITY/FP.ML UNITY/FP.thy UNITY/Follows.ML \
    1.17    UNITY/Follows.thy UNITY/GenPrefix.ML UNITY/GenPrefix.thy \
    1.18 -  UNITY/Guar.ML UNITY/Guar.thy UNITY/Handshake.ML UNITY/Handshake.thy \
    1.19 -  UNITY/Lift.ML UNITY/Lift.thy UNITY/Lift_prog.ML UNITY/Lift_prog.thy \
    1.20 -  UNITY/ListOrder.thy UNITY/Mutex.ML UNITY/Mutex.thy UNITY/NSP_Bad.ML \
    1.21 -  UNITY/NSP_Bad.thy UNITY/Network.ML UNITY/Network.thy  \
    1.22 +  UNITY/Guar.ML UNITY/Guar.thy  \
    1.23 +  UNITY/Lift_prog.ML UNITY/Lift_prog.thy \
    1.24 +  UNITY/ListOrder.thy  \
    1.25    UNITY/PPROD.ML UNITY/PPROD.thy \
    1.26 -  UNITY/PriorityAux.ML UNITY/PriorityAux.thy \
    1.27 -  UNITY/Priority.ML UNITY/Priority.thy \
    1.28    UNITY/Project.ML UNITY/Project.thy \
    1.29 -  UNITY/Reach.ML UNITY/Reach.thy UNITY/Reachability.ML \
    1.30 -  UNITY/Reachability.thy UNITY/Rename.ML UNITY/Rename.thy \
    1.31 -  UNITY/SubstAx.ML UNITY/SubstAx.thy UNITY/TimerArray.ML \
    1.32 -  UNITY/TimerArray.thy UNITY/Token.ML UNITY/Token.thy UNITY/UNITY.ML \
    1.33 +  UNITY/Rename.ML UNITY/Rename.thy \
    1.34 +  UNITY/SubstAx.ML UNITY/SubstAx.thy UNITY/UNITY.ML \
    1.35    UNITY/UNITY.thy UNITY/Union.ML UNITY/Union.thy UNITY/WFair.ML \
    1.36 -  UNITY/WFair.thy
    1.37 +  UNITY/WFair.thy \
    1.38 +  UNITY/Simple/Channel.ML UNITY/Simple/Channel.thy  \
    1.39 +  UNITY/Simple/Common.ML UNITY/Simple/Common.thy  \
    1.40 +  UNITY/Simple/Deadlock.ML UNITY/Simple/Deadlock.thy  \
    1.41 +  UNITY/Simple/Lift.ML UNITY/Simple/Lift.thy  \
    1.42 +  UNITY/Simple/Mutex.ML UNITY/Simple/Mutex.thy  \
    1.43 +  UNITY/Simple/NSP_Bad.ML UNITY/Simple/NSP_Bad.thy  \
    1.44 +  UNITY/Simple/Network.ML UNITY/Simple/Network.thy  \
    1.45 +  UNITY/Simple/Reach.ML UNITY/Simple/Reach.thy   \
    1.46 +  UNITY/Simple/Reachability.ML UNITY/Simple/Reachability.thy   \
    1.47 +  UNITY/Simple/Token.ML UNITY/Simple/Token.thy \
    1.48 +  UNITY/Comp/Alloc.ML UNITY/Comp/Alloc.thy \
    1.49 +  UNITY/Comp/AllocBase.ML UNITY/Comp/AllocBase.thy \
    1.50 +  UNITY/Comp/Client.ML UNITY/Comp/Client.thy \
    1.51 +  UNITY/Comp/Counter.ML UNITY/Comp/Counter.thy \
    1.52 +  UNITY/Comp/Counterc.ML UNITY/Comp/Counterc.thy \
    1.53 +  UNITY/Comp/Handshake.ML UNITY/Comp/Handshake.thy \
    1.54 +  UNITY/Comp/PriorityAux.ML UNITY/Comp/PriorityAux.thy \
    1.55 +  UNITY/Comp/Priority.ML UNITY/Comp/Priority.thy \
    1.56 +  UNITY/Comp/TimerArray.ML UNITY/Comp/TimerArray.thy
    1.57  	@$(ISATOOL) usedir $(OUT)/HOL UNITY
    1.58  
    1.59  
     2.1 --- a/src/HOL/UNITY/Alloc.ML	Mon Mar 05 12:31:31 2001 +0100
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,744 +0,0 @@
     2.4 -(*  Title:      HOL/UNITY/Alloc
     2.5 -    ID:         $Id$
     2.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     2.7 -    Copyright   1998  University of Cambridge
     2.8 -
     2.9 -Specification of Chandy and Charpentier's Allocator
    2.10 -*)
    2.11 -
    2.12 -(*Perhaps equalities.ML shouldn't add this in the first place!*)
    2.13 -Delsimps [image_Collect];
    2.14 -
    2.15 -AddIs    [impOfSubs subset_preserves_o];
    2.16 -Addsimps [impOfSubs subset_preserves_o];
    2.17 -Addsimps [funPair_o_distrib];
    2.18 -Addsimps [Always_INT_distrib];
    2.19 -Delsimps [o_apply];
    2.20 -
    2.21 -(*Eliminate the "o" operator*)
    2.22 -val o_simp = simplify (simpset() addsimps [o_def]);
    2.23 -
    2.24 -(*For rewriting of specifications related by "guarantees"*)
    2.25 -Addsimps [rename_image_constrains, rename_image_stable, 
    2.26 -	  rename_image_increasing, rename_image_invariant,
    2.27 -	  rename_image_Constrains, rename_image_Stable,
    2.28 -	  rename_image_Increasing, rename_image_Always,
    2.29 -	  rename_image_leadsTo, rename_image_LeadsTo,
    2.30 -	  rename_preserves, rename_image_preserves, lift_image_preserves,
    2.31 -	  bij_image_INT, bij_is_inj RS image_Int, bij_image_Collect_eq];
    2.32 -
    2.33 -(*Splits up conjunctions & intersections: like CONJUNCTS in the HOL system*)
    2.34 -fun list_of_Int th = 
    2.35 -    (list_of_Int (th RS conjunct1) @ list_of_Int (th RS conjunct2))
    2.36 -    handle THM _ => (list_of_Int (th RS IntD1) @ list_of_Int (th RS IntD2))
    2.37 -    handle THM _ => (list_of_Int (th RS INT_D))
    2.38 -    handle THM _ => (list_of_Int (th RS bspec))
    2.39 -    handle THM _ => [th];
    2.40 -
    2.41 -(*Used just once, for Alloc_Increasing*)
    2.42 -val lessThanBspec = lessThan_iff RS iffD2 RSN (2, bspec);
    2.43 -fun normalize th = 
    2.44 -     normalize (th RS spec
    2.45 -		handle THM _ => th RS lessThanBspec
    2.46 -		handle THM _ => th RS bspec
    2.47 -		handle THM _ => th RS (guarantees_INT_right_iff RS iffD1))
    2.48 -     handle THM _ => th;
    2.49 -
    2.50 -
    2.51 -
    2.52 -(*** bijectivity of sysOfAlloc [MUST BE AUTOMATED] ***)
    2.53 -
    2.54 -val record_auto_tac =
    2.55 -    auto_tac (claset() addIs [ext] addSWrapper record_split_wrapper, 
    2.56 -	      simpset() addsimps [sysOfAlloc_def, sysOfClient_def,
    2.57 -				  client_map_def, non_dummy_def, funPair_def,
    2.58 -				  o_apply, Let_def]);
    2.59 -
    2.60 -
    2.61 -Goalw [sysOfAlloc_def, Let_def] "inj sysOfAlloc";
    2.62 -by (rtac injI 1);
    2.63 -by record_auto_tac;
    2.64 -qed "inj_sysOfAlloc";
    2.65 -AddIffs [inj_sysOfAlloc];
    2.66 -
    2.67 -(*We need the inverse; also having it simplifies the proof of surjectivity*)
    2.68 -Goal "!!s. inv sysOfAlloc s = \
    2.69 -\            (| allocGiv = allocGiv s,   \
    2.70 -\               allocAsk = allocAsk s,   \
    2.71 -\               allocRel = allocRel s,   \
    2.72 -\               allocState_d.dummy = (client s, dummy s) |)";
    2.73 -by (rtac (inj_sysOfAlloc RS inv_f_eq) 1);
    2.74 -by record_auto_tac;
    2.75 -qed "inv_sysOfAlloc_eq";
    2.76 -Addsimps [inv_sysOfAlloc_eq];
    2.77 -
    2.78 -Goal "surj sysOfAlloc";
    2.79 -by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1);
    2.80 -by record_auto_tac;
    2.81 -qed "surj_sysOfAlloc";
    2.82 -AddIffs [surj_sysOfAlloc];
    2.83 -
    2.84 -Goal "bij sysOfAlloc";
    2.85 -by (blast_tac (claset() addIs [bijI]) 1);
    2.86 -qed "bij_sysOfAlloc";
    2.87 -AddIffs [bij_sysOfAlloc];
    2.88 -
    2.89 -
    2.90 -(*** bijectivity of sysOfClient ***)
    2.91 -
    2.92 -Goalw [sysOfClient_def] "inj sysOfClient";
    2.93 -by (rtac injI 1);
    2.94 -by record_auto_tac;
    2.95 -qed "inj_sysOfClient";
    2.96 -AddIffs [inj_sysOfClient];
    2.97 -
    2.98 -Goal "!!s. inv sysOfClient s = \
    2.99 -\            (client s, \
   2.100 -\             (| allocGiv = allocGiv s, \
   2.101 -\                allocAsk = allocAsk s, \
   2.102 -\                allocRel = allocRel s, \
   2.103 -\                allocState_d.dummy = systemState.dummy s|) )";
   2.104 -by (rtac (inj_sysOfClient RS inv_f_eq) 1);
   2.105 -by record_auto_tac;
   2.106 -qed "inv_sysOfClient_eq";
   2.107 -Addsimps [inv_sysOfClient_eq];
   2.108 -
   2.109 -Goal "surj sysOfClient";
   2.110 -by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1);
   2.111 -by record_auto_tac;
   2.112 -qed "surj_sysOfClient";
   2.113 -AddIffs [surj_sysOfClient];
   2.114 -
   2.115 -Goal "bij sysOfClient";
   2.116 -by (blast_tac (claset() addIs [bijI]) 1);
   2.117 -qed "bij_sysOfClient";
   2.118 -AddIffs [bij_sysOfClient];
   2.119 -
   2.120 -
   2.121 -(*** bijectivity of client_map ***)
   2.122 -
   2.123 -Goalw [inj_on_def] "inj client_map";
   2.124 -by record_auto_tac;
   2.125 -qed "inj_client_map";
   2.126 -AddIffs [inj_client_map];
   2.127 -
   2.128 -Goal "!!s. inv client_map s = \
   2.129 -\            (%(x,y).(|giv = giv x, ask = ask x, rel = rel x, \
   2.130 -\                      clientState_d.dummy = y|)) s";
   2.131 -by (rtac (inj_client_map RS inv_f_eq) 1);
   2.132 -by record_auto_tac;
   2.133 -qed "inv_client_map_eq";
   2.134 -Addsimps [inv_client_map_eq];
   2.135 -
   2.136 -Goal "surj client_map";
   2.137 -by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1);
   2.138 -by record_auto_tac;
   2.139 -qed "surj_client_map";
   2.140 -AddIffs [surj_client_map];
   2.141 -
   2.142 -Goal "bij client_map";
   2.143 -by (blast_tac (claset() addIs [bijI]) 1);
   2.144 -qed "bij_client_map";
   2.145 -AddIffs [bij_client_map];
   2.146 -
   2.147 -
   2.148 -(** o-simprules for client_map **)
   2.149 -
   2.150 -Goalw [client_map_def] "fst o client_map = non_dummy";
   2.151 -by (rtac fst_o_funPair 1);
   2.152 -qed "fst_o_client_map";
   2.153 -Addsimps (make_o_equivs fst_o_client_map);
   2.154 -
   2.155 -Goalw [client_map_def] "snd o client_map = clientState_d.dummy";
   2.156 -by (rtac snd_o_funPair 1);
   2.157 -qed "snd_o_client_map";
   2.158 -Addsimps (make_o_equivs snd_o_client_map);
   2.159 -
   2.160 -(** o-simprules for sysOfAlloc [MUST BE AUTOMATED] **)
   2.161 -
   2.162 -Goal "client o sysOfAlloc = fst o allocState_d.dummy ";
   2.163 -by record_auto_tac;
   2.164 -qed "client_o_sysOfAlloc";
   2.165 -Addsimps (make_o_equivs client_o_sysOfAlloc);
   2.166 -
   2.167 -Goal "allocGiv o sysOfAlloc = allocGiv";
   2.168 -by record_auto_tac;
   2.169 -qed "allocGiv_o_sysOfAlloc_eq";
   2.170 -Addsimps (make_o_equivs allocGiv_o_sysOfAlloc_eq);
   2.171 -
   2.172 -Goal "allocAsk o sysOfAlloc = allocAsk";
   2.173 -by record_auto_tac;
   2.174 -qed "allocAsk_o_sysOfAlloc_eq";
   2.175 -Addsimps (make_o_equivs allocAsk_o_sysOfAlloc_eq);
   2.176 -
   2.177 -Goal "allocRel o sysOfAlloc = allocRel";
   2.178 -by record_auto_tac;
   2.179 -qed "allocRel_o_sysOfAlloc_eq";
   2.180 -Addsimps (make_o_equivs allocRel_o_sysOfAlloc_eq);
   2.181 -
   2.182 -(** o-simprules for sysOfClient [MUST BE AUTOMATED] **)
   2.183 -
   2.184 -Goal "client o sysOfClient = fst";
   2.185 -by record_auto_tac;
   2.186 -qed "client_o_sysOfClient";
   2.187 -Addsimps (make_o_equivs client_o_sysOfClient);
   2.188 -
   2.189 -Goal "allocGiv o sysOfClient = allocGiv o snd ";
   2.190 -by record_auto_tac;
   2.191 -qed "allocGiv_o_sysOfClient_eq";
   2.192 -Addsimps (make_o_equivs allocGiv_o_sysOfClient_eq);
   2.193 -
   2.194 -Goal "allocAsk o sysOfClient = allocAsk o snd ";
   2.195 -by record_auto_tac;
   2.196 -qed "allocAsk_o_sysOfClient_eq";
   2.197 -Addsimps (make_o_equivs allocAsk_o_sysOfClient_eq);
   2.198 -
   2.199 -Goal "allocRel o sysOfClient = allocRel o snd ";
   2.200 -by record_auto_tac;
   2.201 -qed "allocRel_o_sysOfClient_eq";
   2.202 -Addsimps (make_o_equivs allocRel_o_sysOfClient_eq);
   2.203 -
   2.204 -Goal "allocGiv o inv sysOfAlloc = allocGiv";
   2.205 -by (simp_tac (simpset() addsimps [o_def]) 1); 
   2.206 -qed "allocGiv_o_inv_sysOfAlloc_eq";
   2.207 -Addsimps (make_o_equivs allocGiv_o_inv_sysOfAlloc_eq);
   2.208 -
   2.209 -Goal "allocAsk o inv sysOfAlloc = allocAsk";
   2.210 -by (simp_tac (simpset() addsimps [o_def]) 1); 
   2.211 -qed "allocAsk_o_inv_sysOfAlloc_eq";
   2.212 -Addsimps (make_o_equivs allocAsk_o_inv_sysOfAlloc_eq);
   2.213 -
   2.214 -Goal "allocRel o inv sysOfAlloc = allocRel";
   2.215 -by (simp_tac (simpset() addsimps [o_def]) 1); 
   2.216 -qed "allocRel_o_inv_sysOfAlloc_eq";
   2.217 -Addsimps (make_o_equivs allocRel_o_inv_sysOfAlloc_eq);
   2.218 -
   2.219 -Goal "(rel o inv client_map o drop_map i o inv sysOfClient) = \
   2.220 -\     rel o sub i o client";
   2.221 -by (simp_tac (simpset() addsimps [o_def, drop_map_def]) 1); 
   2.222 -qed "rel_inv_client_map_drop_map";
   2.223 -Addsimps (make_o_equivs rel_inv_client_map_drop_map);
   2.224 -
   2.225 -Goal "(ask o inv client_map o drop_map i o inv sysOfClient) = \
   2.226 -\     ask o sub i o client";
   2.227 -by (simp_tac (simpset() addsimps [o_def, drop_map_def]) 1); 
   2.228 -qed "ask_inv_client_map_drop_map";
   2.229 -Addsimps (make_o_equivs ask_inv_client_map_drop_map);
   2.230 -
   2.231 -(**
   2.232 -Open_locale "System";
   2.233 -
   2.234 -val Alloc = thm "Alloc";
   2.235 -val Client = thm "Client";
   2.236 -val Network = thm "Network";
   2.237 -val System_def = thm "System_def";
   2.238 -
   2.239 -CANNOT use bind_thm: it puts the theorem into standard form, in effect
   2.240 -  exporting it from the locale
   2.241 -**)
   2.242 -
   2.243 -AddIffs [finite_lessThan];
   2.244 -
   2.245 -(*Client : <unfolded specification> *)
   2.246 -val client_spec_simps = 
   2.247 -    [client_spec_def, client_increasing_def, client_bounded_def, 
   2.248 -     client_progress_def, client_allowed_acts_def, client_preserves_def, 
   2.249 -     guarantees_Int_right];
   2.250 -
   2.251 -val [Client_Increasing_ask, Client_Increasing_rel,
   2.252 -     Client_Bounded, Client_Progress, Client_AllowedActs, 
   2.253 -     Client_preserves_giv, Client_preserves_dummy] =
   2.254 -        Client |> simplify (simpset() addsimps client_spec_simps) 
   2.255 -               |> list_of_Int;
   2.256 -
   2.257 -AddIffs [Client_Increasing_ask, Client_Increasing_rel, Client_Bounded,
   2.258 -	 Client_preserves_giv, Client_preserves_dummy];
   2.259 -
   2.260 -
   2.261 -(*Network : <unfolded specification> *)
   2.262 -val network_spec_simps = 
   2.263 -    [network_spec_def, network_ask_def, network_giv_def, 
   2.264 -     network_rel_def, network_allowed_acts_def, network_preserves_def, 
   2.265 -     ball_conj_distrib];
   2.266 -
   2.267 -val [Network_Ask, Network_Giv, Network_Rel, Network_AllowedActs,
   2.268 -     Network_preserves_allocGiv, Network_preserves_rel, 
   2.269 -     Network_preserves_ask]  =  
   2.270 -        Network |> simplify (simpset() addsimps network_spec_simps) 
   2.271 -                |> list_of_Int;
   2.272 -
   2.273 -AddIffs  [Network_preserves_allocGiv];
   2.274 -
   2.275 -Addsimps [Network_preserves_rel, Network_preserves_ask];
   2.276 -Addsimps [o_simp Network_preserves_rel, o_simp Network_preserves_ask];
   2.277 -
   2.278 -
   2.279 -(*Alloc : <unfolded specification> *)
   2.280 -val alloc_spec_simps = 
   2.281 -    [alloc_spec_def, alloc_increasing_def, alloc_safety_def, 
   2.282 -		  alloc_progress_def, alloc_allowed_acts_def, 
   2.283 -                  alloc_preserves_def];
   2.284 -
   2.285 -val [Alloc_Increasing_0, Alloc_Safety, Alloc_Progress, Alloc_AllowedActs,
   2.286 -     Alloc_preserves_allocRel, Alloc_preserves_allocAsk, 
   2.287 -     Alloc_preserves_dummy] = 
   2.288 -        Alloc |> simplify (simpset() addsimps alloc_spec_simps) 
   2.289 -              |> list_of_Int;
   2.290 -
   2.291 -(*Strip off the INT in the guarantees postcondition*)
   2.292 -val Alloc_Increasing = normalize Alloc_Increasing_0;
   2.293 -
   2.294 -AddIffs [Alloc_preserves_allocRel, Alloc_preserves_allocAsk, 
   2.295 -         Alloc_preserves_dummy];
   2.296 -
   2.297 -(** Components lemmas [MUST BE AUTOMATED] **)
   2.298 -
   2.299 -Goal "Network Join \
   2.300 -\     ((rename sysOfClient \
   2.301 -\       (plam x: (lessThan Nclients). rename client_map Client)) Join \
   2.302 -\      rename sysOfAlloc Alloc) \
   2.303 -\     = System";
   2.304 -by (simp_tac (simpset() addsimps System_def::Join_ac) 1);
   2.305 -qed "Network_component_System";
   2.306 -
   2.307 -Goal "(rename sysOfClient \
   2.308 -\      (plam x: (lessThan Nclients). rename client_map Client)) Join \
   2.309 -\     (Network Join rename sysOfAlloc Alloc)  =  System";
   2.310 -by (simp_tac (simpset() addsimps System_def::Join_ac) 1);
   2.311 -qed "Client_component_System";
   2.312 -
   2.313 -Goal "rename sysOfAlloc Alloc Join \
   2.314 -\      ((rename sysOfClient (plam x: (lessThan Nclients). rename client_map Client)) Join \
   2.315 -\       Network)  =  System";
   2.316 -by (simp_tac (simpset() addsimps System_def::Join_ac) 1);
   2.317 -qed "Alloc_component_System";
   2.318 -
   2.319 -AddIffs [Client_component_System, Network_component_System, 
   2.320 -	 Alloc_component_System];
   2.321 -
   2.322 -(** These preservation laws should be generated automatically **)
   2.323 -
   2.324 -Goal "Allowed Client = preserves rel Int preserves ask";
   2.325 -by (auto_tac (claset(), 
   2.326 -              simpset() addsimps [Allowed_def, Client_AllowedActs, 
   2.327 -                                  safety_prop_Acts_iff]));  
   2.328 -qed "Client_Allowed";
   2.329 -Addsimps [Client_Allowed];
   2.330 -
   2.331 -Goal "Allowed Network =        \
   2.332 -\       preserves allocRel Int \
   2.333 -\       (INT i: lessThan Nclients. preserves(giv o sub i o client))";
   2.334 -by (auto_tac (claset(), 
   2.335 -              simpset() addsimps [Allowed_def, Network_AllowedActs, 
   2.336 -                                  safety_prop_Acts_iff]));  
   2.337 -qed "Network_Allowed";
   2.338 -Addsimps [Network_Allowed];
   2.339 -
   2.340 -Goal "Allowed Alloc = preserves allocGiv";
   2.341 -by (auto_tac (claset(), 
   2.342 -              simpset() addsimps [Allowed_def, Alloc_AllowedActs, 
   2.343 -                                  safety_prop_Acts_iff]));  
   2.344 -qed "Alloc_Allowed";
   2.345 -Addsimps [Alloc_Allowed];
   2.346 -
   2.347 -Goal "OK I (%i. lift i (rename client_map Client))";
   2.348 -by (rtac OK_lift_I 1); 
   2.349 -by Auto_tac;  
   2.350 -by (dres_inst_tac [("w1", "rel")] (impOfSubs subset_preserves_o) 1);
   2.351 -by (dres_inst_tac [("w1", "ask")] (impOfSubs subset_preserves_o) 2);
   2.352 -by (auto_tac (claset(), simpset() addsimps [o_def, split_def]));  
   2.353 -qed "OK_lift_rename_Client";
   2.354 -Addsimps [OK_lift_rename_Client]; (*needed in rename_client_map_tac*
   2.355 -
   2.356 -(*The proofs of rename_Client_Increasing, rename_Client_Bounded and
   2.357 -  rename_Client_Progress are similar.  All require copying out the original
   2.358 -  Client property.  A forward proof can be constructed as follows:
   2.359 -
   2.360 -  Client_Increasing_ask RS
   2.361 -      (bij_client_map RS rename_rename_guarantees_eq RS iffD2)
   2.362 -  RS (lift_lift_guarantees_eq RS iffD2)
   2.363 -  RS guarantees_PLam_I
   2.364 -  RS (bij_sysOfClient RS rename_rename_guarantees_eq RS iffD2)
   2.365 -  |> simplify (simpset() addsimps [lift_image_eq_rename, o_def, split_def, 
   2.366 -				   surj_rename RS surj_range]);
   2.367 -
   2.368 -However, the "preserves" property remains to be discharged, and the unfolding
   2.369 -of "o" and "sub" complicates subsequent reasoning.
   2.370 -
   2.371 -The following tactic works for all three proofs, though it certainly looks
   2.372 -ad-hoc!
   2.373 -*)
   2.374 -val rename_client_map_tac =
   2.375 -  EVERY [
   2.376 -    simp_tac (simpset() addsimps [rename_guarantees_eq_rename_inv]) 1,
   2.377 -    rtac guarantees_PLam_I 1,
   2.378 -    assume_tac 2,
   2.379 -	 (*preserves: routine reasoning*)
   2.380 -    asm_simp_tac (simpset() addsimps [lift_preserves_sub]) 2,
   2.381 -	 (*the guarantee for  "lift i (rename client_map Client)" *)
   2.382 -    asm_simp_tac
   2.383 -	(simpset() addsimps [lift_guarantees_eq_lift_inv,
   2.384 -			     rename_guarantees_eq_rename_inv,
   2.385 -			     bij_imp_bij_inv, surj_rename RS surj_range,
   2.386 -			     inv_inv_eq]) 1,
   2.387 -    asm_simp_tac
   2.388 -        (simpset() addsimps [o_def, non_dummy_def, guarantees_Int_right]) 1];
   2.389 -
   2.390 -						     
   2.391 -(*Lifting Client_Increasing to systemState*)
   2.392 -Goal "i : I \
   2.393 -\     ==> rename sysOfClient (plam x: I. rename client_map Client) : \
   2.394 -\           UNIV  guarantees  \
   2.395 -\           Increasing (ask o sub i o client) Int \
   2.396 -\           Increasing (rel o sub i o client)";
   2.397 -by rename_client_map_tac;
   2.398 -qed "rename_Client_Increasing";
   2.399 -
   2.400 -Goal "[| F : preserves w; i ~= j |] \
   2.401 -\     ==> F : preserves (sub i o fst o lift_map j o funPair v w)";
   2.402 -by (auto_tac (claset(), 
   2.403 -       simpset() addsimps [lift_map_def, split_def, linorder_neq_iff, o_def]));
   2.404 -by (ALLGOALS (dtac (impOfSubs subset_preserves_o)));
   2.405 -by (auto_tac (claset(), simpset() addsimps [o_def]));  
   2.406 -qed "preserves_sub_fst_lift_map";
   2.407 -
   2.408 -Goal "[| i < Nclients; j < Nclients |] \
   2.409 -\     ==> Client : preserves (giv o sub i o fst o lift_map j o client_map)";
   2.410 -by (case_tac "i=j" 1);
   2.411 -by (asm_full_simp_tac (simpset() addsimps [o_def, non_dummy_def]) 1);
   2.412 -by (dtac (Client_preserves_dummy RS preserves_sub_fst_lift_map) 1);
   2.413 -by (ALLGOALS (dtac (impOfSubs subset_preserves_o)));
   2.414 -by (asm_full_simp_tac (simpset() addsimps [o_def, client_map_def]) 1);  
   2.415 -qed "client_preserves_giv_oo_client_map";
   2.416 -
   2.417 -Goal "rename sysOfClient (plam x: lessThan Nclients. rename client_map Client)\
   2.418 -\     ok Network";
   2.419 -by (auto_tac (claset(), simpset() addsimps [ok_iff_Allowed,
   2.420 -        client_preserves_giv_oo_client_map]));  
   2.421 -qed "rename_sysOfClient_ok_Network";
   2.422 -
   2.423 -Goal "rename sysOfClient (plam x: lessThan Nclients. rename client_map Client)\
   2.424 -\     ok rename sysOfAlloc Alloc";
   2.425 -by (simp_tac (simpset() addsimps [ok_iff_Allowed]) 1);
   2.426 -qed "rename_sysOfClient_ok_Alloc";
   2.427 -
   2.428 -Goal "rename sysOfAlloc Alloc ok Network";
   2.429 -by (simp_tac (simpset() addsimps [ok_iff_Allowed]) 1);
   2.430 -qed "rename_sysOfAlloc_ok_Network";
   2.431 -
   2.432 -AddIffs [rename_sysOfClient_ok_Network, rename_sysOfClient_ok_Alloc,
   2.433 -         rename_sysOfAlloc_ok_Network];
   2.434 -
   2.435 -(*The "ok" laws, re-oriented*)
   2.436 -AddIffs [rename_sysOfClient_ok_Network RS ok_sym,
   2.437 -         rename_sysOfClient_ok_Alloc RS ok_sym,
   2.438 -         rename_sysOfAlloc_ok_Network RS ok_sym];
   2.439 -
   2.440 -Goal "i < Nclients \
   2.441 -\     ==> System : Increasing (ask o sub i o client) Int \
   2.442 -\                  Increasing (rel o sub i o client)";
   2.443 -by (rtac ([rename_Client_Increasing,
   2.444 -	   Client_component_System] MRS component_guaranteesD) 1);
   2.445 -by Auto_tac;  
   2.446 -qed "System_Increasing";
   2.447 -
   2.448 -bind_thm ("rename_guarantees_sysOfAlloc_I",
   2.449 -	  bij_sysOfAlloc RS rename_rename_guarantees_eq RS iffD2);
   2.450 -
   2.451 -
   2.452 -(*Lifting Alloc_Increasing up to the level of systemState*)
   2.453 -val rename_Alloc_Increasing = 
   2.454 -    Alloc_Increasing RS rename_guarantees_sysOfAlloc_I
   2.455 -     |> simplify (simpset() addsimps [surj_rename RS surj_range, o_def]);
   2.456 -
   2.457 -Goalw [System_def]
   2.458 -     "i < Nclients ==> System : Increasing (sub i o allocGiv)";
   2.459 -by (simp_tac (simpset() addsimps [o_def]) 1);
   2.460 -by (rtac (rename_Alloc_Increasing RS guarantees_Join_I1 RS guaranteesD) 1);
   2.461 -by Auto_tac;
   2.462 -qed "System_Increasing_allocGiv";
   2.463 -
   2.464 -AddSIs (list_of_Int System_Increasing);
   2.465 -
   2.466 -(** Follows consequences.
   2.467 -    The "Always (INT ...) formulation expresses the general safety property
   2.468 -    and allows it to be combined using Always_Int_rule below. **)
   2.469 -
   2.470 -Goal
   2.471 -  "i < Nclients ==> System : ((sub i o allocRel) Fols (rel o sub i o client))";
   2.472 -by (auto_tac (claset() addSIs [Network_Rel RS component_guaranteesD], 
   2.473 -	      simpset()));
   2.474 -qed "System_Follows_rel";
   2.475 -
   2.476 -Goal
   2.477 -  "i < Nclients ==> System : ((sub i o allocAsk) Fols (ask o sub i o client))";
   2.478 -by (auto_tac (claset() addSIs [Network_Ask RS component_guaranteesD], 
   2.479 -	      simpset()));
   2.480 -qed "System_Follows_ask";
   2.481 -
   2.482 -Goal
   2.483 -  "i < Nclients ==> System : (giv o sub i o client) Fols (sub i o allocGiv)";
   2.484 -by (auto_tac (claset() addSIs [Network_Giv RS component_guaranteesD, 
   2.485 -		 rename_Alloc_Increasing RS component_guaranteesD], 
   2.486 -	      simpset()));
   2.487 -by (ALLGOALS (simp_tac (simpset() addsimps [o_def, non_dummy_def])));
   2.488 -by (auto_tac
   2.489 -    (claset() addSIs [rename_Alloc_Increasing RS component_guaranteesD],
   2.490 -     simpset()));
   2.491 -qed "System_Follows_allocGiv";
   2.492 -
   2.493 -Goal "System : Always (INT i: lessThan Nclients. \
   2.494 -\                      {s. (giv o sub i o client) s <= (sub i o allocGiv) s})";
   2.495 -by Auto_tac;
   2.496 -by (etac (System_Follows_allocGiv RS Follows_Bounded) 1);
   2.497 -qed "Always_giv_le_allocGiv";
   2.498 -
   2.499 -Goal "System : Always (INT i: lessThan Nclients. \
   2.500 -\                      {s. (sub i o allocAsk) s <= (ask o sub i o client) s})";
   2.501 -by Auto_tac;
   2.502 -by (etac (System_Follows_ask RS Follows_Bounded) 1);
   2.503 -qed "Always_allocAsk_le_ask";
   2.504 -
   2.505 -Goal "System : Always (INT i: lessThan Nclients. \
   2.506 -\                      {s. (sub i o allocRel) s <= (rel o sub i o client) s})";
   2.507 -by (auto_tac (claset() addSIs [Follows_Bounded, System_Follows_rel], 
   2.508 -	      simpset()));
   2.509 -qed "Always_allocRel_le_rel";
   2.510 -
   2.511 -
   2.512 -(*** Proof of the safety property (1) ***)
   2.513 -
   2.514 -(*safety (1), step 1 is System_Follows_rel*)
   2.515 -
   2.516 -(*safety (1), step 2*)
   2.517 -(* i < Nclients ==> System : Increasing (sub i o allocRel) *)
   2.518 -bind_thm ("System_Increasing_allocRel", 
   2.519 -          System_Follows_rel RS Follows_Increasing1);
   2.520 -
   2.521 -(*Lifting Alloc_safety up to the level of systemState.
   2.522 -  Simplififying with o_def gets rid of the translations but it unfortunately
   2.523 -  gets rid of the other "o"s too.*)
   2.524 -val rename_Alloc_Safety = 
   2.525 -    Alloc_Safety RS rename_guarantees_sysOfAlloc_I
   2.526 -     |> simplify (simpset() addsimps [o_def]);
   2.527 -
   2.528 -(*safety (1), step 3*)
   2.529 -Goal
   2.530 -  "System : Always {s. setsum (%i. (tokens o sub i o allocGiv) s) \
   2.531 -\                             (lessThan Nclients)                 \
   2.532 -\           <= NbT + setsum (%i. (tokens o sub i o allocRel) s)   \
   2.533 -\                           (lessThan Nclients)}";
   2.534 -by (simp_tac (simpset() addsimps [o_apply]) 1);
   2.535 -by (rtac (rename_Alloc_Safety RS component_guaranteesD) 1);
   2.536 -by (auto_tac (claset(), 
   2.537 -              simpset() addsimps [o_simp System_Increasing_allocRel]));
   2.538 -qed "System_sum_bounded";
   2.539 -
   2.540 -
   2.541 -(** Follows reasoning **)
   2.542 -
   2.543 -Goal "System : Always (INT i: lessThan Nclients. \
   2.544 -\                         {s. (tokens o giv o sub i o client) s \
   2.545 -\                          <= (tokens o sub i o allocGiv) s})";
   2.546 -by (rtac (Always_giv_le_allocGiv RS Always_weaken) 1);
   2.547 -by (auto_tac (claset() addIs [tokens_mono_prefix], 
   2.548 -	      simpset() addsimps [o_apply]));
   2.549 -qed "Always_tokens_giv_le_allocGiv";
   2.550 -
   2.551 -Goal "System : Always (INT i: lessThan Nclients. \
   2.552 -\                         {s. (tokens o sub i o allocRel) s \
   2.553 -\                          <= (tokens o rel o sub i o client) s})";
   2.554 -by (rtac (Always_allocRel_le_rel RS Always_weaken) 1);
   2.555 -by (auto_tac (claset() addIs [tokens_mono_prefix], 
   2.556 -	      simpset() addsimps [o_apply]));
   2.557 -qed "Always_tokens_allocRel_le_rel";
   2.558 -
   2.559 -(*safety (1), step 4 (final result!) *)
   2.560 -Goalw [system_safety_def] "System : system_safety";
   2.561 -by (rtac (Always_Int_rule [System_sum_bounded, Always_tokens_giv_le_allocGiv, 
   2.562 -			   Always_tokens_allocRel_le_rel] RS Always_weaken) 1);
   2.563 -by Auto_tac;
   2.564 -by (rtac (setsum_fun_mono RS order_trans) 1);
   2.565 -by (dtac order_trans 2);
   2.566 -by (rtac ([order_refl, setsum_fun_mono] MRS add_le_mono) 2);
   2.567 -by (assume_tac 3);
   2.568 -by Auto_tac;
   2.569 -qed "System_safety";
   2.570 -
   2.571 -
   2.572 -(*** Proof of the progress property (2) ***)
   2.573 -
   2.574 -(*progress (2), step 1 is System_Follows_ask and System_Follows_rel*)
   2.575 -
   2.576 -(*progress (2), step 2; see also System_Increasing_allocRel*)
   2.577 -(* i < Nclients ==> System : Increasing (sub i o allocAsk) *)
   2.578 -bind_thm ("System_Increasing_allocAsk",
   2.579 -          System_Follows_ask RS Follows_Increasing1);
   2.580 -
   2.581 -(*progress (2), step 3: lifting "Client_Bounded" to systemState*)
   2.582 -Goal "i : I \
   2.583 -\   ==> rename sysOfClient (plam x: I. rename client_map Client) : \
   2.584 -\         UNIV  guarantees  \
   2.585 -\         Always {s. ALL elt : set ((ask o sub i o client) s). elt <= NbT}";
   2.586 -by rename_client_map_tac;
   2.587 -qed "rename_Client_Bounded";
   2.588 -
   2.589 -Goal "i < Nclients \
   2.590 -\     ==> System : Always \
   2.591 -\                   {s. ALL elt : set ((ask o sub i o client) s). elt <= NbT}";
   2.592 -by (rtac ([rename_Client_Bounded,
   2.593 -	   Client_component_System] MRS component_guaranteesD) 1);
   2.594 -by Auto_tac;
   2.595 -qed "System_Bounded_ask";
   2.596 -
   2.597 -Goal "{x. ALL y. P y --> Q x y} = (INT y: {y. P y}. {x. Q x y})";
   2.598 -by (Blast_tac 1);
   2.599 -qed "Collect_all_imp_eq";
   2.600 -
   2.601 -(*progress (2), step 4*)
   2.602 -Goal "System : Always {s. ALL i<Nclients. \
   2.603 -\                         ALL elt : set ((sub i o allocAsk) s). elt <= NbT}";
   2.604 -by (auto_tac (claset(),  simpset() addsimps [Collect_all_imp_eq]));
   2.605 -by (rtac (Always_Int_rule [Always_allocAsk_le_ask, System_Bounded_ask] 
   2.606 -    RS Always_weaken) 1);
   2.607 -by (auto_tac (claset() addDs [set_mono], simpset()));
   2.608 -qed "System_Bounded_allocAsk";
   2.609 -
   2.610 -(*progress (2), step 5 is System_Increasing_allocGiv*)
   2.611 -
   2.612 -(*progress (2), step 6*)
   2.613 -(* i < Nclients ==> System : Increasing (giv o sub i o client) *)
   2.614 -bind_thm ("System_Increasing_giv",
   2.615 -          System_Follows_allocGiv RS Follows_Increasing1);
   2.616 -
   2.617 -
   2.618 -Goal "i: I \
   2.619 -\  ==> rename sysOfClient (plam x: I. rename client_map Client) \
   2.620 -\       : Increasing (giv o sub i o client)  \
   2.621 -\         guarantees \
   2.622 -\         (INT h. {s. h <= (giv o sub i o client) s & \
   2.623 -\                           h pfixGe (ask o sub i o client) s}  \
   2.624 -\                 LeadsTo {s. tokens h <= (tokens o rel o sub i o client) s})";
   2.625 -by rename_client_map_tac;
   2.626 -by (asm_simp_tac (simpset() addsimps [o_simp Client_Progress]) 1);
   2.627 -qed "rename_Client_Progress";
   2.628 -
   2.629 -
   2.630 -(*progress (2), step 7*)
   2.631 -Goal
   2.632 - "System : (INT i : (lessThan Nclients). \
   2.633 -\           INT h. {s. h <= (giv o sub i o client) s & \
   2.634 -\                      h pfixGe (ask o sub i o client) s}  \
   2.635 -\               LeadsTo {s. tokens h <= (tokens o rel o sub i o client) s})";
   2.636 -by (rtac INT_I 1);
   2.637 -(*Couldn't have just used Auto_tac since the "INT h" must be kept*)
   2.638 -by (rtac ([rename_Client_Progress,
   2.639 -	   Client_component_System] MRS component_guaranteesD) 1);
   2.640 -by (auto_tac (claset(), simpset() addsimps [System_Increasing_giv]));  
   2.641 -qed "System_Client_Progress";
   2.642 -
   2.643 -(*Concludes
   2.644 - System : {s. k <= (sub i o allocGiv) s} 
   2.645 -          LeadsTo
   2.646 -          {s. (sub i o allocAsk) s <= (ask o sub i o client) s} Int
   2.647 -          {s. k <= (giv o sub i o client) s} *)
   2.648 -val lemma =
   2.649 -    [System_Follows_ask RS Follows_Bounded,
   2.650 -     System_Follows_allocGiv RS Follows_LeadsTo] MRS Always_LeadsToD;
   2.651 -
   2.652 -(*A more complicated variant of the previous one*)
   2.653 -val lemma2 = [lemma, 
   2.654 -	      System_Follows_ask RS Follows_Increasing1 RS IncreasingD]
   2.655 -             MRS PSP_Stable;
   2.656 -
   2.657 -Goal "i < Nclients \
   2.658 -\     ==> System : {s. h <= (sub i o allocGiv) s &      \
   2.659 -\                      h pfixGe (sub i o allocAsk) s}   \
   2.660 -\                  LeadsTo  \
   2.661 -\                  {s. h <= (giv o sub i o client) s &  \
   2.662 -\                      h pfixGe (ask o sub i o client) s}";
   2.663 -by (rtac single_LeadsTo_I 1);
   2.664 -by (res_inst_tac [("k6", "h"), ("x2", "(sub i o allocAsk) s")]
   2.665 -    (lemma2 RS LeadsTo_weaken) 1);
   2.666 -by Auto_tac;
   2.667 -by (blast_tac (claset() addIs [trans_Ge RS trans_genPrefix RS transD,
   2.668 -			       prefix_imp_pfixGe]) 1);
   2.669 -val lemma3 = result();
   2.670 -
   2.671 -
   2.672 -(*progress (2), step 8: Client i's "release" action is visible system-wide*)
   2.673 -Goal "i < Nclients  \
   2.674 -\     ==> System : {s. h <= (sub i o allocGiv) s & \
   2.675 -\                      h pfixGe (sub i o allocAsk) s}  \
   2.676 -\                  LeadsTo {s. tokens h <= (tokens o sub i o allocRel) s}";
   2.677 -by (rtac LeadsTo_Trans 1);
   2.678 -by (dtac (System_Follows_rel RS impOfSubs (mono_tokens RS mono_Follows_o) RS 
   2.679 -	  Follows_LeadsTo) 2);
   2.680 -by (asm_full_simp_tac (simpset() addsimps [o_assoc]) 2);
   2.681 -by (rtac LeadsTo_Trans 1);
   2.682 -by (cut_facts_tac [System_Client_Progress] 2);
   2.683 -by (blast_tac (claset() addIs [LeadsTo_Basis]) 2);
   2.684 -by (etac lemma3 1);
   2.685 -qed "System_Alloc_Client_Progress";
   2.686 -
   2.687 -(*Lifting Alloc_Progress up to the level of systemState*)
   2.688 -val rename_Alloc_Progress = 
   2.689 -    Alloc_Progress RS rename_guarantees_sysOfAlloc_I
   2.690 -     |> simplify (simpset() addsimps [o_def]);
   2.691 -
   2.692 -(*progress (2), step 9*)
   2.693 -Goal
   2.694 - "System : (INT i : (lessThan Nclients). \
   2.695 -\           INT h. {s. h <= (sub i o allocAsk) s}  \
   2.696 -\                  LeadsTo {s. h pfixLe (sub i o allocGiv) s})";
   2.697 -(*Can't use simpset(): the "INT h" must be kept*)
   2.698 -by (simp_tac (HOL_ss addsimps [o_apply, sub_def]) 1);
   2.699 -by (rtac (rename_Alloc_Progress RS component_guaranteesD) 1);
   2.700 -by (auto_tac (claset(), 
   2.701 -	      simpset() addsimps [o_simp System_Increasing_allocRel,
   2.702 -				  o_simp System_Increasing_allocAsk,
   2.703 -				  o_simp System_Bounded_allocAsk,
   2.704 -				  o_simp System_Alloc_Client_Progress]));
   2.705 -qed "System_Alloc_Progress";
   2.706 -
   2.707 -
   2.708 -(*progress (2), step 10 (final result!) *)
   2.709 -Goalw [system_progress_def] "System : system_progress";
   2.710 -by (cut_facts_tac [System_Alloc_Progress] 1);
   2.711 -by (blast_tac (claset() addIs [LeadsTo_Trans, 
   2.712 -                System_Follows_allocGiv RS Follows_LeadsTo_pfixLe, 
   2.713 -                System_Follows_ask RS Follows_LeadsTo]) 1);
   2.714 -qed "System_Progress";
   2.715 -
   2.716 -
   2.717 -(*Ultimate goal*)
   2.718 -Goalw [system_spec_def] "System : system_spec";
   2.719 -by (blast_tac (claset() addIs [System_safety, System_Progress]) 1);
   2.720 -qed "System_correct";
   2.721 -
   2.722 -
   2.723 -(** Some lemmas no longer used **)
   2.724 -
   2.725 -Goal "non_dummy = (% (g,a,r). (| giv = g, ask = a, rel = r |)) o \
   2.726 -\                             (funPair giv (funPair ask rel))";
   2.727 -by (rtac ext 1); 
   2.728 -by (auto_tac (claset(), simpset() addsimps [o_def, non_dummy_def]));  
   2.729 -qed "non_dummy_eq_o_funPair";
   2.730 -
   2.731 -Goal "(preserves non_dummy) = \
   2.732 -\     (preserves rel Int preserves ask Int preserves giv)";
   2.733 -by (simp_tac (simpset() addsimps [non_dummy_eq_o_funPair]) 1); 
   2.734 -by Auto_tac;  
   2.735 -by (dres_inst_tac [("w1", "rel")] (impOfSubs subset_preserves_o) 1);
   2.736 -by (dres_inst_tac [("w1", "ask")] (impOfSubs subset_preserves_o) 2);
   2.737 -by (dres_inst_tac [("w1", "giv")] (impOfSubs subset_preserves_o) 3);
   2.738 -by (auto_tac (claset(), simpset() addsimps [o_def]));  
   2.739 -qed "preserves_non_dummy_eq";
   2.740 -
   2.741 -(*Could go to Extend.ML*)
   2.742 -Goal "bij f ==> fst (inv (%(x, u). inv f x) z) = f z";
   2.743 -by (rtac fst_inv_equalityI 1); 
   2.744 -by (res_inst_tac [("f","%z. (f z, ?h z)")] surjI 1); 
   2.745 -by (asm_full_simp_tac (simpset() addsimps [bij_is_inj, inv_f_f]) 1); 
   2.746 -by (asm_full_simp_tac (simpset() addsimps [bij_is_surj, surj_f_inv_f]) 1); 
   2.747 -qed "bij_fst_inv_inv_eq";
     3.1 --- a/src/HOL/UNITY/Alloc.thy	Mon Mar 05 12:31:31 2001 +0100
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,261 +0,0 @@
     3.4 -(*  Title:      HOL/UNITY/Alloc
     3.5 -    ID:         $Id$
     3.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     3.7 -    Copyright   1998  University of Cambridge
     3.8 -
     3.9 -Specification of Chandy and Charpentier's Allocator
    3.10 -*)
    3.11 -
    3.12 -Alloc = AllocBase + PPROD +
    3.13 -
    3.14 -(** State definitions.  OUTPUT variables are locals **)
    3.15 -
    3.16 -record clientState =
    3.17 -  giv :: nat list   (*client's INPUT history:  tokens GRANTED*)
    3.18 -  ask :: nat list   (*client's OUTPUT history: tokens REQUESTED*)
    3.19 -  rel :: nat list   (*client's OUTPUT history: tokens RELEASED*)
    3.20 -
    3.21 -record 'a clientState_d =
    3.22 -  clientState +
    3.23 -  dummy :: 'a       (*dummy field for new variables*)
    3.24 -
    3.25 -constdefs
    3.26 -  (*DUPLICATED FROM Client.thy, but with "tok" removed*)
    3.27 -  (*Maybe want a special theory section to declare such maps*)
    3.28 -  non_dummy :: 'a clientState_d => clientState
    3.29 -    "non_dummy s == (|giv = giv s, ask = ask s, rel = rel s|)"
    3.30 -
    3.31 -  (*Renaming map to put a Client into the standard form*)
    3.32 -  client_map :: "'a clientState_d => clientState*'a"
    3.33 -    "client_map == funPair non_dummy dummy"
    3.34 -
    3.35 -  
    3.36 -record allocState =
    3.37 -  allocGiv :: nat => nat list   (*OUTPUT history: source of "giv" for i*)
    3.38 -  allocAsk :: nat => nat list   (*INPUT: allocator's copy of "ask" for i*)
    3.39 -  allocRel :: nat => nat list   (*INPUT: allocator's copy of "rel" for i*)
    3.40 -
    3.41 -record 'a allocState_d =
    3.42 -  allocState +
    3.43 -  dummy    :: 'a                (*dummy field for new variables*)
    3.44 -
    3.45 -record 'a systemState =
    3.46 -  allocState +
    3.47 -  client :: nat => clientState  (*states of all clients*)
    3.48 -  dummy  :: 'a                  (*dummy field for new variables*)
    3.49 -
    3.50 -
    3.51 -constdefs
    3.52 -
    3.53 -(** Resource allocation system specification **)
    3.54 -
    3.55 -  (*spec (1)*)
    3.56 -  system_safety :: 'a systemState program set
    3.57 -    "system_safety ==
    3.58 -     Always {s. setsum(%i.(tokens o giv o sub i o client)s) (lessThan Nclients)
    3.59 -     <= NbT + setsum(%i.(tokens o rel o sub i o client)s) (lessThan Nclients)}"
    3.60 -
    3.61 -  (*spec (2)*)
    3.62 -  system_progress :: 'a systemState program set
    3.63 -    "system_progress == INT i : lessThan Nclients.
    3.64 -			INT h. 
    3.65 -			  {s. h <= (ask o sub i o client)s} LeadsTo
    3.66 -			  {s. h pfixLe (giv o sub i o client) s}"
    3.67 -
    3.68 -  system_spec :: 'a systemState program set
    3.69 -    "system_spec == system_safety Int system_progress"
    3.70 -
    3.71 -(** Client specification (required) ***)
    3.72 -
    3.73 -  (*spec (3)*)
    3.74 -  client_increasing :: 'a clientState_d program set
    3.75 -    "client_increasing ==
    3.76 -         UNIV guarantees  Increasing ask Int Increasing rel"
    3.77 -
    3.78 -  (*spec (4)*)
    3.79 -  client_bounded :: 'a clientState_d program set
    3.80 -    "client_bounded ==
    3.81 -         UNIV guarantees  Always {s. ALL elt : set (ask s). elt <= NbT}"
    3.82 -
    3.83 -  (*spec (5)*)
    3.84 -  client_progress :: 'a clientState_d program set
    3.85 -    "client_progress ==
    3.86 -	 Increasing giv  guarantees
    3.87 -	 (INT h. {s. h <= giv s & h pfixGe ask s}
    3.88 -		 LeadsTo {s. tokens h <= (tokens o rel) s})"
    3.89 -
    3.90 -  (*spec: preserves part*)
    3.91 -  client_preserves :: 'a clientState_d program set
    3.92 -    "client_preserves == preserves giv Int preserves clientState_d.dummy"
    3.93 -
    3.94 -  (*environmental constraints*)
    3.95 -  client_allowed_acts :: 'a clientState_d program set
    3.96 -    "client_allowed_acts ==
    3.97 -       {F. AllowedActs F =
    3.98 -	    insert Id (UNION (preserves (funPair rel ask)) Acts)}"
    3.99 -
   3.100 -  client_spec :: 'a clientState_d program set
   3.101 -    "client_spec == client_increasing Int client_bounded Int client_progress
   3.102 -                    Int client_allowed_acts Int client_preserves"
   3.103 -
   3.104 -(** Allocator specification (required) ***)
   3.105 -
   3.106 -  (*spec (6)*)
   3.107 -  alloc_increasing :: 'a allocState_d program set
   3.108 -    "alloc_increasing ==
   3.109 -	 UNIV  guarantees
   3.110 -	 (INT i : lessThan Nclients. Increasing (sub i o allocGiv))"
   3.111 -
   3.112 -  (*spec (7)*)
   3.113 -  alloc_safety :: 'a allocState_d program set
   3.114 -    "alloc_safety ==
   3.115 -	 (INT i : lessThan Nclients. Increasing (sub i o allocRel))
   3.116 -         guarantees
   3.117 -	 Always {s. setsum(%i.(tokens o sub i o allocGiv)s) (lessThan Nclients)
   3.118 -         <= NbT + setsum(%i.(tokens o sub i o allocRel)s) (lessThan Nclients)}"
   3.119 -
   3.120 -  (*spec (8)*)
   3.121 -  alloc_progress :: 'a allocState_d program set
   3.122 -    "alloc_progress ==
   3.123 -	 (INT i : lessThan Nclients. Increasing (sub i o allocAsk) Int
   3.124 -	                             Increasing (sub i o allocRel))
   3.125 -         Int
   3.126 -         Always {s. ALL i<Nclients.
   3.127 -		     ALL elt : set ((sub i o allocAsk) s). elt <= NbT}
   3.128 -         Int
   3.129 -         (INT i : lessThan Nclients. 
   3.130 -	  INT h. {s. h <= (sub i o allocGiv)s & h pfixGe (sub i o allocAsk)s}
   3.131 -		 LeadsTo
   3.132 -	         {s. tokens h <= (tokens o sub i o allocRel)s})
   3.133 -         guarantees
   3.134 -	     (INT i : lessThan Nclients.
   3.135 -	      INT h. {s. h <= (sub i o allocAsk) s}
   3.136 -	             LeadsTo
   3.137 -	             {s. h pfixLe (sub i o allocGiv) s})"
   3.138 -
   3.139 -  (*NOTE: to follow the original paper, the formula above should have had
   3.140 -	INT h. {s. h i <= (sub i o allocGiv)s & h i pfixGe (sub i o allocAsk)s}
   3.141 -	       LeadsTo
   3.142 -	       {s. tokens h i <= (tokens o sub i o allocRel)s})
   3.143 -    thus h should have been a function variable.  However, only h i is ever
   3.144 -    looked at.*)
   3.145 -
   3.146 -  (*spec: preserves part*)
   3.147 -  alloc_preserves :: 'a allocState_d program set
   3.148 -    "alloc_preserves == preserves allocRel Int preserves allocAsk Int
   3.149 -                        preserves allocState_d.dummy"
   3.150 -  
   3.151 -  (*environmental constraints*)
   3.152 -  alloc_allowed_acts :: 'a allocState_d program set
   3.153 -    "alloc_allowed_acts ==
   3.154 -       {F. AllowedActs F =
   3.155 -	    insert Id (UNION (preserves allocGiv) Acts)}"
   3.156 -
   3.157 -  alloc_spec :: 'a allocState_d program set
   3.158 -    "alloc_spec == alloc_increasing Int alloc_safety Int alloc_progress Int
   3.159 -                   alloc_allowed_acts Int alloc_preserves"
   3.160 -
   3.161 -(** Network specification ***)
   3.162 -
   3.163 -  (*spec (9.1)*)
   3.164 -  network_ask :: 'a systemState program set
   3.165 -    "network_ask == INT i : lessThan Nclients.
   3.166 -			Increasing (ask o sub i o client)  guarantees
   3.167 -			((sub i o allocAsk) Fols (ask o sub i o client))"
   3.168 -
   3.169 -  (*spec (9.2)*)
   3.170 -  network_giv :: 'a systemState program set
   3.171 -    "network_giv == INT i : lessThan Nclients.
   3.172 -			Increasing (sub i o allocGiv)
   3.173 -			guarantees
   3.174 -			((giv o sub i o client) Fols (sub i o allocGiv))"
   3.175 -
   3.176 -  (*spec (9.3)*)
   3.177 -  network_rel :: 'a systemState program set
   3.178 -    "network_rel == INT i : lessThan Nclients.
   3.179 -			Increasing (rel o sub i o client)
   3.180 -			guarantees
   3.181 -			((sub i o allocRel) Fols (rel o sub i o client))"
   3.182 -
   3.183 -  (*spec: preserves part*)
   3.184 -  network_preserves :: 'a systemState program set
   3.185 -    "network_preserves ==
   3.186 -       preserves allocGiv  Int
   3.187 -       (INT i : lessThan Nclients. preserves (rel o sub i o client)  Int
   3.188 -                                   preserves (ask o sub i o client))"
   3.189 -  
   3.190 -  (*environmental constraints*)
   3.191 -  network_allowed_acts :: 'a systemState program set
   3.192 -    "network_allowed_acts ==
   3.193 -       {F. AllowedActs F =
   3.194 -           insert Id
   3.195 -	    (UNION (preserves allocRel Int
   3.196 -		    (INT i: lessThan Nclients. preserves(giv o sub i o client)))
   3.197 -		  Acts)}"
   3.198 -
   3.199 -  network_spec :: 'a systemState program set
   3.200 -    "network_spec == network_ask Int network_giv Int
   3.201 -                     network_rel Int network_allowed_acts Int
   3.202 -                     network_preserves"
   3.203 -
   3.204 -
   3.205 -(** State mappings **)
   3.206 -  sysOfAlloc :: "((nat => clientState) * 'a) allocState_d => 'a systemState"
   3.207 -    "sysOfAlloc == %s. let (cl,xtr) = allocState_d.dummy s
   3.208 -                       in (| allocGiv = allocGiv s,
   3.209 -			     allocAsk = allocAsk s,
   3.210 -			     allocRel = allocRel s,
   3.211 -			     client   = cl,
   3.212 -			     dummy    = xtr|)"
   3.213 -
   3.214 -
   3.215 -  sysOfClient :: "(nat => clientState) * 'a allocState_d => 'a systemState"
   3.216 -    "sysOfClient == %(cl,al). (| allocGiv = allocGiv al,
   3.217 -			         allocAsk = allocAsk al,
   3.218 -			         allocRel = allocRel al,
   3.219 -			         client   = cl,
   3.220 -			         systemState.dummy = allocState_d.dummy al|)"
   3.221 -
   3.222 -consts 
   3.223 -    Alloc   :: 'a allocState_d program
   3.224 -    Client  :: 'a clientState_d program
   3.225 -    Network :: 'a systemState program
   3.226 -    System  :: 'a systemState program
   3.227 -  
   3.228 -rules
   3.229 -    Alloc   "Alloc   : alloc_spec"
   3.230 -    Client  "Client  : client_spec"
   3.231 -    Network "Network : network_spec"
   3.232 -
   3.233 -defs
   3.234 -    System_def
   3.235 -      "System == rename sysOfAlloc Alloc Join Network Join
   3.236 -                 (rename sysOfClient
   3.237 -		  (plam x: lessThan Nclients. rename client_map Client))"
   3.238 -
   3.239 -
   3.240 -(**
   3.241 -locale System =
   3.242 -  fixes 
   3.243 -    Alloc   :: 'a allocState_d program
   3.244 -    Client  :: 'a clientState_d program
   3.245 -    Network :: 'a systemState program
   3.246 -    System  :: 'a systemState program
   3.247 -
   3.248 -  assumes
   3.249 -    Alloc   "Alloc   : alloc_spec"
   3.250 -    Client  "Client  : client_spec"
   3.251 -    Network "Network : network_spec"
   3.252 -
   3.253 -  defines
   3.254 -    System_def
   3.255 -      "System == rename sysOfAlloc Alloc
   3.256 -                 Join
   3.257 -                 Network
   3.258 -                 Join
   3.259 -                 (rename sysOfClient
   3.260 -		  (plam x: lessThan Nclients. rename client_map Client))"
   3.261 -**)
   3.262 -
   3.263 -
   3.264 -end
     4.1 --- a/src/HOL/UNITY/AllocBase.ML	Mon Mar 05 12:31:31 2001 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,89 +0,0 @@
     4.4 -(*  Title:      HOL/UNITY/AllocBase.ML
     4.5 -    ID:         $Id$
     4.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4.7 -    Copyright   1998  University of Cambridge
     4.8 -
     4.9 -Basis declarations for Chandy and Charpentier's Allocator
    4.10 -*)
    4.11 -
    4.12 -Goal "!!f :: nat=>nat. \
    4.13 -\     (ALL i. i<n --> f i <= g i) --> \
    4.14 -\     setsum f (lessThan n) <= setsum g (lessThan n)";
    4.15 -by (induct_tac "n" 1);
    4.16 -by (auto_tac (claset(), simpset() addsimps [lessThan_Suc]));
    4.17 -by (dres_inst_tac [("x","n")] spec 1);
    4.18 -by (arith_tac 1);
    4.19 -qed_spec_mp "setsum_fun_mono";
    4.20 -
    4.21 -Goal "ALL xs. xs <= ys --> tokens xs <= tokens ys";
    4.22 -by (induct_tac "ys" 1);
    4.23 -by (auto_tac (claset(), simpset() addsimps [prefix_Cons]));
    4.24 -qed_spec_mp "tokens_mono_prefix";
    4.25 -
    4.26 -Goalw [mono_def] "mono tokens";
    4.27 -by (blast_tac (claset() addIs [tokens_mono_prefix]) 1);
    4.28 -qed "mono_tokens";
    4.29 -
    4.30 -
    4.31 -(** bag_of **)
    4.32 -
    4.33 -Goal "bag_of (l@l') = bag_of l + bag_of l'";
    4.34 -by (induct_tac "l" 1);
    4.35 - by (asm_simp_tac (simpset() addsimps (thms "plus_ac0")) 2);
    4.36 -by (Simp_tac 1);
    4.37 -qed "bag_of_append";
    4.38 -Addsimps [bag_of_append];
    4.39 -
    4.40 -Goal "mono (bag_of :: 'a list => ('a::order) multiset)";
    4.41 -by (rtac monoI 1); 
    4.42 -by (rewtac prefix_def);
    4.43 -by (etac genPrefix.induct 1);
    4.44 -by Auto_tac;
    4.45 -by (asm_full_simp_tac (simpset() addsimps [thm "union_le_mono"]) 1); 
    4.46 -by (etac order_trans 1); 
    4.47 -by (rtac (thm "union_upper1") 1); 
    4.48 -qed "mono_bag_of";
    4.49 -
    4.50 -(** setsum **)
    4.51 -
    4.52 -Addcongs [setsum_cong];
    4.53 -
    4.54 -Goal "setsum (%i. {#if i<k then f i else g i#}) (A Int lessThan k) = \
    4.55 -\     setsum (%i. {#f i#}) (A Int lessThan k)";
    4.56 -by (rtac setsum_cong 1);
    4.57 -by Auto_tac;  
    4.58 -qed "bag_of_sublist_lemma";
    4.59 -
    4.60 -Goal "bag_of (sublist l A) = \
    4.61 -\     setsum (%i. {# l!i #}) (A Int lessThan (length l))";
    4.62 -by (rev_induct_tac "l" 1);
    4.63 -by (Simp_tac 1);
    4.64 -by (asm_simp_tac
    4.65 -    (simpset() addsimps [sublist_append, Int_insert_right, lessThan_Suc, 
    4.66 -                    nth_append, bag_of_sublist_lemma] @ thms "plus_ac0") 1);
    4.67 -qed "bag_of_sublist";
    4.68 -
    4.69 -
    4.70 -Goal "bag_of (sublist l (A Un B)) + bag_of (sublist l (A Int B)) = \
    4.71 -\     bag_of (sublist l A) + bag_of (sublist l B)";
    4.72 -by (subgoal_tac "A Int B Int {..length l(} = \
    4.73 -\                (A Int {..length l(}) Int (B Int {..length l(})" 1);
    4.74 -by (asm_simp_tac (simpset() addsimps [bag_of_sublist, Int_Un_distrib2, 
    4.75 -                                      setsum_Un_Int]) 1);
    4.76 -by (Blast_tac 1);
    4.77 -qed "bag_of_sublist_Un_Int";
    4.78 -
    4.79 -Goal "A Int B = {} \
    4.80 -\     ==> bag_of (sublist l (A Un B)) = \
    4.81 -\         bag_of (sublist l A) + bag_of (sublist l B)"; 
    4.82 -by (asm_simp_tac (simpset() addsimps [bag_of_sublist_Un_Int RS sym]) 1);
    4.83 -qed "bag_of_sublist_Un_disjoint";
    4.84 -
    4.85 -Goal "[| finite I; ALL i:I. ALL j:I. i~=j --> A i Int A j = {} |] \
    4.86 -\     ==> bag_of (sublist l (UNION I A)) =  \
    4.87 -\         setsum (%i. bag_of (sublist l (A i))) I";  
    4.88 -by (asm_simp_tac (simpset() delsimps UN_simps addsimps (UN_simps RL [sym])
    4.89 -			    addsimps [bag_of_sublist]) 1);
    4.90 -by (stac setsum_UN_disjoint 1);
    4.91 -by Auto_tac;  
    4.92 -qed_spec_mp "bag_of_sublist_UN_disjoint";
     5.1 --- a/src/HOL/UNITY/AllocBase.thy	Mon Mar 05 12:31:31 2001 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,31 +0,0 @@
     5.4 -(*  Title:      HOL/UNITY/AllocBase.thy
     5.5 -    ID:         $Id$
     5.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     5.7 -    Copyright   1998  University of Cambridge
     5.8 -
     5.9 -Common declarations for Chandy and Charpentier's Allocator
    5.10 -*)
    5.11 -
    5.12 -AllocBase = Rename + Follows + 
    5.13 -
    5.14 -consts
    5.15 -  NbT      :: nat       (*Number of tokens in system*)
    5.16 -  Nclients :: nat       (*Number of clients*)
    5.17 -
    5.18 -rules
    5.19 -  NbT_pos  "0 < NbT"
    5.20 -
    5.21 -(*This function merely sums the elements of a list*)
    5.22 -consts tokens     :: nat list => nat
    5.23 -primrec 
    5.24 -  "tokens [] = 0"
    5.25 -  "tokens (x#xs) = x + tokens xs"
    5.26 -
    5.27 -consts
    5.28 -  bag_of :: 'a list => 'a multiset
    5.29 -
    5.30 -primrec
    5.31 -  "bag_of []     = {#}"
    5.32 -  "bag_of (x#xs) = {#x#} + bag_of xs"
    5.33 -
    5.34 -end
     6.1 --- a/src/HOL/UNITY/AllocImpl.ML	Mon Mar 05 12:31:31 2001 +0100
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,194 +0,0 @@
     6.4 -(*  Title:      HOL/UNITY/AllocImpl
     6.5 -    ID:         $Id$
     6.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     6.7 -    Copyright   2000  University of Cambridge
     6.8 -
     6.9 -Implementation of a multiple-client allocator from a single-client allocator
    6.10 -*)
    6.11 -
    6.12 -AddIs [impOfSubs subset_preserves_o];
    6.13 -Addsimps [funPair_o_distrib];
    6.14 -Addsimps [Always_INT_distrib];
    6.15 -Delsimps [o_apply];
    6.16 -
    6.17 -Open_locale "Merge";
    6.18 -
    6.19 -val Merge = thm "Merge_spec";
    6.20 -
    6.21 -Goal "Allowed M = (preserves merge.Out) Int (preserves merge.iOut)";
    6.22 -by (cut_facts_tac [Merge] 1);
    6.23 -by (auto_tac (claset(), 
    6.24 -              simpset() addsimps [merge_spec_def, merge_allowed_acts_def, 
    6.25 -                                  Allowed_def, safety_prop_Acts_iff]));  
    6.26 -qed "Merge_Allowed";
    6.27 -
    6.28 -Goal "M ok G = (G: preserves merge.Out & G: preserves merge.iOut & \
    6.29 -\                    M : Allowed G)";
    6.30 -by (auto_tac (claset(), simpset() addsimps [Merge_Allowed, ok_iff_Allowed]));  
    6.31 -qed "M_ok_iff";
    6.32 -AddIffs [M_ok_iff];
    6.33 -
    6.34 -Goal "[| G: preserves merge.Out; G: preserves merge.iOut; M : Allowed G |] \
    6.35 -\     ==> M Join G : Always {s. length (merge.Out s) = length (merge.iOut s)}";
    6.36 -by (cut_facts_tac [Merge] 1);
    6.37 -by (force_tac (claset() addDs [guaranteesD], 
    6.38 -               simpset() addsimps [merge_spec_def, merge_eqOut_def]) 1); 
    6.39 -qed "Merge_Always_Out_eq_iOut";
    6.40 -
    6.41 -Goal "[| G: preserves merge.iOut; G: preserves merge.Out; M : Allowed G |] \
    6.42 -\     ==> M Join G: Always {s. ALL elt : set (merge.iOut s). elt < Nclients}";
    6.43 -by (cut_facts_tac [Merge] 1);
    6.44 -by (force_tac (claset() addDs [guaranteesD], 
    6.45 -               simpset() addsimps [merge_spec_def, merge_bounded_def]) 1); 
    6.46 -qed "Merge_Bounded";
    6.47 -
    6.48 -Goal "[| G: preserves merge.iOut; G: preserves merge.Out; M : Allowed G |] \
    6.49 -\ ==> M Join G : Always \
    6.50 -\         {s. setsum (%i. bag_of (sublist (merge.Out s) \
    6.51 -\                                 {k. k < length (iOut s) & iOut s ! k = i})) \
    6.52 -\                    (lessThan Nclients)   =  \
    6.53 -\             (bag_of o merge.Out) s}";
    6.54 -by (rtac ([[Merge_Always_Out_eq_iOut, Merge_Bounded] MRS Always_Int_I,
    6.55 -	   UNIV_AlwaysI] MRS (Always_Compl_Un_eq RS iffD1)) 1);
    6.56 -     by Auto_tac; 
    6.57 -by (stac (bag_of_sublist_UN_disjoint RS sym) 1); 
    6.58 -  by (Simp_tac 1);
    6.59 - by (Blast_tac 1); 
    6.60 -by (asm_full_simp_tac (simpset() addsimps [set_conv_nth]) 1); 
    6.61 -by (subgoal_tac
    6.62 -    "(UN i:lessThan Nclients. {k. k < length (iOut x) & iOut x ! k = i}) = \
    6.63 -\    lessThan (length (iOut x))" 1);
    6.64 - by (Blast_tac 2); 
    6.65 -by (asm_simp_tac (simpset() addsimps [o_def]) 1); 
    6.66 -qed "Merge_Bag_Follows_lemma";
    6.67 -
    6.68 -Goal "M : (INT i: lessThan Nclients. Increasing (sub i o merge.In)) \
    6.69 -\         guarantees  \
    6.70 -\            (bag_of o merge.Out) Fols \
    6.71 -\            (%s. setsum (%i. (bag_of o sub i o merge.In) s) \
    6.72 -\                        (lessThan Nclients))";
    6.73 -by (rtac (Merge_Bag_Follows_lemma RS Always_Follows1 RS guaranteesI) 1);
    6.74 -by Auto_tac;  
    6.75 -by (rtac Follows_setsum 1);
    6.76 -by (cut_facts_tac [Merge] 1);
    6.77 -by (auto_tac (claset(), 
    6.78 -              simpset() addsimps [merge_spec_def, merge_follows_def, o_def]));
    6.79 -by (dtac guaranteesD 1); 
    6.80 -by (best_tac
    6.81 -    (claset() addIs [impOfSubs (mono_bag_of RS mono_Follows_apply)]) 3);
    6.82 -by Auto_tac;  
    6.83 -qed "Merge_Bag_Follows";
    6.84 -
    6.85 -Close_locale "Merge";
    6.86 -
    6.87 -
    6.88 -(** Distributor **)
    6.89 -
    6.90 -Open_locale "Distrib";
    6.91 -
    6.92 -val Distrib = thm "Distrib_spec";
    6.93 -  
    6.94 -
    6.95 -Goal "D : Increasing distr.In Int Increasing distr.iIn Int \
    6.96 -\         Always {s. ALL elt : set (distr.iIn s). elt < Nclients} \
    6.97 -\         guarantees \
    6.98 -\         (INT i : lessThan Nclients. Increasing (sub i o distr.Out))";
    6.99 -by (cut_facts_tac [Distrib] 1);
   6.100 -by (full_simp_tac (simpset() addsimps [distr_spec_def, distr_follows_def]) 1); 
   6.101 -by (Clarify_tac 1); 
   6.102 -by (blast_tac (claset() addIs [guaranteesI, Follows_Increasing1]
   6.103 -                        addDs [guaranteesD]) 1);
   6.104 -qed "Distr_Increasing_Out";
   6.105 -
   6.106 -Goal "[| G : preserves distr.Out; \
   6.107 -\        D Join G : Always {s. ALL elt: set (distr.iIn s). elt < Nclients} |] \
   6.108 -\ ==> D Join G : Always \
   6.109 -\         {s. setsum (%i. bag_of (sublist (distr.In s) \
   6.110 -\                                 {k. k < length (iIn s) & iIn s ! k = i})) \
   6.111 -\                    (lessThan Nclients)   = \
   6.112 -\             bag_of (sublist (distr.In s) (lessThan (length (iIn s))))}";
   6.113 -by (etac ([asm_rl, UNIV_AlwaysI] MRS (Always_Compl_Un_eq RS iffD1)) 1);
   6.114 -by Auto_tac; 
   6.115 -by (stac (bag_of_sublist_UN_disjoint RS sym) 1); 
   6.116 -  by (Simp_tac 1);
   6.117 - by (Blast_tac 1); 
   6.118 -by (asm_full_simp_tac (simpset() addsimps [set_conv_nth]) 1); 
   6.119 -by (subgoal_tac
   6.120 -    "(UN i:lessThan Nclients. {k. k < length (iIn x) & iIn x ! k = i}) = \
   6.121 -\    lessThan (length (iIn x))" 1);
   6.122 - by (Blast_tac 2); 
   6.123 -by (Asm_simp_tac 1); 
   6.124 -qed "Distr_Bag_Follows_lemma";
   6.125 -
   6.126 -Goal "D ok G = (G: preserves distr.Out & D : Allowed G)";
   6.127 -by (cut_facts_tac [Distrib] 1);
   6.128 -by (auto_tac (claset(), 
   6.129 -     simpset() addsimps [distr_spec_def, distr_allowed_acts_def, 
   6.130 -                         Allowed_def, safety_prop_Acts_iff, ok_iff_Allowed]));
   6.131 -qed "D_ok_iff";
   6.132 -AddIffs [D_ok_iff];
   6.133 -
   6.134 -Goal
   6.135 - "D : Increasing distr.In Int Increasing distr.iIn Int \
   6.136 -\     Always {s. ALL elt : set (distr.iIn s). elt < Nclients} \
   6.137 -\     guarantees  \
   6.138 -\      (INT i : lessThan Nclients. \
   6.139 -\       (%s. setsum (%i. (bag_of o sub i o distr.Out) s) (lessThan Nclients)) \
   6.140 -\       Fols \
   6.141 -\       (%s. bag_of (sublist (distr.In s) (lessThan (length(distr.iIn s))))))";
   6.142 -by (rtac guaranteesI 1);
   6.143 -by (Clarify_tac 1); 
   6.144 -by (rtac (Distr_Bag_Follows_lemma RS Always_Follows2) 1);
   6.145 -by Auto_tac;  
   6.146 -by (rtac Follows_setsum 1);
   6.147 -by (cut_facts_tac [Distrib] 1);
   6.148 -by (auto_tac (claset(), 
   6.149 -              simpset() addsimps [distr_spec_def, distr_follows_def, o_def]));
   6.150 -by (dtac guaranteesD 1); 
   6.151 -by (best_tac (claset() addIs [impOfSubs (mono_bag_of RS mono_Follows_apply)]) 3);
   6.152 -by Auto_tac;  
   6.153 -qed "Distr_Bag_Follows";
   6.154 -
   6.155 -Close_locale "Distrib";
   6.156 -
   6.157 -
   6.158 -Goal "!!f::nat=>nat. (INT i:(lessThan n). {s. f i <= g i s})  \
   6.159 -\     <= {s. setsum f (lessThan n) <= setsum (%i. g i s) (lessThan n)}";
   6.160 -by (induct_tac "n" 1);
   6.161 -by (auto_tac (claset(), simpset() addsimps [lessThan_Suc]));
   6.162 -qed "alloc_refinement_lemma";
   6.163 -
   6.164 -Goal
   6.165 -"(INT i : lessThan Nclients. Increasing (sub i o allocAsk) Int  \
   6.166 -\                            Increasing (sub i o allocRel))     \
   6.167 -\ Int   \
   6.168 -\ Always {s. ALL i. i<Nclients -->      \
   6.169 -\             (ALL elt : set ((sub i o allocAsk) s). elt <= NbT)}       \
   6.170 -\ Int   \
   6.171 -\ (INT i : lessThan Nclients.   \
   6.172 -\  INT h. {s. h <= (sub i o allocGiv)s & h pfixGe (sub i o allocAsk)s}  \
   6.173 -\          LeadsTo {s. tokens h <= (tokens o sub i o allocRel)s})        \
   6.174 -\ <=     \
   6.175 -\(INT i : lessThan Nclients. Increasing (sub i o allocAsk) Int  \
   6.176 -\                            Increasing (sub i o allocRel))     \
   6.177 -\ Int   \
   6.178 -\ Always {s. ALL i. i<Nclients -->      \
   6.179 -\             (ALL elt : set ((sub i o allocAsk) s). elt <= NbT)}       \
   6.180 -\ Int   \
   6.181 -\ (INT hf. (INT i : lessThan Nclients.  \
   6.182 -\        {s. hf i <= (sub i o allocGiv)s & hf i pfixGe (sub i o allocAsk)s}) \
   6.183 -\ LeadsTo {s. setsum (%i. tokens (hf i)) (lessThan Nclients) <=         \
   6.184 -\   setsum (%i. (tokens o sub i o allocRel)s) (lessThan Nclients) })";
   6.185 -by (auto_tac (claset(), simpset() addsimps [ball_conj_distrib]));  
   6.186 -by (rename_tac "F hf" 1);
   6.187 -by (rtac ([Finite_stable_completion, alloc_refinement_lemma]
   6.188 -          MRS LeadsTo_weaken_R) 1);
   6.189 -  by (Blast_tac 1); 
   6.190 - by (Blast_tac 1); 
   6.191 -by (subgoal_tac "F : Increasing (tokens o (sub i o allocRel))" 1);
   6.192 - by (blast_tac
   6.193 -     (claset() addIs [impOfSubs (mono_tokens RS mono_Increasing_o)]) 2);
   6.194 -by (asm_full_simp_tac (simpset() addsimps [Increasing_def, o_assoc]) 1);
   6.195 -qed "alloc_refinement";
   6.196 -
   6.197 -
     7.1 --- a/src/HOL/UNITY/AllocImpl.thy	Mon Mar 05 12:31:31 2001 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,224 +0,0 @@
     7.4 -(*  Title:      HOL/UNITY/AllocImpl
     7.5 -    ID:         $Id$
     7.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     7.7 -    Copyright   1998  University of Cambridge
     7.8 -
     7.9 -Implementation of a multiple-client allocator from a single-client allocator
    7.10 -*)
    7.11 -
    7.12 -AllocImpl = AllocBase + Follows + PPROD + 
    7.13 -
    7.14 -
    7.15 -(** State definitions.  OUTPUT variables are locals **)
    7.16 -
    7.17 -(*Type variable 'b is the type of items being merged*)
    7.18 -record 'b merge =
    7.19 -  In   :: nat => 'b list   (*merge's INPUT histories: streams to merge*)
    7.20 -  Out  :: 'b list          (*merge's OUTPUT history: merged items*)
    7.21 -  iOut :: nat list         (*merge's OUTPUT history: origins of merged items*)
    7.22 -
    7.23 -record ('a,'b) merge_d =
    7.24 -  'b merge +
    7.25 -  dummy :: 'a       (*dummy field for new variables*)
    7.26 -
    7.27 -constdefs
    7.28 -  non_dummy :: ('a,'b) merge_d => 'b merge
    7.29 -    "non_dummy s == (|In = In s, Out = Out s, iOut = iOut s|)"
    7.30 -
    7.31 -record 'b distr =
    7.32 -  In  :: 'b list          (*items to distribute*)
    7.33 -  iIn :: nat list         (*destinations of items to distribute*)
    7.34 -  Out :: nat => 'b list   (*distributed items*)
    7.35 -
    7.36 -record ('a,'b) distr_d =
    7.37 -  'b distr +
    7.38 -  dummy :: 'a       (*dummy field for new variables*)
    7.39 -
    7.40 -record allocState =
    7.41 -  giv :: nat list   (*OUTPUT history: source of tokens*)
    7.42 -  ask :: nat list   (*INPUT: tokens requested from allocator*)
    7.43 -  rel :: nat list   (*INPUT: tokens released to allocator*)
    7.44 -
    7.45 -record 'a allocState_d =
    7.46 -  allocState +
    7.47 -  dummy    :: 'a                (*dummy field for new variables*)
    7.48 -
    7.49 -record 'a systemState =
    7.50 -  allocState +
    7.51 -  mergeRel :: nat merge
    7.52 -  mergeAsk :: nat merge
    7.53 -  distr    :: nat distr
    7.54 -  dummy    :: 'a                  (*dummy field for new variables*)
    7.55 -
    7.56 -
    7.57 -constdefs
    7.58 -
    7.59 -(** Merge specification (the number of inputs is Nclients) ***)
    7.60 -
    7.61 -  (*spec (10)*)
    7.62 -  merge_increasing :: ('a,'b) merge_d program set
    7.63 -    "merge_increasing ==
    7.64 -         UNIV guarantees (Increasing merge.Out) Int (Increasing merge.iOut)"
    7.65 -
    7.66 -  (*spec (11)*)
    7.67 -  merge_eqOut :: ('a,'b) merge_d program set
    7.68 -    "merge_eqOut ==
    7.69 -         UNIV guarantees
    7.70 -         Always {s. length (merge.Out s) = length (merge.iOut s)}"
    7.71 -
    7.72 -  (*spec (12)*)
    7.73 -  merge_bounded :: ('a,'b) merge_d program set
    7.74 -    "merge_bounded ==
    7.75 -         UNIV guarantees
    7.76 -         Always {s. ALL elt : set (merge.iOut s). elt < Nclients}"
    7.77 -
    7.78 -  (*spec (13)*)
    7.79 -  merge_follows :: ('a,'b) merge_d program set
    7.80 -    "merge_follows ==
    7.81 -	 (INT i : lessThan Nclients. Increasing (sub i o merge.In))
    7.82 -	 guarantees
    7.83 -	 (INT i : lessThan Nclients. 
    7.84 -	  (%s. sublist (merge.Out s) 
    7.85 -                       {k. k < size(merge.iOut s) & merge.iOut s! k = i})
    7.86 -	  Fols (sub i o merge.In))"
    7.87 -
    7.88 -  (*spec: preserves part*)
    7.89 -  merge_preserves :: ('a,'b) merge_d program set
    7.90 -    "merge_preserves == preserves merge.In Int preserves merge_d.dummy"
    7.91 -
    7.92 -  (*environmental constraints*)
    7.93 -  merge_allowed_acts :: ('a,'b) merge_d program set
    7.94 -    "merge_allowed_acts ==
    7.95 -       {F. AllowedActs F =
    7.96 -	    insert Id (UNION (preserves (funPair merge.Out merge.iOut)) Acts)}"
    7.97 -
    7.98 -  merge_spec :: ('a,'b) merge_d program set
    7.99 -    "merge_spec == merge_increasing Int merge_eqOut Int merge_bounded Int
   7.100 -                   merge_follows Int merge_allowed_acts Int merge_preserves"
   7.101 -
   7.102 -(** Distributor specification (the number of outputs is Nclients) ***)
   7.103 -
   7.104 -  (*spec (14)*)
   7.105 -  distr_follows :: ('a,'b) distr_d program set
   7.106 -    "distr_follows ==
   7.107 -	 Increasing distr.In Int Increasing distr.iIn Int
   7.108 -	 Always {s. ALL elt : set (distr.iIn s). elt < Nclients}
   7.109 -	 guarantees
   7.110 -	 (INT i : lessThan Nclients. 
   7.111 -	  (sub i o distr.Out) Fols
   7.112 -	  (%s. sublist (distr.In s) 
   7.113 -                       {k. k < size(distr.iIn s) & distr.iIn s ! k = i}))"
   7.114 -
   7.115 -  distr_allowed_acts :: ('a,'b) distr_d program set
   7.116 -    "distr_allowed_acts ==
   7.117 -       {D. AllowedActs D = insert Id (UNION (preserves distr.Out) Acts)}"
   7.118 -
   7.119 -  distr_spec :: ('a,'b) distr_d program set
   7.120 -    "distr_spec == distr_follows Int distr_allowed_acts"
   7.121 -
   7.122 -(** Single-client allocator specification (required) ***)
   7.123 -
   7.124 -  (*spec (18)*)
   7.125 -  alloc_increasing :: 'a allocState_d program set
   7.126 -    "alloc_increasing == UNIV  guarantees  Increasing giv"
   7.127 -
   7.128 -  (*spec (19)*)
   7.129 -  alloc_safety :: 'a allocState_d program set
   7.130 -    "alloc_safety ==
   7.131 -	 Increasing rel
   7.132 -         guarantees  Always {s. tokens (giv s) <= NbT + tokens (rel s)}"
   7.133 -
   7.134 -  (*spec (20)*)
   7.135 -  alloc_progress :: 'a allocState_d program set
   7.136 -    "alloc_progress ==
   7.137 -	 Increasing ask Int Increasing rel Int
   7.138 -         Always {s. ALL elt : set (ask s). elt <= NbT}
   7.139 -         Int
   7.140 -         (INT h. {s. h <= giv s & h pfixGe (ask s)}
   7.141 -		 LeadsTo
   7.142 -	         {s. tokens h <= tokens (rel s)})
   7.143 -         guarantees  (INT h. {s. h <= ask s} LeadsTo {s. h pfixLe giv s})"
   7.144 -
   7.145 -  (*spec: preserves part*)
   7.146 -  alloc_preserves :: 'a allocState_d program set
   7.147 -    "alloc_preserves == preserves rel Int
   7.148 -                        preserves ask Int
   7.149 -                        preserves allocState_d.dummy"
   7.150 -  
   7.151 -
   7.152 -  (*environmental constraints*)
   7.153 -  alloc_allowed_acts :: 'a allocState_d program set
   7.154 -    "alloc_allowed_acts ==
   7.155 -       {F. AllowedActs F = insert Id (UNION (preserves giv) Acts)}"
   7.156 -
   7.157 -  alloc_spec :: 'a allocState_d program set
   7.158 -    "alloc_spec == alloc_increasing Int alloc_safety Int alloc_progress Int
   7.159 -                   alloc_allowed_acts Int alloc_preserves"
   7.160 -
   7.161 -locale Merge =
   7.162 -  fixes 
   7.163 -    M   :: ('a,'b::order) merge_d program
   7.164 -  assumes
   7.165 -    Merge_spec  "M  : merge_spec"
   7.166 -
   7.167 -locale Distrib =
   7.168 -  fixes 
   7.169 -    D   :: ('a,'b::order) distr_d program
   7.170 -  assumes
   7.171 -    Distrib_spec  "D : distr_spec"
   7.172 -
   7.173 -
   7.174 -(****
   7.175 -#  (** Network specification ***)
   7.176 -
   7.177 -#    (*spec (9.1)*)
   7.178 -#    network_ask :: 'a systemState program set
   7.179 -#	"network_ask == INT i : lessThan Nclients.
   7.180 -#			    Increasing (ask o sub i o client)
   7.181 -#			    guarantees[ask]
   7.182 -#			    (ask  Fols (ask o sub i o client))"
   7.183 -
   7.184 -#    (*spec (9.2)*)
   7.185 -#    network_giv :: 'a systemState program set
   7.186 -#	"network_giv == INT i : lessThan Nclients.
   7.187 -#			    Increasing giv 
   7.188 -#			    guarantees[giv o sub i o client]
   7.189 -#			    ((giv o sub i o client) Fols giv )"
   7.190 -
   7.191 -#    (*spec (9.3)*)
   7.192 -#    network_rel :: 'a systemState program set
   7.193 -#	"network_rel == INT i : lessThan Nclients.
   7.194 -#			    Increasing (rel o sub i o client)
   7.195 -#			    guarantees[rel]
   7.196 -#			    (rel  Fols (rel o sub i o client))"
   7.197 -
   7.198 -#    (*spec: preserves part*)
   7.199 -#	network_preserves :: 'a systemState program set
   7.200 -#	"network_preserves == preserves giv  Int
   7.201 -#			      (INT i : lessThan Nclients.
   7.202 -#			       preserves (funPair rel ask o sub i o client))"
   7.203 -
   7.204 -#    network_spec :: 'a systemState program set
   7.205 -#	"network_spec == network_ask Int network_giv Int
   7.206 -#			 network_rel Int network_preserves"
   7.207 -
   7.208 -
   7.209 -#  (** State mappings **)
   7.210 -#    sysOfAlloc :: "((nat => merge) * 'a) allocState_d => 'a systemState"
   7.211 -#	"sysOfAlloc == %s. let (cl,xtr) = allocState_d.dummy s
   7.212 -#			   in (| giv = giv s,
   7.213 -#				 ask = ask s,
   7.214 -#				 rel = rel s,
   7.215 -#				 client   = cl,
   7.216 -#				 dummy    = xtr|)"
   7.217 -
   7.218 -
   7.219 -#    sysOfClient :: "(nat => merge) * 'a allocState_d => 'a systemState"
   7.220 -#	"sysOfClient == %(cl,al). (| giv = giv al,
   7.221 -#				     ask = ask al,
   7.222 -#				     rel = rel al,
   7.223 -#				     client   = cl,
   7.224 -#				     systemState.dummy = allocState_d.dummy al|)"
   7.225 -****)
   7.226 -
   7.227 -end
     8.1 --- a/src/HOL/UNITY/Channel.ML	Mon Mar 05 12:31:31 2001 +0100
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,57 +0,0 @@
     8.4 -(*  Title:      HOL/UNITY/Channel
     8.5 -    ID:         $Id$
     8.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     8.7 -    Copyright   1998  University of Cambridge
     8.8 -
     8.9 -Unordered Channel
    8.10 -
    8.11 -From Misra, "A Logic for Concurrent Programming" (1994), section 13.3
    8.12 -*)
    8.13 -
    8.14 -(*None represents "infinity" while Some represents proper integers*)
    8.15 -Goalw [minSet_def] "minSet A = Some x --> x : A";
    8.16 -by (Simp_tac 1);
    8.17 -by (fast_tac (claset() addIs [LeastI]) 1);
    8.18 -qed_spec_mp "minSet_eq_SomeD";
    8.19 -
    8.20 -Goalw [minSet_def] " minSet{} = None";
    8.21 -by (Asm_simp_tac 1);
    8.22 -qed_spec_mp "minSet_empty";
    8.23 -Addsimps [minSet_empty];
    8.24 -
    8.25 -Goalw [minSet_def] "x:A ==> minSet A = Some (LEAST x. x: A)";
    8.26 -by Auto_tac;
    8.27 -qed_spec_mp "minSet_nonempty";
    8.28 -
    8.29 -Goal "F : (minSet -` {Some x}) leadsTo (minSet -` (Some`greaterThan x))";
    8.30 -by (rtac leadsTo_weaken 1);
    8.31 -by (res_inst_tac [("x1","x")] ([UC2, UC1] MRS psp) 1);
    8.32 -by Safe_tac;
    8.33 -by (auto_tac (claset() addDs [minSet_eq_SomeD], 
    8.34 -	      simpset() addsimps [linorder_neq_iff]));
    8.35 -qed "minSet_greaterThan";
    8.36 -
    8.37 -(*The induction*)
    8.38 -Goal "F : (UNIV-{{}}) leadsTo (minSet -` (Some`atLeast y))";
    8.39 -by (rtac leadsTo_weaken_R 1);
    8.40 -by (res_inst_tac  [("l", "y"), ("f", "the o minSet"), ("B", "{}")]
    8.41 -     greaterThan_bounded_induct 1);
    8.42 -by Safe_tac;
    8.43 -by (ALLGOALS Asm_simp_tac);
    8.44 -by (dtac minSet_nonempty 2);
    8.45 -by (Asm_full_simp_tac 2);
    8.46 -by (rtac (minSet_greaterThan RS leadsTo_weaken) 1);
    8.47 -by Safe_tac;
    8.48 -by (ALLGOALS Asm_full_simp_tac);
    8.49 -by (dtac minSet_nonempty 1);
    8.50 -by (Asm_full_simp_tac 1);
    8.51 -val lemma = result();
    8.52 -
    8.53 -
    8.54 -Goal "!!y::nat. F : (UNIV-{{}}) leadsTo {s. y ~: s}";
    8.55 -by (rtac (lemma RS leadsTo_weaken_R) 1);
    8.56 -by (Clarify_tac 1);
    8.57 -by (ftac minSet_nonempty 1);
    8.58 -by (auto_tac (claset() addDs [Suc_le_lessD, not_less_Least], 
    8.59 -	      simpset()));
    8.60 -qed "Channel_progress";
     9.1 --- a/src/HOL/UNITY/Channel.thy	Mon Mar 05 12:31:31 2001 +0100
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,30 +0,0 @@
     9.4 -(*  Title:      HOL/UNITY/Channel
     9.5 -    ID:         $Id$
     9.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     9.7 -    Copyright   1998  University of Cambridge
     9.8 -
     9.9 -Unordered Channel
    9.10 -
    9.11 -From Misra, "A Logic for Concurrent Programming" (1994), section 13.3
    9.12 -*)
    9.13 -
    9.14 -Channel = WFair + Option + 
    9.15 -
    9.16 -types state = nat set
    9.17 -
    9.18 -consts
    9.19 -  F :: state program
    9.20 -
    9.21 -constdefs
    9.22 -  minSet :: nat set => nat option
    9.23 -    "minSet A == if A={} then None else Some (LEAST x. x:A)"
    9.24 -
    9.25 -rules
    9.26 -
    9.27 -  UC1  "F : (minSet -` {Some x}) co (minSet -` (Some`atLeast x))"
    9.28 -
    9.29 -  (*  UC1  "F : {s. minSet s = x} co {s. x <= minSet s}"  *)
    9.30 -
    9.31 -  UC2  "F : (minSet -` {Some x}) leadsTo {s. x ~: s}"
    9.32 -
    9.33 -end
    10.1 --- a/src/HOL/UNITY/Client.ML	Mon Mar 05 12:31:31 2001 +0100
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,174 +0,0 @@
    10.4 -(*  Title:      HOL/UNITY/Client
    10.5 -    ID:         $Id$
    10.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    10.7 -    Copyright   1998  University of Cambridge
    10.8 -
    10.9 -Distributed Resource Management System: the Client
   10.10 -*)
   10.11 -
   10.12 -Addsimps [Client_def RS def_prg_Init, 
   10.13 -          Client_def RS def_prg_AllowedActs];
   10.14 -program_defs_ref := [Client_def];
   10.15 -
   10.16 -Addsimps (map simp_of_act [rel_act_def, tok_act_def, ask_act_def]);
   10.17 -
   10.18 -Goal "(Client ok G) = \
   10.19 -\     (G : preserves rel & G : preserves ask & G : preserves tok &\
   10.20 -\      Client : Allowed G)";
   10.21 -by (auto_tac (claset(), 
   10.22 -      simpset() addsimps [ok_iff_Allowed, Client_def RS def_prg_Allowed]));  
   10.23 -qed "Client_ok_iff";
   10.24 -AddIffs [Client_ok_iff];
   10.25 -
   10.26 -
   10.27 -(*Safety property 1: ask, rel are increasing*)
   10.28 -Goal "Client: UNIV guarantees Increasing ask Int Increasing rel";
   10.29 -by (auto_tac
   10.30 -    (claset() addSIs [increasing_imp_Increasing],
   10.31 -     simpset() addsimps [guar_def, impOfSubs preserves_subset_increasing]));
   10.32 -by (auto_tac (claset(), simpset() addsimps [increasing_def]));
   10.33 -by (ALLGOALS constrains_tac);
   10.34 -by Auto_tac;
   10.35 -qed "increasing_ask_rel";
   10.36 -
   10.37 -Addsimps [nth_append, append_one_prefix];
   10.38 -
   10.39 -
   10.40 -(*Safety property 2: the client never requests too many tokens.
   10.41 -      With no Substitution Axiom, we must prove the two invariants 
   10.42 -  simultaneously.
   10.43 -*)
   10.44 -Goal "Client ok G  \
   10.45 -\     ==> Client Join G :  \
   10.46 -\             Always ({s. tok s <= NbT}  Int  \
   10.47 -\                     {s. ALL elt : set (ask s). elt <= NbT})";
   10.48 -by Auto_tac;  
   10.49 -by (rtac (invariantI RS stable_Join_Always2) 1);
   10.50 -by (fast_tac (claset() addSEs [impOfSubs preserves_subset_stable]
   10.51 -		       addSIs [stable_Int]) 3);
   10.52 -by (constrains_tac 2);
   10.53 -by (cut_inst_tac [("m", "tok s")] (NbT_pos RS mod_less_divisor) 2);
   10.54 -by Auto_tac;
   10.55 -qed "ask_bounded_lemma";
   10.56 -
   10.57 -(*export version, with no mention of tok in the postcondition, but
   10.58 -  unfortunately tok must be declared local.*)
   10.59 -Goal "Client: UNIV guarantees Always {s. ALL elt : set (ask s). elt <= NbT}";
   10.60 -by (rtac guaranteesI 1);
   10.61 -by (etac (ask_bounded_lemma RS Always_weaken) 1);
   10.62 -by (rtac Int_lower2 1);
   10.63 -qed "ask_bounded";
   10.64 -
   10.65 -
   10.66 -(*** Towards proving the liveness property ***)
   10.67 -
   10.68 -Goal "Client: stable {s. rel s <= giv s}";
   10.69 -by (constrains_tac 1);
   10.70 -by Auto_tac;
   10.71 -qed "stable_rel_le_giv";
   10.72 -
   10.73 -Goal "[| Client Join G : Increasing giv;  G : preserves rel |] \
   10.74 -\     ==> Client Join G : Stable {s. rel s <= giv s}";
   10.75 -by (rtac (stable_rel_le_giv RS Increasing_preserves_Stable) 1);
   10.76 -by Auto_tac;
   10.77 -qed "Join_Stable_rel_le_giv";
   10.78 -
   10.79 -Goal "[| Client Join G : Increasing giv;  G : preserves rel |] \
   10.80 -\     ==> Client Join G : Always {s. rel s <= giv s}";
   10.81 -by (force_tac (claset() addIs [AlwaysI, Join_Stable_rel_le_giv], simpset()) 1);
   10.82 -qed "Join_Always_rel_le_giv";
   10.83 -
   10.84 -Goal "Client : transient {s. rel s = k & k<h & h <= giv s & h pfixGe ask s}";
   10.85 -by (res_inst_tac [("act", "rel_act")] transientI 1);
   10.86 -by (auto_tac (claset(),
   10.87 -	      simpset() addsimps [Domain_def, Client_def]));
   10.88 -by (blast_tac (claset() addIs [less_le_trans, prefix_length_le,
   10.89 -			       strict_prefix_length_less]) 1);
   10.90 -by (auto_tac (claset(), 
   10.91 -	      simpset() addsimps [prefix_def, genPrefix_iff_nth, Ge_def]));
   10.92 -by (blast_tac (claset() addIs [strict_prefix_length_less]) 1);
   10.93 -qed "transient_lemma";
   10.94 -
   10.95 -
   10.96 -Goal "[| Client Join G : Increasing giv;  Client ok G |] \
   10.97 -\ ==> Client Join G : {s. rel s = k & k<h & h <= giv s & h pfixGe ask s}  \
   10.98 -\                     LeadsTo {s. k < rel s & rel s <= giv s & \
   10.99 -\                                 h <= giv s & h pfixGe ask s}";
  10.100 -by (rtac single_LeadsTo_I 1);
  10.101 -by (ftac (increasing_ask_rel RS guaranteesD) 1);
  10.102 -by Auto_tac;
  10.103 -by (rtac (transient_lemma RS Join_transient_I1 RS transient_imp_leadsTo RS 
  10.104 -	  leadsTo_imp_LeadsTo RS PSP_Stable RS LeadsTo_weaken) 1);
  10.105 -by (rtac (Stable_Int RS Stable_Int RS Stable_Int) 1);
  10.106 -by (eres_inst_tac [("f", "giv"), ("x", "giv s")] IncreasingD 1);
  10.107 -by (eres_inst_tac [("f", "ask"), ("x", "ask s")] IncreasingD 1);
  10.108 -by (eres_inst_tac [("f", "rel"), ("x", "rel s")] IncreasingD 1);
  10.109 -by (etac Join_Stable_rel_le_giv 1);
  10.110 -by (Blast_tac 1);
  10.111 -by (blast_tac (claset() addIs [sym, order_less_le RS iffD2, 
  10.112 -			       order_trans, prefix_imp_pfixGe, 
  10.113 -			       pfixGe_trans]) 2);
  10.114 -by (blast_tac (claset() addIs [order_less_imp_le, order_trans]) 1);
  10.115 -qed "induct_lemma";
  10.116 -
  10.117 -
  10.118 -Goal "[| Client Join G : Increasing giv;  Client ok G |] \
  10.119 -\ ==> Client Join G : {s. rel s < h & h <= giv s & h pfixGe ask s}  \
  10.120 -\                     LeadsTo {s. h <= rel s}";
  10.121 -by (res_inst_tac [("f", "%s. size h - size (rel s)")] LessThan_induct 1);
  10.122 -by (auto_tac (claset(), simpset() addsimps [vimage_def]));
  10.123 -by (rtac single_LeadsTo_I 1);
  10.124 -by (rtac (induct_lemma RS LeadsTo_weaken) 1);
  10.125 -by Auto_tac;
  10.126 -by (blast_tac (claset() addIs [order_less_le RS iffD2]
  10.127 -			addDs [common_prefix_linear]) 1);
  10.128 -by (REPEAT (dtac strict_prefix_length_less 1));
  10.129 -by (arith_tac 1);
  10.130 -qed "rel_progress_lemma";
  10.131 -
  10.132 -
  10.133 -Goal "[| Client Join G : Increasing giv;  Client ok G |] \
  10.134 -\ ==> Client Join G : {s. h <= giv s & h pfixGe ask s}  \
  10.135 -\                     LeadsTo {s. h <= rel s}";
  10.136 -by (rtac (Join_Always_rel_le_giv RS Always_LeadsToI) 1);
  10.137 -by (rtac ([rel_progress_lemma, subset_refl RS subset_imp_LeadsTo] MRS 
  10.138 -    LeadsTo_Un RS LeadsTo_weaken_L) 3);
  10.139 -by Auto_tac;
  10.140 -by (blast_tac (claset() addIs [order_less_le RS iffD2]
  10.141 -			addDs [common_prefix_linear]) 1);
  10.142 -qed "client_progress_lemma";
  10.143 -
  10.144 -(*Progress property: all tokens that are given will be released*)
  10.145 -Goal "Client : \
  10.146 -\      Increasing giv  guarantees  \
  10.147 -\      (INT h. {s. h <= giv s & h pfixGe ask s} LeadsTo {s. h <= rel s})";
  10.148 -by (rtac guaranteesI 1);
  10.149 -by (Clarify_tac 1);
  10.150 -by (blast_tac (claset() addIs [client_progress_lemma]) 1);
  10.151 -qed "client_progress";
  10.152 -
  10.153 -(*This shows that the Client won't alter other variables in any state
  10.154 -  that it is combined with*)
  10.155 -Goal "Client : preserves dummy";
  10.156 -by (rewtac preserves_def);
  10.157 -by Auto_tac;
  10.158 -by (constrains_tac 1);
  10.159 -by Auto_tac;
  10.160 -qed "client_preserves_dummy";
  10.161 -
  10.162 -
  10.163 -(** Obsolete lemmas from first version of the Client **)
  10.164 -
  10.165 -Goal "Client: stable {s. size (rel s) <= size (giv s)}";
  10.166 -by (constrains_tac 1);
  10.167 -by Auto_tac;
  10.168 -qed "stable_size_rel_le_giv";
  10.169 -
  10.170 -(*clients return the right number of tokens*)
  10.171 -Goal "Client : Increasing giv  guarantees  Always {s. rel s <= giv s}";
  10.172 -by (rtac guaranteesI 1);
  10.173 -by (rtac AlwaysI 1);
  10.174 -by (Force_tac 1);
  10.175 -by (blast_tac (claset() addIs [Increasing_preserves_Stable, 
  10.176 -			       stable_rel_le_giv]) 1);
  10.177 -qed "ok_guar_rel_prefix_giv";
    11.1 --- a/src/HOL/UNITY/Client.thy	Mon Mar 05 12:31:31 2001 +0100
    11.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.3 @@ -1,66 +0,0 @@
    11.4 -(*  Title:      HOL/UNITY/Client.thy
    11.5 -    ID:         $Id$
    11.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    11.7 -    Copyright   1998  University of Cambridge
    11.8 -
    11.9 -Distributed Resource Management System: the Client
   11.10 -*)
   11.11 -
   11.12 -Client = Rename + AllocBase +
   11.13 -
   11.14 -types
   11.15 -  tokbag = nat	   (*tokbags could be multisets...or any ordered type?*)
   11.16 -
   11.17 -record state =
   11.18 -  giv :: tokbag list   (*input history: tokens granted*)
   11.19 -  ask :: tokbag list   (*output history: tokens requested*)
   11.20 -  rel :: tokbag list   (*output history: tokens released*)
   11.21 -  tok :: tokbag	       (*current token request*)
   11.22 -
   11.23 -record 'a state_d =
   11.24 -  state +  
   11.25 -  dummy :: 'a          (*new variables*)
   11.26 -
   11.27 -
   11.28 -(*Array indexing is translated to list indexing as A[n] == A!(n-1). *)
   11.29 -
   11.30 -constdefs
   11.31 -  
   11.32 -  (** Release some tokens **)
   11.33 -  
   11.34 -  rel_act :: "('a state_d * 'a state_d) set"
   11.35 -    "rel_act == {(s,s').
   11.36 -		  EX nrel. nrel = size (rel s) &
   11.37 -		           s' = s (| rel := rel s @ [giv s!nrel] |) &
   11.38 -		           nrel < size (giv s) &
   11.39 -		           ask s!nrel <= giv s!nrel}"
   11.40 -
   11.41 -  (** Choose a new token requirement **)
   11.42 -
   11.43 -  (** Including s'=s suppresses fairness, allowing the non-trivial part
   11.44 -      of the action to be ignored **)
   11.45 -
   11.46 -  tok_act :: "('a state_d * 'a state_d) set"
   11.47 -     "tok_act == {(s,s'). s'=s | s' = s (|tok := Suc (tok s mod NbT) |)}"
   11.48 -  
   11.49 -  ask_act :: "('a state_d * 'a state_d) set"
   11.50 -    "ask_act == {(s,s'). s'=s |
   11.51 -		         (s' = s (|ask := ask s @ [tok s]|))}"
   11.52 -
   11.53 -  Client :: 'a state_d program
   11.54 -    "Client ==
   11.55 -       mk_program ({s. tok s : atMost NbT &
   11.56 -		    giv s = [] & ask s = [] & rel s = []},
   11.57 -		   {rel_act, tok_act, ask_act},
   11.58 -		   UN G: preserves rel Int preserves ask Int preserves tok.
   11.59 -		   Acts G)"
   11.60 -
   11.61 -  (*Maybe want a special theory section to declare such maps*)
   11.62 -  non_dummy :: 'a state_d => state
   11.63 -    "non_dummy s == (|giv = giv s, ask = ask s, rel = rel s, tok = tok s|)"
   11.64 -
   11.65 -  (*Renaming map to put a Client into the standard form*)
   11.66 -  client_map :: "'a state_d => state*'a"
   11.67 -    "client_map == funPair non_dummy dummy"
   11.68 -
   11.69 -end
    12.1 --- a/src/HOL/UNITY/Common.ML	Mon Mar 05 12:31:31 2001 +0100
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,90 +0,0 @@
    12.4 -(*  Title:      HOL/UNITY/Common
    12.5 -    ID:         $Id$
    12.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    12.7 -    Copyright   1998  University of Cambridge
    12.8 -
    12.9 -Common Meeting Time example from Misra (1994)
   12.10 -
   12.11 -The state is identified with the one variable in existence.
   12.12 -
   12.13 -From Misra, "A Logic for Concurrent Programming" (1994), sections 5.1 and 13.1.
   12.14 -*)
   12.15 -
   12.16 -(*Misra's property CMT4: t exceeds no common meeting time*)
   12.17 -Goal "[| ALL m. F : {m} Co (maxfg m); n: common |] \
   12.18 -\     ==> F : Stable (atMost n)";
   12.19 -by (dres_inst_tac [("M", "{t. t<=n}")] Elimination_sing 1);
   12.20 -by (asm_full_simp_tac
   12.21 -    (simpset() addsimps [atMost_def, Stable_def, common_def, maxfg_def,
   12.22 -			 le_max_iff_disj]) 1);
   12.23 -by (etac Constrains_weaken_R 1);
   12.24 -by (blast_tac (claset() addIs [order_eq_refl, fmono, gmono, le_trans]) 1);
   12.25 -qed "common_stable";
   12.26 -
   12.27 -Goal "[| Init F <= atMost n;  \
   12.28 -\        ALL m. F : {m} Co (maxfg m); n: common |] \
   12.29 -\     ==> F : Always (atMost n)";
   12.30 -by (asm_simp_tac (simpset() addsimps [AlwaysI, common_stable]) 1);
   12.31 -qed "common_safety";
   12.32 -
   12.33 -
   12.34 -(*** Some programs that implement the safety property above ***)
   12.35 -
   12.36 -Goal "SKIP : {m} co (maxfg m)";
   12.37 -by (simp_tac (simpset() addsimps [constrains_def, maxfg_def, le_max_iff_disj,
   12.38 -				  fasc]) 1);
   12.39 -result();
   12.40 -
   12.41 -(*This one is  t := ftime t || t := gtime t*)
   12.42 -Goal "mk_program (UNIV, {range(%t.(t,ftime t)), range(%t.(t,gtime t))}, UNIV) \
   12.43 -\      : {m} co (maxfg m)";
   12.44 -by (simp_tac (simpset() addsimps [constrains_def, maxfg_def, 
   12.45 -				  le_max_iff_disj, fasc]) 1);
   12.46 -result();
   12.47 -
   12.48 -(*This one is  t := max (ftime t) (gtime t)*)
   12.49 -Goal "mk_program (UNIV, {range(%t.(t, max (ftime t) (gtime t)))}, UNIV) \
   12.50 -\      : {m} co (maxfg m)";
   12.51 -by (simp_tac 
   12.52 -    (simpset() addsimps [constrains_def, maxfg_def, max_def, gasc]) 1);
   12.53 -result();
   12.54 -
   12.55 -(*This one is  t := t+1 if t <max (ftime t) (gtime t) *)
   12.56 -Goal "mk_program  \
   12.57 -\         (UNIV, { {(t, Suc t) | t. t < max (ftime t) (gtime t)} }, UNIV)  \
   12.58 -\      : {m} co (maxfg m)";
   12.59 -by (simp_tac 
   12.60 -    (simpset() addsimps [constrains_def, maxfg_def, max_def, gasc]) 1);
   12.61 -result();
   12.62 -
   12.63 -
   12.64 -(*It remans to prove that they satisfy CMT3': t does not decrease,
   12.65 -  and that CMT3' implies that t stops changing once common(t) holds.*)
   12.66 -
   12.67 -
   12.68 -(*** Progress under weak fairness ***)
   12.69 -
   12.70 -Addsimps [atMost_Int_atLeast];
   12.71 -
   12.72 -Goal "[| ALL m. F : {m} Co (maxfg m); \
   12.73 -\               ALL m: lessThan n. F : {m} LeadsTo (greaterThan m); \
   12.74 -\               n: common |]  \
   12.75 -\     ==> F : (atMost n) LeadsTo common";
   12.76 -by (rtac LeadsTo_weaken_R 1);
   12.77 -by (res_inst_tac [("f","id"), ("l","n")] GreaterThan_bounded_induct 1);
   12.78 -by (ALLGOALS Asm_simp_tac);
   12.79 -by (rtac subset_refl 2);
   12.80 -by (blast_tac (claset() addDs [PSP_Stable2] 
   12.81 -                        addIs [common_stable, LeadsTo_weaken_R]) 1);
   12.82 -val lemma = result();
   12.83 -
   12.84 -(*The "ALL m: -common" form echoes CMT6.*)
   12.85 -Goal "[| ALL m. F : {m} Co (maxfg m); \
   12.86 -\               ALL m: -common. F : {m} LeadsTo (greaterThan m); \
   12.87 -\               n: common |]  \
   12.88 -\            ==> F : (atMost (LEAST n. n: common)) LeadsTo common";
   12.89 -by (rtac lemma 1);
   12.90 -by (ALLGOALS Asm_simp_tac);
   12.91 -by (etac LeastI 2);
   12.92 -by (blast_tac (claset() addSDs [not_less_Least]) 1);
   12.93 -qed "leadsTo_common";
    13.1 --- a/src/HOL/UNITY/Common.thy	Mon Mar 05 12:31:31 2001 +0100
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,32 +0,0 @@
    13.4 -(*  Title:      HOL/UNITY/Common
    13.5 -    ID:         $Id$
    13.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    13.7 -    Copyright   1998  University of Cambridge
    13.8 -
    13.9 -Common Meeting Time example from Misra (1994)
   13.10 -
   13.11 -The state is identified with the one variable in existence.
   13.12 -
   13.13 -From Misra, "A Logic for Concurrent Programming" (1994), sections 5.1 and 13.1.
   13.14 -*)
   13.15 -
   13.16 -Common = SubstAx + 
   13.17 -
   13.18 -consts
   13.19 -  ftime,gtime :: nat=>nat
   13.20 -
   13.21 -rules
   13.22 -  fmono "m <= n ==> ftime m <= ftime n"
   13.23 -  gmono "m <= n ==> gtime m <= gtime n"
   13.24 -
   13.25 -  fasc  "m <= ftime n"
   13.26 -  gasc  "m <= gtime n"
   13.27 -
   13.28 -constdefs
   13.29 -  common :: nat set
   13.30 -    "common == {n. ftime n = n & gtime n = n}"
   13.31 -
   13.32 -  maxfg :: nat => nat set
   13.33 -    "maxfg m == {t. t <= max (ftime m) (gtime m)}"
   13.34 -
   13.35 -end
    14.1 --- a/src/HOL/UNITY/Counter.ML	Mon Mar 05 12:31:31 2001 +0100
    14.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.3 @@ -1,140 +0,0 @@
    14.4 -(*  Title:      HOL/UNITY/Counter
    14.5 -    ID:         $Id$
    14.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    14.7 -    Copyright   2001  University of Cambridge
    14.8 -
    14.9 -A family of similar counters, version close to the original. 
   14.10 -
   14.11 -From Charpentier and Chandy,
   14.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   14.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   14.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   14.15 -*)
   14.16 -
   14.17 -Addsimps [Component_def RS def_prg_Init];
   14.18 -program_defs_ref := [Component_def];
   14.19 -Addsimps (map simp_of_act  [a_def]);
   14.20 -
   14.21 -(* Theorems about sum and sumj *)
   14.22 -Goal "ALL n. I<n --> sum I (s(c n := x)) = sum I s";
   14.23 -by (induct_tac "I" 1);
   14.24 -by Auto_tac;
   14.25 -qed_spec_mp "sum_upd_gt";
   14.26 -
   14.27 -
   14.28 -Goal "sum I (s(c I := x)) = sum I s";
   14.29 -by (induct_tac "I" 1);
   14.30 -by Auto_tac;
   14.31 -by (simp_tac (simpset() 
   14.32 -    addsimps [rewrite_rule [fun_upd_def] sum_upd_gt]) 1);
   14.33 -qed "sum_upd_eq";
   14.34 -
   14.35 -Goal "sum I (s(C := x)) = sum I s";
   14.36 -by (induct_tac "I" 1);
   14.37 -by Auto_tac;
   14.38 -qed "sum_upd_C";
   14.39 -
   14.40 -Goal "sumj I i (s(c i := x)) = sumj I i s";
   14.41 -by (induct_tac "I" 1);
   14.42 -by Auto_tac;
   14.43 -by (simp_tac (simpset() addsimps 
   14.44 -    [rewrite_rule [fun_upd_def] sum_upd_eq]) 1);
   14.45 -qed "sumj_upd_ci";
   14.46 -
   14.47 -Goal "sumj I i (s(C := x)) = sumj I i s";
   14.48 -by (induct_tac "I" 1);
   14.49 -by Auto_tac;
   14.50 -by (simp_tac (simpset() 
   14.51 -    addsimps [rewrite_rule [fun_upd_def] sum_upd_C]) 1);
   14.52 -qed "sumj_upd_C";
   14.53 -
   14.54 -Goal "ALL i. I<i--> (sumj I i s = sum I s)";
   14.55 -by (induct_tac "I" 1);
   14.56 -by Auto_tac;
   14.57 -qed_spec_mp  "sumj_sum_gt";
   14.58 -
   14.59 -Goal "(sumj I I s = sum I s)";
   14.60 -by (induct_tac "I" 1);
   14.61 -by Auto_tac;
   14.62 -by (simp_tac (simpset() addsimps [sumj_sum_gt]) 1);
   14.63 -qed "sumj_sum_eq";
   14.64 -
   14.65 -Goal "ALL i. i<I-->(sum I s = s (c i) +  sumj I i s)";
   14.66 -by (induct_tac "I" 1);
   14.67 -by (auto_tac (claset(), simpset() addsimps [linorder_neq_iff, sumj_sum_eq]));  
   14.68 -qed_spec_mp "sum_sumj";
   14.69 -
   14.70 -(* Correctness proofs for Components *)
   14.71 -(* p2 and p3 proofs *)
   14.72 -Goal "Component i : stable {s. s C = s (c i) + k}";
   14.73 -by (constrains_tac 1);
   14.74 -qed "p2";
   14.75 -
   14.76 -Goal 
   14.77 -"Component i: stable {s. ALL v. v~=c i & v~=C --> s v = k v}";
   14.78 -by (constrains_tac 1);
   14.79 -qed "p3";
   14.80 -
   14.81 -
   14.82 -Goal 
   14.83 -"(ALL k. Component i: stable ({s. s C = s (c i) + sumj I i k} \
   14.84 -\                  Int {s. ALL v. v~=c i & v~=C --> s v = k v})) \
   14.85 -\  = (Component i: stable {s. s C = s (c i) + sumj I i s})";
   14.86 -by (auto_tac (claset(), simpset() 
   14.87 -     addsimps [constrains_def, stable_def,Component_def,
   14.88 -               sumj_upd_C, sumj_upd_ci]));
   14.89 -qed "p2_p3_lemma1";
   14.90 -
   14.91 -Goal 
   14.92 -"ALL k. Component i: stable ({s. s C = s (c i) + sumj I i k} Int \
   14.93 -\                             {s. ALL v. v~=c i & v~=C --> s v = k v})";
   14.94 -by (blast_tac (claset() addIs [[p2, p3] MRS stable_Int]) 1);
   14.95 -qed "p2_p3_lemma2";
   14.96 -
   14.97 -
   14.98 -Goal 
   14.99 -"Component i: stable {s.  s C = s (c i) + sumj I i s}";
  14.100 -by (auto_tac (claset() addSIs [p2_p3_lemma2],
  14.101 -              simpset() addsimps [p2_p3_lemma1 RS sym]));
  14.102 -qed "p2_p3";
  14.103 -
  14.104 -(* Compositional Proof *)
  14.105 -
  14.106 -Goal "(ALL i. i < I --> s (c i) = #0) --> sum I s = #0";
  14.107 -by (induct_tac "I" 1);
  14.108 -by Auto_tac;
  14.109 -qed "sum_0'";
  14.110 -val sum0_lemma =  (sum_0' RS mp) RS sym;
  14.111 -
  14.112 -(* I could'nt be empty *)
  14.113 -Goalw [invariant_def] 
  14.114 -"!!I. 0<I ==> (JN i:{i. i<I}. Component i):invariant {s. s C = sum I s}";
  14.115 -by (simp_tac (simpset() addsimps [JN_stable,Init_JN,sum_sumj]) 1);
  14.116 -by (force_tac (claset() addIs [p2_p3, sum0_lemma RS sym], simpset()) 1);
  14.117 -qed "safety";
  14.118 -
  14.119 -
  14.120 -
  14.121 -
  14.122 -
  14.123 -
  14.124 -
  14.125 -
  14.126 -
  14.127 -
  14.128 -
  14.129 -
  14.130 -
  14.131 -
  14.132 -
  14.133 -
  14.134 -
  14.135 -
  14.136 -
  14.137 -
  14.138 -
  14.139 - 
  14.140 -
  14.141 -
  14.142 -
  14.143 -
    15.1 --- a/src/HOL/UNITY/Counter.thy	Mon Mar 05 12:31:31 2001 +0100
    15.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.3 @@ -1,41 +0,0 @@
    15.4 -(*  Title:      HOL/UNITY/Counter
    15.5 -    ID:         $Id$
    15.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    15.7 -    Copyright   2001  University of Cambridge
    15.8 -
    15.9 -A family of similar counters, version close to the original. 
   15.10 -
   15.11 -From Charpentier and Chandy,
   15.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   15.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   15.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   15.15 -*)
   15.16 -
   15.17 -Counter =  Comp +
   15.18 -(* Variables are names *)
   15.19 -datatype name = C | c nat
   15.20 -types state = name=>int
   15.21 -
   15.22 -consts  
   15.23 -  sum  :: "[nat,state]=>int"
   15.24 -  sumj :: "[nat, nat, state]=>int"
   15.25 -
   15.26 -primrec (* sum I s = sigma_{i<I}. s (c i) *)
   15.27 -  "sum 0 s = #0"
   15.28 -  "sum (Suc i) s = s (c i) + sum i s"
   15.29 -
   15.30 -primrec
   15.31 -  "sumj 0 i s = #0"
   15.32 -  "sumj (Suc n) i s = (if n=i then sum n s else s (c n) + sumj n i s)"
   15.33 -  
   15.34 -types command = "(state*state)set"
   15.35 -
   15.36 -constdefs
   15.37 -  a :: "nat=>command"
   15.38 - "a i == {(s, s'). s'=s(c i:= s (c i) + #1, C:= s C + #1)}"
   15.39 -
   15.40 -  Component :: "nat => state program"
   15.41 -  "Component i ==
   15.42 -    mk_program({s. s C = #0 & s (c i) = #0}, {a i},
   15.43 -	       UN G: preserves (%s. s (c i)). Acts G)"
   15.44 -end  
    16.1 --- a/src/HOL/UNITY/Counterc.ML	Mon Mar 05 12:31:31 2001 +0100
    16.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.3 @@ -1,124 +0,0 @@
    16.4 -(*  Title:      HOL/UNITY/Counterc
    16.5 -    ID:         $Id$
    16.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    16.7 -    Copyright   2001  University of Cambridge
    16.8 -
    16.9 -A family of similar counters, version with a full use of "compatibility "
   16.10 -
   16.11 -From Charpentier and Chandy,
   16.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   16.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   16.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   16.15 -*)
   16.16 -
   16.17 -Addsimps [Component_def RS def_prg_Init, 
   16.18 -Component_def RS def_prg_AllowedActs];
   16.19 -program_defs_ref := [Component_def];
   16.20 -Addsimps (map simp_of_act  [a_def]);
   16.21 -
   16.22 -(* Theorems about sum and sumj *)
   16.23 -Goal "ALL i. I<i--> (sum I s = sumj I i s)";
   16.24 -by (induct_tac "I" 1);
   16.25 -by Auto_tac;
   16.26 -qed_spec_mp  "sum_sumj_eq1";
   16.27 -
   16.28 -Goal "i<I --> sum I s  = c s i + sumj I i s";
   16.29 -by (induct_tac "I" 1);
   16.30 -by (auto_tac (claset(), simpset() addsimps [linorder_neq_iff, sum_sumj_eq1]));
   16.31 -qed_spec_mp "sum_sumj_eq2";
   16.32 -
   16.33 -Goal "(ALL i. i<I --> c s' i = c s i) --> (sum I s' = sum I s)";
   16.34 -by (induct_tac "I" 1 THEN Auto_tac);
   16.35 -qed_spec_mp "sum_ext";
   16.36 -
   16.37 -Goal "(ALL j. j<I & j~=i --> c s' j =  c s j) --> (sumj I i s' = sumj I i s)";
   16.38 -by (induct_tac "I" 1);
   16.39 -by Safe_tac;
   16.40 -by (auto_tac (claset() addSIs [sum_ext], simpset()));
   16.41 -qed_spec_mp "sumj_ext";
   16.42 -
   16.43 -
   16.44 -Goal "(ALL i. i<I --> c s i = #0) -->  sum I s = #0";
   16.45 -by (induct_tac "I" 1);
   16.46 -by Auto_tac;
   16.47 -qed "sum0";
   16.48 -
   16.49 -
   16.50 -(* Safety properties for Components *)
   16.51 -
   16.52 -Goal "(Component i ok G) = \
   16.53 -\     (G: preserves (%s. c s i) & Component i:Allowed G)";
   16.54 -by (auto_tac (claset(), 
   16.55 -      simpset() addsimps [ok_iff_Allowed, Component_def RS def_prg_Allowed]));
   16.56 -qed "Component_ok_iff";
   16.57 -AddIffs [Component_ok_iff];
   16.58 -AddIffs [OK_iff_ok];
   16.59 -Addsimps [preserves_def];
   16.60 -
   16.61 -
   16.62 -Goal "Component i: stable {s. C s = (c s) i + k}";
   16.63 -by (constrains_tac 1);
   16.64 -qed "p2";
   16.65 -
   16.66 -Goal "[| OK I Component; i:I |]  \
   16.67 -\      ==> Component i: stable {s. ALL j:I. j~=i --> c s j = c k j}";
   16.68 -by (full_simp_tac (simpset() addsimps [stable_def, constrains_def]) 1);
   16.69 -by (Blast_tac 1);
   16.70 -qed "p3";
   16.71 -
   16.72 -
   16.73 -Goal 
   16.74 -"[| OK {i. i<I} Component; i<I |] ==> \
   16.75 -\ ALL k. Component i: stable ({s. C s = c s i + sumj I i k} Int \
   16.76 -\                             {s. ALL j:{i. i<I}. j~=i --> c s j = c k j})";
   16.77 -by (blast_tac (claset() addIs [[p2, p3] MRS stable_Int]) 1);
   16.78 -qed "p2_p3_lemma1";
   16.79 -
   16.80 -
   16.81 -Goal "(ALL k. F:stable ({s. C s = (c s) i + sumj I i k} Int \
   16.82 -\                       {s. ALL j:{i. i<I}. j~=i --> c s j = c k j}))  \
   16.83 -\     ==> (F:stable {s. C s = c s i + sumj I i s})";
   16.84 -by (full_simp_tac (simpset() addsimps [constrains_def, stable_def]) 1);
   16.85 -by (force_tac (claset() addSIs [sumj_ext], simpset()) 1);
   16.86 -qed "p2_p3_lemma2";
   16.87 -
   16.88 -
   16.89 -Goal "[| OK {i. i<I} Component; i<I |] \
   16.90 -\     ==> Component i: stable {s. C s = c s i + sumj I i s}";
   16.91 -by (blast_tac (claset() addIs [p2_p3_lemma1 RS p2_p3_lemma2]) 1);
   16.92 -qed "p2_p3";
   16.93 -
   16.94 -
   16.95 -(* Compositional correctness *)
   16.96 -Goalw [invariant_def]
   16.97 -     "[| 0<I; OK {i. i<I} Component |]  \
   16.98 -\     ==> (JN i:{i. i<I}. (Component i)) : invariant {s. C s = sum I s}";
   16.99 -by (simp_tac (simpset() addsimps [JN_stable, sum_sumj_eq2]) 1);
  16.100 -by (auto_tac (claset() addSIs [sum0 RS mp, p2_p3], 
  16.101 -              simpset()));
  16.102 -qed "safety";
  16.103 -
  16.104 -
  16.105 -
  16.106 -
  16.107 -
  16.108 -
  16.109 -
  16.110 -
  16.111 -
  16.112 -
  16.113 -
  16.114 -
  16.115 -
  16.116 -
  16.117 -
  16.118 -
  16.119 -
  16.120 -
  16.121 -
  16.122 -
  16.123 - 
  16.124 -
  16.125 -
  16.126 -
  16.127 -
    17.1 --- a/src/HOL/UNITY/Counterc.thy	Mon Mar 05 12:31:31 2001 +0100
    17.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.3 @@ -1,43 +0,0 @@
    17.4 -(*  Title:      HOL/UNITY/Counterc
    17.5 -    ID:         $Id$
    17.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    17.7 -    Copyright   2001  University of Cambridge
    17.8 -
    17.9 -A family of similar counters, version with a full use of "compatibility "
   17.10 -
   17.11 -From Charpentier and Chandy,
   17.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   17.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   17.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   17.15 -*)
   17.16 -
   17.17 -Counterc =  Comp +
   17.18 -types state
   17.19 -arities state :: term
   17.20 -
   17.21 -consts
   17.22 -  C :: "state=>int"
   17.23 -  c :: "state=>nat=>int"
   17.24 -
   17.25 -consts  
   17.26 -  sum  :: "[nat,state]=>int"
   17.27 -  sumj :: "[nat, nat, state]=>int"
   17.28 -
   17.29 -primrec (* sum I s = sigma_{i<I}. c s i *)
   17.30 -  "sum 0 s = #0"
   17.31 -  "sum (Suc i) s = (c s) i + sum i s"
   17.32 -
   17.33 -primrec
   17.34 -  "sumj 0 i s = #0"
   17.35 -  "sumj (Suc n) i s = (if n=i then sum n s else (c s) n + sumj n i s)"
   17.36 -  
   17.37 -types command = "(state*state)set"
   17.38 -
   17.39 -constdefs
   17.40 -  a :: "nat=>command"
   17.41 - "a i == {(s, s'). (c s') i = (c s) i + #1 & (C s') = (C s) + #1}"
   17.42 - 
   17.43 -  Component :: "nat => state program"
   17.44 -  "Component i == mk_program({s. C s = #0 & (c s) i = #0}, {a i},
   17.45 -	       UN G: preserves (%s. (c s) i). Acts G)"
   17.46 -end  
    18.1 --- a/src/HOL/UNITY/Deadlock.ML	Mon Mar 05 12:31:31 2001 +0100
    18.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.3 @@ -1,78 +0,0 @@
    18.4 -(*  Title:      HOL/UNITY/Deadlock
    18.5 -    ID:         $Id$
    18.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    18.7 -    Copyright   1998  University of Cambridge
    18.8 -
    18.9 -Deadlock examples from section 5.6 of 
   18.10 -    Misra, "A Logic for Concurrent Programming", 1994
   18.11 -*)
   18.12 -
   18.13 -(*Trivial, two-process case*)
   18.14 -Goalw [constrains_def, stable_def]
   18.15 -    "[| F : (A Int B) co A;  F : (B Int A) co B |] ==> F : stable (A Int B)";
   18.16 -by (Blast_tac 1);
   18.17 -result();
   18.18 -
   18.19 -
   18.20 -(*a simplification step*)
   18.21 -Goal "(INT i: atMost n. A(Suc i) Int A i) = (INT i: atMost (Suc n). A i)";
   18.22 -by (induct_tac "n" 1);
   18.23 -by (ALLGOALS (asm_simp_tac (simpset() addsimps [atMost_Suc])));
   18.24 -by Auto_tac;
   18.25 -qed "Collect_le_Int_equals";
   18.26 -
   18.27 -(*Dual of the required property.  Converse inclusion fails.*)
   18.28 -Goal "(UN i: lessThan n. A i) Int (- A n) <=  \
   18.29 -\     (UN i: lessThan n. (A i) Int (- A (Suc i)))";
   18.30 -by (induct_tac "n" 1);
   18.31 -by (Asm_simp_tac 1);
   18.32 -by (simp_tac (simpset() addsimps [lessThan_Suc]) 1);
   18.33 -by (Blast_tac 1);
   18.34 -qed "UN_Int_Compl_subset";
   18.35 -
   18.36 -
   18.37 -(*Converse inclusion fails.*)
   18.38 -Goal "(INT i: lessThan n. -A i Un A (Suc i))  <= \
   18.39 -\     (INT i: lessThan n. -A i) Un A n";
   18.40 -by (induct_tac "n" 1);
   18.41 -by (Asm_simp_tac 1);
   18.42 -by (asm_simp_tac (simpset() addsimps [lessThan_Suc]) 1);
   18.43 -by (Blast_tac 1);
   18.44 -qed "INT_Un_Compl_subset";
   18.45 -
   18.46 -
   18.47 -(*Specialized rewriting*)
   18.48 -Goal "A 0 Int (-(A n) Int (INT i: lessThan n. -A i Un A (Suc i))) = {}";
   18.49 -by (blast_tac (claset() addIs [gr0I]
   18.50 -		        addDs [impOfSubs INT_Un_Compl_subset]) 1);
   18.51 -val lemma = result();
   18.52 -
   18.53 -(*Reverse direction makes it harder to invoke the ind hyp*)
   18.54 -Goal "(INT i: atMost n. A i) = \
   18.55 -\         A 0 Int (INT i: lessThan n. -A i Un A(Suc i))";
   18.56 -by (induct_tac "n" 1);
   18.57 -by (Asm_simp_tac 1);
   18.58 -by (asm_simp_tac
   18.59 -    (simpset() addsimps Int_ac @ [Int_Un_distrib, Int_Un_distrib2, lemma,
   18.60 -				  lessThan_Suc, atMost_Suc]) 1);
   18.61 -qed "INT_le_equals_Int";
   18.62 -
   18.63 -Goal "(INT i: atMost (Suc n). A i) = \
   18.64 -\     A 0 Int (INT i: atMost n. -A i Un A(Suc i))";
   18.65 -by (simp_tac (simpset() addsimps [lessThan_Suc_atMost, INT_le_equals_Int]) 1);
   18.66 -qed "INT_le_Suc_equals_Int";
   18.67 -
   18.68 -
   18.69 -(*The final deadlock example*)
   18.70 -val [zeroprem, allprem] = Goalw [stable_def]
   18.71 -    "[| F : (A 0 Int A (Suc n)) co (A 0);  \
   18.72 -\       !!i. i: atMost n ==> F : (A(Suc i) Int A i) co (-A i Un A(Suc i)) |] \
   18.73 -\    ==> F : stable (INT i: atMost (Suc n). A i)";
   18.74 -by (rtac ([zeroprem, constrains_INT] MRS 
   18.75 -	  constrains_Int RS constrains_weaken) 1);
   18.76 -by (etac allprem 1);
   18.77 -by (simp_tac (simpset() addsimps [Collect_le_Int_equals, 
   18.78 -				  Int_assoc, INT_absorb]) 1);
   18.79 -by (simp_tac (simpset() addsimps [INT_le_Suc_equals_Int]) 1);
   18.80 -result();
   18.81 -
    19.1 --- a/src/HOL/UNITY/Deadlock.thy	Mon Mar 05 12:31:31 2001 +0100
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,1 +0,0 @@
    19.4 -Deadlock = UNITY
    20.1 --- a/src/HOL/UNITY/Handshake.ML	Mon Mar 05 12:31:31 2001 +0100
    20.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.3 @@ -1,49 +0,0 @@
    20.4 -(*  Title:      HOL/UNITY/Handshake
    20.5 -    ID:         $Id$
    20.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    20.7 -    Copyright   1998  University of Cambridge
    20.8 -
    20.9 -Handshake Protocol
   20.10 -
   20.11 -From Misra, "Asynchronous Compositions of Programs", Section 5.3.2
   20.12 -*)
   20.13 -
   20.14 -Addsimps [F_def RS def_prg_Init, G_def RS def_prg_Init];
   20.15 -program_defs_ref := [F_def, G_def];
   20.16 -
   20.17 -Addsimps (map simp_of_act [cmdF_def, cmdG_def]);
   20.18 -Addsimps [simp_of_set invFG_def];
   20.19 -
   20.20 -
   20.21 -Goal "(F Join G) : Always invFG";
   20.22 -by (rtac AlwaysI 1);
   20.23 -by (Force_tac 1);
   20.24 -by (rtac (constrains_imp_Constrains RS StableI) 1);
   20.25 -by Auto_tac;
   20.26 -by (constrains_tac 2);
   20.27 -by (auto_tac (claset() addIs [order_antisym] addSEs [le_SucE], simpset()));
   20.28 -by (constrains_tac 1);
   20.29 -qed "invFG";
   20.30 -
   20.31 -Goal "(F Join G) : ({s. NF s = k} - {s. BB s}) LeadsTo \
   20.32 -\                  ({s. NF s = k} Int {s. BB s})";
   20.33 -by (rtac (stable_Join_ensures1 RS leadsTo_Basis RS leadsTo_imp_LeadsTo) 1);
   20.34 -by (ensures_tac "cmdG" 2);
   20.35 -by (constrains_tac 1);
   20.36 -qed "lemma2_1";
   20.37 -
   20.38 -Goal "(F Join G) : ({s. NF s = k} Int {s. BB s}) LeadsTo {s. k < NF s}";
   20.39 -by (rtac (stable_Join_ensures2 RS leadsTo_Basis RS leadsTo_imp_LeadsTo) 1);
   20.40 -by (constrains_tac 2);
   20.41 -by (ensures_tac "cmdF" 1);
   20.42 -qed "lemma2_2";
   20.43 -
   20.44 -Goal "(F Join G) : UNIV LeadsTo {s. m < NF s}";
   20.45 -by (rtac LeadsTo_weaken_R 1);
   20.46 -by (res_inst_tac [("f", "NF"), ("l","Suc m"), ("B","{}")] 
   20.47 -    GreaterThan_bounded_induct 1);
   20.48 -(*The inductive step is (F Join G) : {x. NF x = ma} LeadsTo {x. ma < NF x}*)
   20.49 -by (auto_tac (claset() addSIs [lemma2_1, lemma2_2] 
   20.50 -	               addIs[LeadsTo_Trans, LeadsTo_Diff], 
   20.51 -	      simpset() addsimps [vimage_def]));
   20.52 -qed "progress";
    21.1 --- a/src/HOL/UNITY/Handshake.thy	Mon Mar 05 12:31:31 2001 +0100
    21.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.3 @@ -1,37 +0,0 @@
    21.4 -(*  Title:      HOL/UNITY/Handshake.thy
    21.5 -    ID:         $Id$
    21.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    21.7 -    Copyright   1998  University of Cambridge
    21.8 -
    21.9 -Handshake Protocol
   21.10 -
   21.11 -From Misra, "Asynchronous Compositions of Programs", Section 5.3.2
   21.12 -*)
   21.13 -
   21.14 -Handshake = Union +
   21.15 -
   21.16 -record state =
   21.17 -  BB :: bool
   21.18 -  NF :: nat
   21.19 -  NG :: nat
   21.20 -
   21.21 -constdefs
   21.22 -  (*F's program*)
   21.23 -  cmdF :: "(state*state) set"
   21.24 -    "cmdF == {(s,s'). s' = s (|NF:= Suc(NF s), BB:=False|) & BB s}"
   21.25 -
   21.26 -  F :: "state program"
   21.27 -    "F == mk_program ({s. NF s = 0 & BB s}, {cmdF}, UNIV)"
   21.28 -
   21.29 -  (*G's program*)
   21.30 -  cmdG :: "(state*state) set"
   21.31 -    "cmdG == {(s,s'). s' = s (|NG:= Suc(NG s), BB:=True|) & ~ BB s}"
   21.32 -
   21.33 -  G :: "state program"
   21.34 -    "G == mk_program ({s. NG s = 0 & BB s}, {cmdG}, UNIV)"
   21.35 -
   21.36 -  (*the joint invariant*)
   21.37 -  invFG :: "state set"
   21.38 -    "invFG == {s. NG s <= NF s & NF s <= Suc (NG s) & (BB s = (NF s = NG s))}"
   21.39 -
   21.40 -end
    22.1 --- a/src/HOL/UNITY/Lift.ML	Mon Mar 05 12:31:31 2001 +0100
    22.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.3 @@ -1,317 +0,0 @@
    22.4 -(*  Title:      HOL/UNITY/Lift
    22.5 -    ID:         $Id$
    22.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    22.7 -    Copyright   1998  University of Cambridge
    22.8 -
    22.9 -The Lift-Control Example
   22.10 -*)
   22.11 -
   22.12 -Goal "[| x ~: A;  y : A |] ==> x ~= y";
   22.13 -by (Blast_tac 1);
   22.14 -qed "not_mem_distinct";
   22.15 -
   22.16 -
   22.17 -Addsimps [Lift_def RS def_prg_Init];
   22.18 -program_defs_ref := [Lift_def];
   22.19 -
   22.20 -Addsimps (map simp_of_act
   22.21 -	  [request_act_def, open_act_def, close_act_def,
   22.22 -	   req_up_def, req_down_def, move_up_def, move_down_def,
   22.23 -	   button_press_def]);
   22.24 -
   22.25 -(*The ALWAYS properties*)
   22.26 -Addsimps (map simp_of_set [above_def, below_def, queueing_def, 
   22.27 -			   goingup_def, goingdown_def, ready_def]);
   22.28 -
   22.29 -Addsimps [bounded_def, open_stop_def, open_move_def, stop_floor_def,
   22.30 -	  moving_up_def, moving_down_def];
   22.31 -
   22.32 -AddIffs [Min_le_Max];
   22.33 -
   22.34 -Goal "Lift : Always open_stop";
   22.35 -by (always_tac 1);
   22.36 -qed "open_stop";
   22.37 -
   22.38 -Goal "Lift : Always stop_floor";
   22.39 -by (always_tac 1);
   22.40 -qed "stop_floor";
   22.41 -
   22.42 -(*This one needs open_stop, which was proved above*)
   22.43 -Goal "Lift : Always open_move";
   22.44 -by (cut_facts_tac [open_stop] 1);
   22.45 -by (always_tac 1);
   22.46 -qed "open_move";
   22.47 -
   22.48 -Goal "Lift : Always moving_up";
   22.49 -by (always_tac 1);
   22.50 -by (auto_tac (claset() addDs [zle_imp_zless_or_eq],
   22.51 -	      simpset() addsimps [add1_zle_eq]));
   22.52 -qed "moving_up";
   22.53 -
   22.54 -Goal "Lift : Always moving_down";
   22.55 -by (always_tac 1);
   22.56 -by (blast_tac (claset() addDs [zle_imp_zless_or_eq]) 1);
   22.57 -qed "moving_down";
   22.58 -
   22.59 -Goal "Lift : Always bounded";
   22.60 -by (cut_facts_tac [moving_up, moving_down] 1);
   22.61 -by (always_tac 1);
   22.62 -by Auto_tac;
   22.63 -by (ALLGOALS (dtac not_mem_distinct THEN' assume_tac));
   22.64 -by (ALLGOALS arith_tac);
   22.65 -qed "bounded";
   22.66 -
   22.67 -
   22.68 -
   22.69 -(*** Progress ***)
   22.70 -
   22.71 -
   22.72 -val abbrev_defs = [moving_def, stopped_def, 
   22.73 -		   opened_def, closed_def, atFloor_def, Req_def];
   22.74 -
   22.75 -Addsimps (map simp_of_set abbrev_defs);
   22.76 -
   22.77 -
   22.78 -(** The HUG'93 paper mistakenly omits the Req n from these! **)
   22.79 -
   22.80 -(** Lift_1 **)
   22.81 -
   22.82 -Goal "Lift : (stopped Int atFloor n) LeadsTo (opened Int atFloor n)";
   22.83 -by (cut_facts_tac [stop_floor] 1);
   22.84 -by (ensures_tac "open_act" 1);
   22.85 -qed "E_thm01";  (*lem_lift_1_5*)
   22.86 -
   22.87 -Goal "Lift : (Req n Int stopped - atFloor n) LeadsTo \
   22.88 -\                    (Req n Int opened - atFloor n)";
   22.89 -by (cut_facts_tac [stop_floor] 1);
   22.90 -by (ensures_tac "open_act" 1);
   22.91 -qed "E_thm02";  (*lem_lift_1_1*)
   22.92 -
   22.93 -Goal "Lift : (Req n Int opened - atFloor n) LeadsTo \
   22.94 -\                    (Req n Int closed - (atFloor n - queueing))";
   22.95 -by (ensures_tac "close_act" 1);
   22.96 -qed "E_thm03";  (*lem_lift_1_2*)
   22.97 -
   22.98 -Goal "Lift : (Req n Int closed Int (atFloor n - queueing))  \
   22.99 -\            LeadsTo (opened Int atFloor n)";
  22.100 -by (ensures_tac "open_act" 1);
  22.101 -qed "E_thm04";  (*lem_lift_1_7*)
  22.102 -
  22.103 -
  22.104 -(** Lift 2.  Statements of thm05a and thm05b were wrong! **)
  22.105 -
  22.106 -Open_locale "floor"; 
  22.107 -
  22.108 -val Min_le_n = thm "Min_le_n";
  22.109 -val n_le_Max = thm "n_le_Max";
  22.110 -
  22.111 -AddIffs [Min_le_n, n_le_Max];
  22.112 -
  22.113 -val le_MinD = Min_le_n RS order_antisym;
  22.114 -val Max_leD = n_le_Max RSN (2,order_antisym);
  22.115 -
  22.116 -val linorder_leI = linorder_not_less RS iffD1;
  22.117 -
  22.118 -AddSDs [le_MinD, linorder_leI RS le_MinD,
  22.119 -	Max_leD, linorder_leI RS Max_leD];
  22.120 -
  22.121 -(*lem_lift_2_0 
  22.122 -  NOT an ensures property, but a mere inclusion;
  22.123 -  don't know why script lift_2.uni says ENSURES*)
  22.124 -Goal "Lift : (Req n Int closed - (atFloor n - queueing))   \
  22.125 -\            LeadsTo ((closed Int goingup Int Req n)  Un \
  22.126 -\                     (closed Int goingdown Int Req n))";
  22.127 -by (auto_tac (claset() addSIs [subset_imp_LeadsTo] addSEs [int_neqE], 
  22.128 -		       simpset()));
  22.129 -qed "E_thm05c";
  22.130 -
  22.131 -(*lift_2*)
  22.132 -Goal "Lift : (Req n Int closed - (atFloor n - queueing))   \
  22.133 -\            LeadsTo (moving Int Req n)";
  22.134 -by (rtac ([E_thm05c, LeadsTo_Un] MRS LeadsTo_Trans) 1);
  22.135 -by (ensures_tac "req_down" 2);
  22.136 -by (ensures_tac "req_up" 1);
  22.137 -by Auto_tac;
  22.138 -qed "lift_2";
  22.139 -
  22.140 -
  22.141 -(** Towards lift_4 ***)
  22.142 - 
  22.143 -val metric_ss = simpset() addsplits [split_if_asm] 
  22.144 -                          addsimps  [metric_def, vimage_def];
  22.145 -
  22.146 -
  22.147 -(*lem_lift_4_1 *)
  22.148 -Goal "#0 < N ==> \
  22.149 -\     Lift : (moving Int Req n Int {s. metric n s = N} Int \
  22.150 -\             {s. floor s ~: req s} Int {s. up s})   \
  22.151 -\            LeadsTo \
  22.152 -\              (moving Int Req n Int {s. metric n s < N})";
  22.153 -by (cut_facts_tac [moving_up] 1);
  22.154 -by (ensures_tac "move_up" 1);
  22.155 -by Safe_tac;
  22.156 -(*this step consolidates two formulae to the goal  metric n s' <= metric n s*)
  22.157 -by (etac (linorder_leI RS order_antisym RS sym) 1);
  22.158 -by (auto_tac (claset(), metric_ss));
  22.159 -qed "E_thm12a";
  22.160 -
  22.161 -
  22.162 -(*lem_lift_4_3 *)
  22.163 -Goal "#0 < N ==> \
  22.164 -\     Lift : (moving Int Req n Int {s. metric n s = N} Int \
  22.165 -\             {s. floor s ~: req s} - {s. up s})   \
  22.166 -\            LeadsTo (moving Int Req n Int {s. metric n s < N})";
  22.167 -by (cut_facts_tac [moving_down] 1);
  22.168 -by (ensures_tac "move_down" 1);
  22.169 -by Safe_tac;
  22.170 -(*this step consolidates two formulae to the goal  metric n s' <= metric n s*)
  22.171 -by (etac (linorder_leI RS order_antisym RS sym) 1);
  22.172 -by (auto_tac (claset(), metric_ss));
  22.173 -qed "E_thm12b";
  22.174 -
  22.175 -(*lift_4*)
  22.176 -Goal "#0<N ==> Lift : (moving Int Req n Int {s. metric n s = N} Int \
  22.177 -\                           {s. floor s ~: req s}) LeadsTo     \
  22.178 -\                          (moving Int Req n Int {s. metric n s < N})";
  22.179 -by (rtac ([subset_imp_LeadsTo, [E_thm12a, E_thm12b] MRS LeadsTo_Un] 
  22.180 -	  MRS LeadsTo_Trans) 1);
  22.181 -by Auto_tac;
  22.182 -qed "lift_4";
  22.183 -
  22.184 -
  22.185 -(** towards lift_5 **)
  22.186 -
  22.187 -(*lem_lift_5_3*)
  22.188 -Goal "#0<N   \
  22.189 -\ ==> Lift : (closed Int Req n Int {s. metric n s = N} Int goingup) LeadsTo \
  22.190 -\            (moving Int Req n Int {s. metric n s < N})";
  22.191 -by (cut_facts_tac [bounded] 1);
  22.192 -by (ensures_tac "req_up" 1);
  22.193 -by (auto_tac (claset(), metric_ss));
  22.194 -qed "E_thm16a";
  22.195 -
  22.196 -
  22.197 -(*lem_lift_5_1 has ~goingup instead of goingdown*)
  22.198 -Goal "#0<N ==>   \
  22.199 -\     Lift : (closed Int Req n Int {s. metric n s = N} Int goingdown) LeadsTo \
  22.200 -\                  (moving Int Req n Int {s. metric n s < N})";
  22.201 -by (cut_facts_tac [bounded] 1);
  22.202 -by (ensures_tac "req_down" 1);
  22.203 -by (auto_tac (claset(), metric_ss));
  22.204 -qed "E_thm16b";
  22.205 -
  22.206 -
  22.207 -(*lem_lift_5_0 proves an intersection involving ~goingup and goingup,
  22.208 -  i.e. the trivial disjunction, leading to an asymmetrical proof.*)
  22.209 -Goal "#0<N ==> Req n Int {s. metric n s = N} <= goingup Un goingdown";
  22.210 -by (Clarify_tac 1);
  22.211 -by (auto_tac (claset(), metric_ss));
  22.212 -qed "E_thm16c";
  22.213 -
  22.214 -
  22.215 -(*lift_5*)
  22.216 -Goal "#0<N ==> Lift : (closed Int Req n Int {s. metric n s = N}) LeadsTo   \
  22.217 -\                          (moving Int Req n Int {s. metric n s < N})";
  22.218 -by (rtac ([subset_imp_LeadsTo, [E_thm16a, E_thm16b] MRS LeadsTo_Un] 
  22.219 -	  MRS LeadsTo_Trans) 1);
  22.220 -by (dtac E_thm16c 1);
  22.221 -by Auto_tac;
  22.222 -qed "lift_5";
  22.223 -
  22.224 -
  22.225 -(** towards lift_3 **)
  22.226 -
  22.227 -(*lemma used to prove lem_lift_3_1*)
  22.228 -Goal "[| metric n s = #0;  Min <= floor s;  floor s <= Max |] ==> floor s = n";
  22.229 -by (auto_tac (claset(), metric_ss));
  22.230 -qed "metric_eq_0D";
  22.231 -
  22.232 -AddDs [metric_eq_0D];
  22.233 -
  22.234 -
  22.235 -(*lem_lift_3_1*)
  22.236 -Goal "Lift : (moving Int Req n Int {s. metric n s = #0}) LeadsTo   \
  22.237 -\                  (stopped Int atFloor n)";
  22.238 -by (cut_facts_tac [bounded] 1);
  22.239 -by (ensures_tac "request_act" 1);
  22.240 -by Auto_tac;
  22.241 -qed "E_thm11";
  22.242 -
  22.243 -(*lem_lift_3_5*)
  22.244 -Goal
  22.245 -  "Lift : (moving Int Req n Int {s. metric n s = N} Int {s. floor s : req s}) \
  22.246 -\ LeadsTo (stopped Int Req n Int {s. metric n s = N} Int {s. floor s : req s})";
  22.247 -by (ensures_tac "request_act" 1);
  22.248 -by (auto_tac (claset(), metric_ss));
  22.249 -qed "E_thm13";
  22.250 -
  22.251 -(*lem_lift_3_6*)
  22.252 -Goal "#0 < N ==> \
  22.253 -\     Lift : \
  22.254 -\       (stopped Int Req n Int {s. metric n s = N} Int {s. floor s : req s}) \
  22.255 -\       LeadsTo (opened Int Req n Int {s. metric n s = N})";
  22.256 -by (ensures_tac "open_act" 1);
  22.257 -by (auto_tac (claset(), metric_ss));
  22.258 -qed "E_thm14";
  22.259 -
  22.260 -(*lem_lift_3_7*)
  22.261 -Goal "Lift : (opened Int Req n Int {s. metric n s = N})  \
  22.262 -\            LeadsTo (closed Int Req n Int {s. metric n s = N})";
  22.263 -by (ensures_tac "close_act" 1);
  22.264 -by (auto_tac (claset(), metric_ss));
  22.265 -qed "E_thm15";
  22.266 -
  22.267 -
  22.268 -(** the final steps **)
  22.269 -
  22.270 -Goal "#0 < N ==> \
  22.271 -\     Lift : \
  22.272 -\       (moving Int Req n Int {s. metric n s = N} Int {s. floor s : req s})   \
  22.273 -\       LeadsTo (moving Int Req n Int {s. metric n s < N})";
  22.274 -by (blast_tac (claset() addSIs [E_thm13, E_thm14, E_thm15, lift_5]
  22.275 -	                addIs [LeadsTo_Trans]) 1);
  22.276 -qed "lift_3_Req";
  22.277 -
  22.278 -
  22.279 -(*Now we observe that our integer metric is really a natural number*)
  22.280 -Goal "Lift : Always {s. #0 <= metric n s}";
  22.281 -by (rtac (bounded RS Always_weaken) 1);
  22.282 -by (auto_tac (claset(), metric_ss));
  22.283 -qed "Always_nonneg";
  22.284 -
  22.285 -val R_thm11 = [Always_nonneg, E_thm11] MRS Always_LeadsTo_weaken;
  22.286 -
  22.287 -Goal "Lift : (moving Int Req n) LeadsTo (stopped Int atFloor n)";
  22.288 -by (rtac (Always_nonneg RS integ_0_le_induct) 1);
  22.289 -by (case_tac "#0 < z" 1);
  22.290 -(*If z <= #0 then actually z = #0*)
  22.291 -by (force_tac (claset() addIs [R_thm11, order_antisym], 
  22.292 -	       simpset() addsimps [linorder_not_less]) 2);
  22.293 -by (rtac ([asm_rl, Un_upper1] MRS LeadsTo_weaken_R) 1);
  22.294 -by (rtac ([subset_imp_LeadsTo, [lift_4, lift_3_Req] MRS LeadsTo_Un] 
  22.295 -	  MRS LeadsTo_Trans) 1);
  22.296 -by Auto_tac;
  22.297 -qed "lift_3";
  22.298 -
  22.299 -
  22.300 -val LeadsTo_Trans_Un' = rotate_prems 1 LeadsTo_Trans_Un;
  22.301 -(* [| Lift: B LeadsTo C; Lift: A LeadsTo B |] ==> Lift: (A Un B) LeadsTo C *)
  22.302 -
  22.303 -Goal "Lift : (Req n) LeadsTo (opened Int atFloor n)";
  22.304 -by (rtac LeadsTo_Trans 1);
  22.305 -by (rtac ([E_thm04, LeadsTo_Un_post] MRS LeadsTo_Un) 2);
  22.306 -by (rtac (E_thm01 RS LeadsTo_Trans_Un') 2);
  22.307 -by (rtac (lift_3 RS LeadsTo_Trans_Un') 2);
  22.308 -by (rtac (lift_2 RS LeadsTo_Trans_Un') 2);
  22.309 -by (rtac ([E_thm03,E_thm02] MRS LeadsTo_Trans_Un') 2);
  22.310 -by (rtac (open_move RS Always_LeadsToI) 1);
  22.311 -by (rtac ([open_stop, subset_imp_LeadsTo] MRS Always_LeadsToI) 1);
  22.312 -by (Clarify_tac 1);
  22.313 -(*The case split is not essential but makes Blast_tac much faster.
  22.314 -  Calling rotate_tac prevents simplification from looping*)
  22.315 -by (case_tac "open x" 1);
  22.316 -by (ALLGOALS (rotate_tac ~1));
  22.317 -by Auto_tac;
  22.318 -qed "lift_1";
  22.319 -
  22.320 -Close_locale "floor";
    23.1 --- a/src/HOL/UNITY/Lift.thy	Mon Mar 05 12:31:31 2001 +0100
    23.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.3 @@ -1,169 +0,0 @@
    23.4 -(*  Title:      HOL/UNITY/Lift.thy
    23.5 -    ID:         $Id$
    23.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    23.7 -    Copyright   1998  University of Cambridge
    23.8 -
    23.9 -The Lift-Control Example
   23.10 -*)
   23.11 -
   23.12 -Lift = SubstAx +
   23.13 -
   23.14 -record state =
   23.15 -  floor :: int		(*current position of the lift*)
   23.16 -  open  :: bool		(*whether the door is open at floor*)
   23.17 -  stop  :: bool		(*whether the lift is stopped at floor*)
   23.18 -  req   :: int set	(*for each floor, whether the lift is requested*)
   23.19 -  up    :: bool		(*current direction of movement*)
   23.20 -  move  :: bool		(*whether moving takes precedence over opening*)
   23.21 -
   23.22 -consts
   23.23 -  Min, Max :: int       (*least and greatest floors*)
   23.24 -
   23.25 -rules
   23.26 -  Min_le_Max  "Min <= Max"
   23.27 -  
   23.28 -constdefs
   23.29 -  
   23.30 -  (** Abbreviations: the "always" part **)
   23.31 -  
   23.32 -  above :: state set
   23.33 -    "above == {s. EX i. floor s < i & i <= Max & i : req s}"
   23.34 -
   23.35 -  below :: state set
   23.36 -    "below == {s. EX i. Min <= i & i < floor s & i : req s}"
   23.37 -
   23.38 -  queueing :: state set
   23.39 -    "queueing == above Un below"
   23.40 -
   23.41 -  goingup :: state set
   23.42 -    "goingup   == above Int  ({s. up s}  Un -below)"
   23.43 -
   23.44 -  goingdown :: state set
   23.45 -    "goingdown == below Int ({s. ~ up s} Un -above)"
   23.46 -
   23.47 -  ready :: state set
   23.48 -    "ready == {s. stop s & ~ open s & move s}"
   23.49 -
   23.50 - 
   23.51 -  (** Further abbreviations **)
   23.52 -
   23.53 -  moving :: state set
   23.54 -    "moving ==  {s. ~ stop s & ~ open s}"
   23.55 -
   23.56 -  stopped :: state set
   23.57 -    "stopped == {s. stop s  & ~ open s & ~ move s}"
   23.58 -
   23.59 -  opened :: state set
   23.60 -    "opened ==  {s. stop s  &  open s  &  move s}"
   23.61 -
   23.62 -  closed :: state set  (*but this is the same as ready!!*)
   23.63 -    "closed ==  {s. stop s  & ~ open s &  move s}"
   23.64 -
   23.65 -  atFloor :: int => state set
   23.66 -    "atFloor n ==  {s. floor s = n}"
   23.67 -
   23.68 -  Req :: int => state set
   23.69 -    "Req n ==  {s. n : req s}"
   23.70 -
   23.71 -
   23.72 -  
   23.73 -  (** The program **)
   23.74 -  
   23.75 -  request_act :: "(state*state) set"
   23.76 -    "request_act == {(s,s'). s' = s (|stop:=True, move:=False|)
   23.77 -		                  & ~ stop s & floor s : req s}"
   23.78 -
   23.79 -  open_act :: "(state*state) set"
   23.80 -    "open_act ==
   23.81 -         {(s,s'). s' = s (|open :=True,
   23.82 -			   req  := req s - {floor s},
   23.83 -			   move := True|)
   23.84 -		       & stop s & ~ open s & floor s : req s
   23.85 -	               & ~(move s & s: queueing)}"
   23.86 -
   23.87 -  close_act :: "(state*state) set"
   23.88 -    "close_act == {(s,s'). s' = s (|open := False|) & open s}"
   23.89 -
   23.90 -  req_up :: "(state*state) set"
   23.91 -    "req_up ==
   23.92 -         {(s,s'). s' = s (|stop  :=False,
   23.93 -			   floor := floor s + #1,
   23.94 -			   up    := True|)
   23.95 -		       & s : (ready Int goingup)}"
   23.96 -
   23.97 -  req_down :: "(state*state) set"
   23.98 -    "req_down ==
   23.99 -         {(s,s'). s' = s (|stop  :=False,
  23.100 -			   floor := floor s - #1,
  23.101 -			   up    := False|)
  23.102 -		       & s : (ready Int goingdown)}"
  23.103 -
  23.104 -  move_up :: "(state*state) set"
  23.105 -    "move_up ==
  23.106 -         {(s,s'). s' = s (|floor := floor s + #1|)
  23.107 -		       & ~ stop s & up s & floor s ~: req s}"
  23.108 -
  23.109 -  move_down :: "(state*state) set"
  23.110 -    "move_down ==
  23.111 -         {(s,s'). s' = s (|floor := floor s - #1|)
  23.112 -		       & ~ stop s & ~ up s & floor s ~: req s}"
  23.113 -
  23.114 -  (*This action is omitted from prior treatments, which therefore are
  23.115 -    unrealistic: nobody asks the lift to do anything!  But adding this
  23.116 -    action invalidates many of the existing progress arguments: various
  23.117 -    "ensures" properties fail.*)
  23.118 -  button_press  :: "(state*state) set"
  23.119 -    "button_press ==
  23.120 -         {(s,s'). EX n. s' = s (|req := insert n (req s)|)
  23.121 -		        & Min <= n & n <= Max}"
  23.122 -
  23.123 -
  23.124 -  Lift :: state program
  23.125 -    (*for the moment, we OMIT button_press*)
  23.126 -    "Lift == mk_program ({s. floor s = Min & ~ up s & move s & stop s &
  23.127 -		          ~ open s & req s = {}},
  23.128 -			 {request_act, open_act, close_act,
  23.129 -			  req_up, req_down, move_up, move_down},
  23.130 -			 UNIV)"
  23.131 -
  23.132 -
  23.133 -  (** Invariants **)
  23.134 -
  23.135 -  bounded :: state set
  23.136 -    "bounded == {s. Min <= floor s & floor s <= Max}"
  23.137 -
  23.138 -  open_stop :: state set
  23.139 -    "open_stop == {s. open s --> stop s}"
  23.140 -  
  23.141 -  open_move :: state set
  23.142 -    "open_move == {s. open s --> move s}"
  23.143 -  
  23.144 -  stop_floor :: state set
  23.145 -    "stop_floor == {s. stop s & ~ move s --> floor s : req s}"
  23.146 -  
  23.147 -  moving_up :: state set
  23.148 -    "moving_up == {s. ~ stop s & up s -->
  23.149 -                   (EX f. floor s <= f & f <= Max & f : req s)}"
  23.150 -  
  23.151 -  moving_down :: state set
  23.152 -    "moving_down == {s. ~ stop s & ~ up s -->
  23.153 -                     (EX f. Min <= f & f <= floor s & f : req s)}"
  23.154 -  
  23.155 -  metric :: [int,state] => int
  23.156 -    "metric ==
  23.157 -       %n s. if floor s < n then (if up s then n - floor s
  23.158 -			          else (floor s - Min) + (n-Min))
  23.159 -             else
  23.160 -             if n < floor s then (if up s then (Max - floor s) + (Max-n)
  23.161 -		                  else floor s - n)
  23.162 -             else #0"
  23.163 -
  23.164 -locale floor =
  23.165 -  fixes 
  23.166 -    n	:: int
  23.167 -  assumes
  23.168 -    Min_le_n    "Min <= n"
  23.169 -    n_le_Max    "n <= Max"
  23.170 -  defines
  23.171 -
  23.172 -end
    24.1 --- a/src/HOL/UNITY/Mutex.ML	Mon Mar 05 12:31:31 2001 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,166 +0,0 @@
    24.4 -(*  Title:      HOL/UNITY/Mutex
    24.5 -    ID:         $Id$
    24.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    24.7 -    Copyright   1998  University of Cambridge
    24.8 -
    24.9 -Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
   24.10 -*)
   24.11 -
   24.12 -Addsimps [Mutex_def RS def_prg_Init];
   24.13 -program_defs_ref := [Mutex_def];
   24.14 -
   24.15 -Addsimps (map simp_of_act
   24.16 -	  [U0_def, U1_def, U2_def, U3_def, U4_def, 
   24.17 -	   V0_def, V1_def, V2_def, V3_def, V4_def]);
   24.18 -
   24.19 -Addsimps (map simp_of_set [IU_def, IV_def, bad_IU_def]);
   24.20 -
   24.21 -
   24.22 -Goal "Mutex : Always IU";
   24.23 -by (always_tac 1);
   24.24 -qed "IU";
   24.25 -
   24.26 -Goal "Mutex : Always IV";
   24.27 -by (always_tac 1);
   24.28 -qed "IV";
   24.29 -
   24.30 -(*The safety property: mutual exclusion*)
   24.31 -Goal "Mutex : Always {s. ~ (m s = #3 & n s = #3)}";
   24.32 -by (rtac ([IU, IV] MRS Always_Int_I RS Always_weaken) 1);
   24.33 -by Auto_tac;
   24.34 -qed "mutual_exclusion";
   24.35 -
   24.36 -
   24.37 -(*The bad invariant FAILS in V1*)
   24.38 -Goal "Mutex : Always bad_IU";
   24.39 -by (always_tac 1);
   24.40 -by Auto_tac;
   24.41 -(*Resulting state: n=1, p=false, m=4, u=false.  
   24.42 -  Execution of V1 (the command of process v guarded by n=1) sets p:=true,
   24.43 -  violating the invariant!*)
   24.44 -(*Check that subgoals remain: proof failed.*)
   24.45 -getgoal 1;  
   24.46 -
   24.47 -
   24.48 -Goal "((#1::int) <= i & i <= #3) = (i = #1 | i = #2 | i = #3)";
   24.49 -by (arith_tac 1);
   24.50 -qed "eq_123";
   24.51 -
   24.52 -
   24.53 -(*** Progress for U ***)
   24.54 -
   24.55 -Goalw [Unless_def] "Mutex : {s. m s=#2} Unless {s. m s=#3}";
   24.56 -by (constrains_tac 1);
   24.57 -qed "U_F0";
   24.58 -
   24.59 -Goal "Mutex : {s. m s=#1} LeadsTo {s. p s = v s & m s = #2}";
   24.60 -by (ensures_tac "U1" 1);
   24.61 -qed "U_F1";
   24.62 -
   24.63 -Goal "Mutex : {s. ~ p s & m s = #2} LeadsTo {s. m s = #3}";
   24.64 -by (cut_facts_tac [IU] 1);
   24.65 -by (ensures_tac "U2" 1);
   24.66 -qed "U_F2";
   24.67 -
   24.68 -Goal "Mutex : {s. m s = #3} LeadsTo {s. p s}";
   24.69 -by (res_inst_tac [("B", "{s. m s = #4}")] LeadsTo_Trans 1);
   24.70 -by (ensures_tac "U4" 2);
   24.71 -by (ensures_tac "U3" 1);
   24.72 -qed "U_F3";
   24.73 -
   24.74 -Goal "Mutex : {s. m s = #2} LeadsTo {s. p s}";
   24.75 -by (rtac ([LeadsTo_weaken_L, Int_lower2 RS subset_imp_LeadsTo] 
   24.76 -	  MRS LeadsTo_Diff) 1);
   24.77 -by (rtac ([U_F2, U_F3] MRS LeadsTo_Trans) 1);
   24.78 -by (auto_tac (claset() addSEs [less_SucE], simpset()));
   24.79 -val U_lemma2 = result();
   24.80 -
   24.81 -Goal "Mutex : {s. m s = #1} LeadsTo {s. p s}";
   24.82 -by (rtac ([U_F1 RS LeadsTo_weaken_R, U_lemma2] MRS LeadsTo_Trans) 1);
   24.83 -by (Blast_tac 1);
   24.84 -val U_lemma1 = result();
   24.85 -
   24.86 -Goal "Mutex : {s. #1 <= m s & m s <= #3} LeadsTo {s. p s}";
   24.87 -by (simp_tac (simpset() addsimps [eq_123, Collect_disj_eq, LeadsTo_Un_distrib,
   24.88 -				  U_lemma1, U_lemma2, U_F3] ) 1);
   24.89 -val U_lemma123 = result();
   24.90 -
   24.91 -(*Misra's F4*)
   24.92 -Goal "Mutex : {s. u s} LeadsTo {s. p s}";
   24.93 -by (rtac ([IU, U_lemma123] MRS Always_LeadsTo_weaken) 1);
   24.94 -by Auto_tac;
   24.95 -qed "u_Leadsto_p";
   24.96 -
   24.97 -
   24.98 -(*** Progress for V ***)
   24.99 -
  24.100 -
  24.101 -Goalw [Unless_def] "Mutex : {s. n s=#2} Unless {s. n s=#3}";
  24.102 -by (constrains_tac 1);
  24.103 -qed "V_F0";
  24.104 -
  24.105 -Goal "Mutex : {s. n s=#1} LeadsTo {s. p s = (~ u s) & n s = #2}";
  24.106 -by (ensures_tac "V1" 1);
  24.107 -qed "V_F1";
  24.108 -
  24.109 -Goal "Mutex : {s. p s & n s = #2} LeadsTo {s. n s = #3}";
  24.110 -by (cut_facts_tac [IV] 1);
  24.111 -by (ensures_tac "V2" 1);
  24.112 -qed "V_F2";
  24.113 -
  24.114 -Goal "Mutex : {s. n s = #3} LeadsTo {s. ~ p s}";
  24.115 -by (res_inst_tac [("B", "{s. n s = #4}")] LeadsTo_Trans 1);
  24.116 -by (ensures_tac "V4" 2);
  24.117 -by (ensures_tac "V3" 1);
  24.118 -qed "V_F3";
  24.119 -
  24.120 -Goal "Mutex : {s. n s = #2} LeadsTo {s. ~ p s}";
  24.121 -by (rtac ([LeadsTo_weaken_L, Int_lower2 RS subset_imp_LeadsTo] 
  24.122 -	  MRS LeadsTo_Diff) 1);
  24.123 -by (rtac ([V_F2, V_F3] MRS LeadsTo_Trans) 1);
  24.124 -by (auto_tac (claset() addSEs [less_SucE], simpset()));
  24.125 -val V_lemma2 = result();
  24.126 -
  24.127 -Goal "Mutex : {s. n s = #1} LeadsTo {s. ~ p s}";
  24.128 -by (rtac ([V_F1 RS LeadsTo_weaken_R, V_lemma2] MRS LeadsTo_Trans) 1);
  24.129 -by (Blast_tac 1);
  24.130 -val V_lemma1 = result();
  24.131 -
  24.132 -Goal "Mutex : {s. #1 <= n s & n s <= #3} LeadsTo {s. ~ p s}";
  24.133 -by (simp_tac (simpset() addsimps [eq_123, Collect_disj_eq, LeadsTo_Un_distrib,
  24.134 -				  V_lemma1, V_lemma2, V_F3] ) 1);
  24.135 -val V_lemma123 = result();
  24.136 -
  24.137 -
  24.138 -(*Misra's F4*)
  24.139 -Goal "Mutex : {s. v s} LeadsTo {s. ~ p s}";
  24.140 -by (rtac ([IV, V_lemma123] MRS Always_LeadsTo_weaken) 1);
  24.141 -by Auto_tac;
  24.142 -qed "v_Leadsto_not_p";
  24.143 -
  24.144 -
  24.145 -(** Absence of starvation **)
  24.146 -
  24.147 -(*Misra's F6*)
  24.148 -Goal "Mutex : {s. m s = #1} LeadsTo {s. m s = #3}";
  24.149 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
  24.150 -by (rtac U_F2 2);
  24.151 -by (simp_tac (simpset() addsimps [Collect_conj_eq] ) 1);
  24.152 -by (stac Un_commute 1);
  24.153 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
  24.154 -by (rtac ([v_Leadsto_not_p, U_F0] MRS PSP_Unless) 2);
  24.155 -by (rtac (U_F1 RS LeadsTo_weaken_R) 1);
  24.156 -by Auto_tac;
  24.157 -qed "m1_Leadsto_3";
  24.158 -
  24.159 -(*The same for V*)
  24.160 -Goal "Mutex : {s. n s = #1} LeadsTo {s. n s = #3}";
  24.161 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
  24.162 -by (rtac V_F2 2);
  24.163 -by (simp_tac (simpset() addsimps [Collect_conj_eq] ) 1);
  24.164 -by (stac Un_commute 1);
  24.165 -by (rtac (LeadsTo_cancel2 RS LeadsTo_Un_duplicate) 1);
  24.166 -by (rtac ([u_Leadsto_p, V_F0] MRS PSP_Unless) 2);
  24.167 -by (rtac (V_F1 RS LeadsTo_weaken_R) 1);
  24.168 -by Auto_tac;
  24.169 -qed "n1_Leadsto_3";
    25.1 --- a/src/HOL/UNITY/Mutex.thy	Mon Mar 05 12:31:31 2001 +0100
    25.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.3 @@ -1,76 +0,0 @@
    25.4 -(*  Title:      HOL/UNITY/Mutex.thy
    25.5 -    ID:         $Id$
    25.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    25.7 -    Copyright   1998  University of Cambridge
    25.8 -
    25.9 -Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
   25.10 -*)
   25.11 -
   25.12 -Mutex = SubstAx +
   25.13 -
   25.14 -record state =
   25.15 -  p :: bool
   25.16 -  m :: int
   25.17 -  n :: int
   25.18 -  u :: bool
   25.19 -  v :: bool
   25.20 -
   25.21 -types command = "(state*state) set"
   25.22 -
   25.23 -constdefs
   25.24 -  
   25.25 -  (** The program for process U **)
   25.26 -  
   25.27 -  U0 :: command
   25.28 -    "U0 == {(s,s'). s' = s (|u:=True, m:=#1|) & m s = #0}"
   25.29 -
   25.30 -  U1 :: command
   25.31 -    "U1 == {(s,s'). s' = s (|p:= v s, m:=#2|) & m s = #1}"
   25.32 -
   25.33 -  U2 :: command
   25.34 -    "U2 == {(s,s'). s' = s (|m:=#3|) & ~ p s & m s = #2}"
   25.35 -
   25.36 -  U3 :: command
   25.37 -    "U3 == {(s,s'). s' = s (|u:=False, m:=#4|) & m s = #3}"
   25.38 -
   25.39 -  U4 :: command
   25.40 -    "U4 == {(s,s'). s' = s (|p:=True, m:=#0|) & m s = #4}"
   25.41 -
   25.42 -  (** The program for process V **)
   25.43 -  
   25.44 -  V0 :: command
   25.45 -    "V0 == {(s,s'). s' = s (|v:=True, n:=#1|) & n s = #0}"
   25.46 -
   25.47 -  V1 :: command
   25.48 -    "V1 == {(s,s'). s' = s (|p:= ~ u s, n:=#2|) & n s = #1}"
   25.49 -
   25.50 -  V2 :: command
   25.51 -    "V2 == {(s,s'). s' = s (|n:=#3|) & p s & n s = #2}"
   25.52 -
   25.53 -  V3 :: command
   25.54 -    "V3 == {(s,s'). s' = s (|v:=False, n:=#4|) & n s = #3}"
   25.55 -
   25.56 -  V4 :: command
   25.57 -    "V4 == {(s,s'). s' = s (|p:=False, n:=#0|) & n s = #4}"
   25.58 -
   25.59 -  Mutex :: state program
   25.60 -    "Mutex == mk_program ({s. ~ u s & ~ v s & m s = #0 & n s = #0},
   25.61 -		 	  {U0, U1, U2, U3, U4, V0, V1, V2, V3, V4},
   25.62 -			  UNIV)"
   25.63 -
   25.64 -
   25.65 -  (** The correct invariants **)
   25.66 -
   25.67 -  IU :: state set
   25.68 -    "IU == {s. (u s = (#1 <= m s & m s <= #3)) & (m s = #3 --> ~ p s)}"
   25.69 -
   25.70 -  IV :: state set
   25.71 -    "IV == {s. (v s = (#1 <= n s & n s <= #3)) & (n s = #3 --> p s)}"
   25.72 -
   25.73 -  (** The faulty invariant (for U alone) **)
   25.74 -
   25.75 -  bad_IU :: state set
   25.76 -    "bad_IU == {s. (u s = (#1 <= m s & m s <= #3)) &
   25.77 -	           (#3 <= m s & m s <= #4 --> ~ p s)}"
   25.78 -
   25.79 -end
    26.1 --- a/src/HOL/UNITY/NSP_Bad.ML	Mon Mar 05 12:31:31 2001 +0100
    26.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.3 @@ -1,288 +0,0 @@
    26.4 -(*  Title:      HOL/Auth/NSP_Bad
    26.5 -    ID:         $Id$
    26.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    26.7 -    Copyright   1996  University of Cambridge
    26.8 -
    26.9 -Inductive relation "ns_public" for the Needham-Schroeder Public-Key protocol.
   26.10 -Flawed version, vulnerable to Lowe's attack.
   26.11 -
   26.12 -From page 260 of
   26.13 -  Burrows, Abadi and Needham.  A Logic of Authentication.
   26.14 -  Proc. Royal Soc. 426 (1989)
   26.15 -*)
   26.16 -
   26.17 -fun impOfAlways th =
   26.18 -  rulify (th RS Always_includes_reachable RS subsetD RS CollectD);
   26.19 -
   26.20 -AddEs spies_partsEs;
   26.21 -AddDs [impOfSubs analz_subset_parts];
   26.22 -AddDs [impOfSubs Fake_parts_insert];
   26.23 -
   26.24 -(*For other theories, e.g. Mutex and Lift, using AddIffs slows proofs down.
   26.25 -  Here, it facilitates re-use of the Auth proofs.*)
   26.26 -
   26.27 -AddIffs (map simp_of_act [Fake_def, NS1_def, NS2_def, NS3_def]);
   26.28 -
   26.29 -Addsimps [Nprg_def RS def_prg_simps];
   26.30 -
   26.31 -
   26.32 -(*A "possibility property": there are traces that reach the end.
   26.33 -  Replace by LEADSTO proof!*)
   26.34 -Goal "A ~= B ==> EX NB. EX s: reachable Nprg.                \
   26.35 -\                  Says A B (Crypt (pubK B) (Nonce NB)) : set s";
   26.36 -by (REPEAT (resolve_tac [exI,bexI] 1));
   26.37 -by (res_inst_tac [("act", "NS3")] reachable.Acts 2);
   26.38 -by (res_inst_tac [("act", "NS2")] reachable.Acts 3);
   26.39 -by (res_inst_tac [("act", "NS1")] reachable.Acts 4);
   26.40 -by (rtac reachable.Init 5);
   26.41 -by (ALLGOALS (asm_simp_tac (simpset() addsimps [Nprg_def])));
   26.42 -by (REPEAT_FIRST (rtac exI ));
   26.43 -by possibility_tac;
   26.44 -result();
   26.45 -
   26.46 -
   26.47 -(**** Inductive proofs about ns_public ****)
   26.48 -
   26.49 -(*can be used to simulate analz_mono_contra_tac
   26.50 -val analz_impI = read_instantiate_sg (sign_of thy)
   26.51 -                [("P", "?Y ~: analz (spies ?evs)")] impI;
   26.52 -
   26.53 -val spies_Says_analz_contraD = 
   26.54 -    spies_subset_spies_Says RS analz_mono RS contra_subsetD;
   26.55 -
   26.56 -by (rtac analz_impI 2);
   26.57 -by (auto_tac (claset() addSDs [spies_Says_analz_contraD], simpset()));
   26.58 -*)
   26.59 -
   26.60 -fun ns_constrains_tac i = 
   26.61 -   SELECT_GOAL
   26.62 -      (EVERY [REPEAT (etac Always_ConstrainsI 1),
   26.63 -	      REPEAT (resolve_tac [StableI, stableI,
   26.64 -				   constrains_imp_Constrains] 1),
   26.65 -	      rtac constrainsI 1,
   26.66 -	      Full_simp_tac 1,
   26.67 -	      REPEAT (FIRSTGOAL (etac disjE)),
   26.68 -	      ALLGOALS (clarify_tac (claset() delrules [impI,impCE])),
   26.69 -	      REPEAT (FIRSTGOAL analz_mono_contra_tac),
   26.70 -	      ALLGOALS Asm_simp_tac]) i;
   26.71 -
   26.72 -(*Tactic for proving secrecy theorems*)
   26.73 -val ns_induct_tac = 
   26.74 -  (SELECT_GOAL o EVERY)
   26.75 -     [rtac AlwaysI 1,
   26.76 -      Force_tac 1,
   26.77 -      (*"reachable" gets in here*)
   26.78 -      rtac (Always_reachable RS Always_ConstrainsI RS StableI) 1,
   26.79 -      ns_constrains_tac 1];
   26.80 -
   26.81 -
   26.82 -(** Theorems of the form X ~: parts (spies evs) imply that NOBODY
   26.83 -    sends messages containing X! **)
   26.84 -
   26.85 -(*Spy never sees another agent's private key! (unless it's bad at start)*)
   26.86 -Goal "Nprg : Always {s. (Key (priK A) : parts (spies s)) = (A : bad)}";
   26.87 -by (ns_induct_tac 1);
   26.88 -by (Blast_tac 1);
   26.89 -qed "Spy_see_priK";
   26.90 -Addsimps [impOfAlways Spy_see_priK];
   26.91 -
   26.92 -Goal "Nprg : Always {s. (Key (priK A) : analz (spies s)) = (A : bad)}";
   26.93 -by (rtac (Always_reachable RS Always_weaken) 1);
   26.94 -by Auto_tac;
   26.95 -qed "Spy_analz_priK";
   26.96 -Addsimps [impOfAlways Spy_analz_priK];
   26.97 -
   26.98 -(**
   26.99 -AddSDs [Spy_see_priK RSN (2, rev_iffD1), 
  26.100 -	Spy_analz_priK RSN (2, rev_iffD1)];
  26.101 -**)
  26.102 -
  26.103 -
  26.104 -(**** Authenticity properties obtained from NS2 ****)
  26.105 -
  26.106 -(*It is impossible to re-use a nonce in both NS1 and NS2, provided the nonce
  26.107 -  is secret.  (Honest users generate fresh nonces.)*)
  26.108 -Goal
  26.109 - "Nprg \
  26.110 -\  : Always {s. Nonce NA ~: analz (spies s) -->  \
  26.111 -\               Crypt (pubK B) {|Nonce NA, Agent A|} : parts (spies s) --> \
  26.112 -\               Crypt (pubK C) {|NA', Nonce NA|} ~: parts (spies s)}";
  26.113 -by (ns_induct_tac 1);
  26.114 -by (ALLGOALS Blast_tac);
  26.115 -qed "no_nonce_NS1_NS2";
  26.116 -
  26.117 -(*Adding it to the claset slows down proofs...*)
  26.118 -val nonce_NS1_NS2_E = impOfAlways no_nonce_NS1_NS2 RSN (2, rev_notE);
  26.119 -
  26.120 -
  26.121 -(*Unicity for NS1: nonce NA identifies agents A and B*)
  26.122 -Goal "Nprg \
  26.123 -\  : Always {s. Nonce NA ~: analz (spies s) --> \
  26.124 -\               Crypt(pubK B) {|Nonce NA, Agent A|} : parts(spies s) --> \
  26.125 -\               Crypt(pubK B') {|Nonce NA, Agent A'|} : parts(spies s) --> \
  26.126 -\               A=A' & B=B'}";
  26.127 -by (ns_induct_tac 1);
  26.128 -by Auto_tac;  
  26.129 -(*Fake, NS1 are non-trivial*)
  26.130 -val unique_NA_lemma = result();
  26.131 -
  26.132 -(*Unicity for NS1: nonce NA identifies agents A and B*)
  26.133 -Goal "[| Crypt(pubK B)  {|Nonce NA, Agent A|}  : parts(spies s); \
  26.134 -\        Crypt(pubK B') {|Nonce NA, Agent A'|} : parts(spies s); \
  26.135 -\        Nonce NA ~: analz (spies s);                            \
  26.136 -\        s : reachable Nprg |]                                   \
  26.137 -\     ==> A=A' & B=B'";
  26.138 -by (blast_tac (claset() addDs [impOfAlways unique_NA_lemma]) 1); 
  26.139 -qed "unique_NA";
  26.140 -
  26.141 -
  26.142 -(*Secrecy: Spy does not see the nonce sent in msg NS1 if A and B are secure*)
  26.143 -Goal "[| A ~: bad;  B ~: bad |]                     \
  26.144 -\ ==> Nprg : Always \
  26.145 -\             {s. Says A B (Crypt(pubK B) {|Nonce NA, Agent A|}) : set s \
  26.146 -\                 --> Nonce NA ~: analz (spies s)}";
  26.147 -by (ns_induct_tac 1);
  26.148 -(*NS3*)
  26.149 -by (blast_tac (claset() addEs [nonce_NS1_NS2_E]) 4);
  26.150 -(*NS2*)
  26.151 -by (blast_tac (claset() addDs [unique_NA]) 3);
  26.152 -(*NS1*)
  26.153 -by (Blast_tac 2);
  26.154 -(*Fake*)
  26.155 -by (spy_analz_tac 1);
  26.156 -qed "Spy_not_see_NA";
  26.157 -
  26.158 -
  26.159 -(*Authentication for A: if she receives message 2 and has used NA
  26.160 -  to start a run, then B has sent message 2.*)
  26.161 -val prems =
  26.162 -goal thy "[| A ~: bad;  B ~: bad |]                     \
  26.163 -\ ==> Nprg : Always \
  26.164 -\             {s. Says A B (Crypt(pubK B) {|Nonce NA, Agent A|}) : set s &  \
  26.165 -\                 Crypt(pubK A) {|Nonce NA, Nonce NB|} : parts (knows Spy s) \
  26.166 -\        --> Says B A (Crypt(pubK A) {|Nonce NA, Nonce NB|}): set s}";
  26.167 -  (*insert an invariant for use in some of the subgoals*)
  26.168 -by (cut_facts_tac ([prems MRS Spy_not_see_NA] @ prems) 1);
  26.169 -by (ns_induct_tac 1);
  26.170 -by (ALLGOALS Clarify_tac);
  26.171 -(*NS2*)
  26.172 -by (blast_tac (claset() addDs [unique_NA]) 3);
  26.173 -(*NS1*)
  26.174 -by (Blast_tac 2);
  26.175 -(*Fake*)
  26.176 -by (Blast_tac 1);
  26.177 -qed "A_trusts_NS2";
  26.178 -
  26.179 -
  26.180 -(*If the encrypted message appears then it originated with Alice in NS1*)
  26.181 -Goal "Nprg : Always \
  26.182 -\             {s. Nonce NA ~: analz (spies s) --> \
  26.183 -\                 Crypt (pubK B) {|Nonce NA, Agent A|} : parts (spies s) \
  26.184 -\        --> Says A B (Crypt (pubK B) {|Nonce NA, Agent A|}) : set s}";
  26.185 -by (ns_induct_tac 1);
  26.186 -by (Blast_tac 1);
  26.187 -qed "B_trusts_NS1";
  26.188 -
  26.189 -
  26.190 -
  26.191 -(**** Authenticity properties obtained from NS2 ****)
  26.192 -
  26.193 -(*Unicity for NS2: nonce NB identifies nonce NA and agent A
  26.194 -  [proof closely follows that for unique_NA] *)
  26.195 -Goal
  26.196 - "Nprg \
  26.197 -\  : Always {s. Nonce NB ~: analz (spies s)  --> \
  26.198 -\               Crypt (pubK A) {|Nonce NA, Nonce NB|} : parts (spies s) -->  \
  26.199 -\               Crypt(pubK A'){|Nonce NA', Nonce NB|} : parts(spies s) -->  \
  26.200 -\               A=A' & NA=NA'}";
  26.201 -by (ns_induct_tac 1);
  26.202 -by Auto_tac;  
  26.203 -(*Fake, NS2 are non-trivial*)
  26.204 -val unique_NB_lemma = result();
  26.205 -
  26.206 -Goal "[| Crypt(pubK A) {|Nonce NA, Nonce NB|}  : parts(spies s); \
  26.207 -\        Crypt(pubK A'){|Nonce NA', Nonce NB|} : parts(spies s); \
  26.208 -\        Nonce NB ~: analz (spies s);                            \
  26.209 -\        s : reachable Nprg |]                                        \
  26.210 -\     ==> A=A' & NA=NA'";
  26.211 -by (blast_tac (claset() addDs [impOfAlways unique_NB_lemma]) 1); 
  26.212 -qed "unique_NB";
  26.213 -
  26.214 -
  26.215 -(*NB remains secret PROVIDED Alice never responds with round 3*)
  26.216 -Goal "[| A ~: bad;  B ~: bad |]                     \
  26.217 -\ ==> Nprg : Always \
  26.218 -\             {s. Says B A (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s &  \
  26.219 -\                 (ALL C. Says A C (Crypt (pubK C) (Nonce NB)) ~: set s) \
  26.220 -\                 --> Nonce NB ~: analz (spies s)}";
  26.221 -by (ns_induct_tac 1);
  26.222 -by (ALLGOALS (asm_simp_tac (simpset() addsimps [all_conj_distrib])));
  26.223 -by (ALLGOALS Clarify_tac);
  26.224 -(*NS3: because NB determines A*)
  26.225 -by (blast_tac (claset() addDs [unique_NB]) 4);
  26.226 -(*NS2: by freshness and unicity of NB*)
  26.227 -by (blast_tac (claset() addEs [nonce_NS1_NS2_E]) 3);
  26.228 -(*NS1: by freshness*)
  26.229 -by (Blast_tac 2);
  26.230 -(*Fake*)
  26.231 -by (spy_analz_tac 1);
  26.232 -qed "Spy_not_see_NB";
  26.233 -
  26.234 -
  26.235 -
  26.236 -(*Authentication for B: if he receives message 3 and has used NB
  26.237 -  in message 2, then A has sent message 3--to somebody....*)
  26.238 -val prems =
  26.239 -goal thy "[| A ~: bad;  B ~: bad |]                     \
  26.240 -\ ==> Nprg : Always \
  26.241 -\             {s. Crypt (pubK B) (Nonce NB) : parts (spies s) &  \
  26.242 -\                 Says B A  (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s \
  26.243 -\                 --> (EX C. Says A C (Crypt (pubK C) (Nonce NB)) : set s)}";
  26.244 -  (*insert an invariant for use in some of the subgoals*)
  26.245 -by (cut_facts_tac ([prems MRS Spy_not_see_NB] @ prems) 1);
  26.246 -by (ns_induct_tac 1);
  26.247 -by (ALLGOALS (asm_simp_tac (simpset() addsimps [ex_disj_distrib])));
  26.248 -by (ALLGOALS Clarify_tac);
  26.249 -(*NS3: because NB determines A (this use of unique_NB is more robust) *)
  26.250 -by (blast_tac (claset() addIs [unique_NB RS conjunct1]) 3);
  26.251 -(*NS1: by freshness*)
  26.252 -by (Blast_tac 2);
  26.253 -(*Fake*)
  26.254 -by (Blast_tac 1);
  26.255 -qed "B_trusts_NS3";
  26.256 -
  26.257 -
  26.258 -(*Can we strengthen the secrecy theorem?  NO*)
  26.259 -Goal "[| A ~: bad;  B ~: bad |]                     \
  26.260 -\ ==> Nprg : Always \
  26.261 -\             {s. Says B A (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s  \
  26.262 -\                 --> Nonce NB ~: analz (spies s)}";
  26.263 -by (ns_induct_tac 1);
  26.264 -by (ALLGOALS Clarify_tac);
  26.265 -(*NS2: by freshness and unicity of NB*)
  26.266 -by (blast_tac (claset() addEs [nonce_NS1_NS2_E]) 3);
  26.267 -(*NS1: by freshness*)
  26.268 -by (Blast_tac 2);
  26.269 -(*Fake*)
  26.270 -by (spy_analz_tac 1);
  26.271 -(*NS3: unicity of NB identifies A and NA, but not B*)
  26.272 -by (forw_inst_tac [("A'","A")] (Says_imp_spies RS parts.Inj RS unique_NB) 1
  26.273 -    THEN REPEAT (eresolve_tac [asm_rl, Says_imp_spies RS parts.Inj] 1));
  26.274 -by Auto_tac;
  26.275 -by (rename_tac "s B' C" 1);
  26.276 -
  26.277 -(*
  26.278 -THIS IS THE ATTACK!
  26.279 -[| A ~: bad; B ~: bad |]
  26.280 -==> Nprg
  26.281 -    : Always
  26.282 -       {s. Says B A (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s -->
  26.283 -           Nonce NB ~: analz (knows Spy s)}
  26.284 - 1. !!s B' C.
  26.285 -       [| A ~: bad; B ~: bad; s : reachable Nprg;
  26.286 -          Says A C (Crypt (pubK C) {|Nonce NA, Agent A|}) : set s;
  26.287 -          Says B' A (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s;
  26.288 -          C : bad; Says B A (Crypt (pubK A) {|Nonce NA, Nonce NB|}) : set s;
  26.289 -          Nonce NB ~: analz (knows Spy s) |]
  26.290 -       ==> False
  26.291 -*)
    27.1 --- a/src/HOL/UNITY/NSP_Bad.thy	Mon Mar 05 12:31:31 2001 +0100
    27.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.3 @@ -1,59 +0,0 @@
    27.4 -(*  Title:      HOL/Auth/NSP_Bad
    27.5 -    ID:         $Id$
    27.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    27.7 -    Copyright   1996  University of Cambridge
    27.8 -
    27.9 -add_path "../Auth"; use_thy"NSP_Bad";
   27.10 -
   27.11 -Security protocols in UNITY: Needham-Schroeder, public keys (flawed version).
   27.12 -
   27.13 -Original file is ../Auth/NS_Public_Bad
   27.14 -*)
   27.15 -
   27.16 -NSP_Bad = Public + Constrains + 
   27.17 -
   27.18 -types state = event list
   27.19 -
   27.20 -constdefs
   27.21 -  
   27.22 -  (*The spy MAY say anything he CAN say.  We do not expect him to
   27.23 -    invent new nonces here, but he can also use NS1.  Common to
   27.24 -    all similar protocols.*)
   27.25 -  Fake :: "(state*state) set"
   27.26 -    "Fake == {(s,s').
   27.27 -	      EX B X. s' = Says Spy B X # s
   27.28 -		    & X: synth (analz (spies s))}"
   27.29 -  
   27.30 -  (*The numeric suffixes on A identify the rule*)
   27.31 -
   27.32 -  (*Alice initiates a protocol run, sending a nonce to Bob*)
   27.33 -  NS1 :: "(state*state) set"
   27.34 -    "NS1 == {(s1,s').
   27.35 -	     EX A1 B NA.
   27.36 -	         s' = Says A1 B (Crypt (pubK B) {|Nonce NA, Agent A1|}) # s1
   27.37 -	       & Nonce NA ~: used s1}"
   27.38 -  
   27.39 -  (*Bob responds to Alice's message with a further nonce*)
   27.40 -  NS2 :: "(state*state) set"
   27.41 -    "NS2 == {(s2,s').
   27.42 -	     EX A' A2 B NA NB.
   27.43 -	         s' = Says B A2 (Crypt (pubK A2) {|Nonce NA, Nonce NB|}) # s2
   27.44 -               & Says A' B (Crypt (pubK B) {|Nonce NA, Agent A2|}) : set s2
   27.45 -	       & Nonce NB ~: used s2}"
   27.46 - 
   27.47 -  (*Alice proves her existence by sending NB back to Bob.*)
   27.48 -  NS3 :: "(state*state) set"
   27.49 -    "NS3 == {(s3,s').
   27.50 -	     EX A3 B' B NA NB.
   27.51 -	         s' = Says A3 B (Crypt (pubK B) (Nonce NB)) # s3
   27.52 -               & Says A3  B (Crypt (pubK B) {|Nonce NA, Agent A3|}) : set s3
   27.53 -	       & Says B' A3 (Crypt (pubK A3) {|Nonce NA, Nonce NB|}) : set s3}"
   27.54 -
   27.55 -
   27.56 -
   27.57 -constdefs
   27.58 -  Nprg :: state program
   27.59 -    (*Initial trace is empty*)
   27.60 -    "Nprg == mk_program({[]}, {Fake, NS1, NS2, NS3}, UNIV)"
   27.61 -
   27.62 -end
    28.1 --- a/src/HOL/UNITY/Network.ML	Mon Mar 05 12:31:31 2001 +0100
    28.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.3 @@ -1,59 +0,0 @@
    28.4 -(*  Title:      HOL/UNITY/Network
    28.5 -    ID:         $Id$
    28.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    28.7 -    Copyright   1998  University of Cambridge
    28.8 -
    28.9 -The Communication Network
   28.10 -
   28.11 -From Misra, "A Logic for Concurrent Programming" (1994), section 5.7
   28.12 -*)
   28.13 -
   28.14 -val [rsA, rsB, sent_nondec, rcvd_nondec, rcvd_idle, sent_idle] = 
   28.15 -Goalw [stable_def]
   28.16 -   "[| !! m. F : stable {s. s(Bproc,Rcvd) <= s(Aproc,Sent)};  \
   28.17 -\      !! m. F : stable {s. s(Aproc,Rcvd) <= s(Bproc,Sent)};  \
   28.18 -\      !! m proc. F : stable {s. m <= s(proc,Sent)};  \
   28.19 -\      !! n proc. F : stable {s. n <= s(proc,Rcvd)};  \
   28.20 -\      !! m proc. F : {s. s(proc,Idle) = 1 & s(proc,Rcvd) = m} co \
   28.21 -\                                 {s. s(proc,Rcvd) = m --> s(proc,Idle) = 1}; \
   28.22 -\      !! n proc. F : {s. s(proc,Idle) = 1 & s(proc,Sent) = n} co \
   28.23 -\                                 {s. s(proc,Sent) = n} \
   28.24 -\   |] ==> F : stable {s. s(Aproc,Idle) = 1 & s(Bproc,Idle) = 1 & \
   28.25 -\                         s(Aproc,Sent) = s(Bproc,Rcvd) & \
   28.26 -\                         s(Bproc,Sent) = s(Aproc,Rcvd) & \
   28.27 -\                         s(Aproc,Rcvd) = m & s(Bproc,Rcvd) = n}";
   28.28 -
   28.29 -val sent_nondec_A = read_instantiate [("proc","Aproc")] sent_nondec;
   28.30 -val sent_nondec_B = read_instantiate [("proc","Bproc")] sent_nondec;
   28.31 -val rcvd_nondec_A = read_instantiate [("proc","Aproc")] rcvd_nondec;
   28.32 -val rcvd_nondec_B = read_instantiate [("proc","Bproc")] rcvd_nondec;
   28.33 -val rcvd_idle_A = read_instantiate [("proc","Aproc")] rcvd_idle;
   28.34 -val rcvd_idle_B = read_instantiate [("proc","Bproc")] rcvd_idle;
   28.35 -val sent_idle_A = read_instantiate [("proc","Aproc")] sent_idle;
   28.36 -val sent_idle_B = read_instantiate [("proc","Bproc")] sent_idle;
   28.37 -
   28.38 -val rs_AB = [rsA, rsB] MRS constrains_Int;
   28.39 -val sent_nondec_AB = [sent_nondec_A, sent_nondec_B] MRS constrains_Int;
   28.40 -val rcvd_nondec_AB = [rcvd_nondec_A, rcvd_nondec_B] MRS constrains_Int;
   28.41 -val rcvd_idle_AB = [rcvd_idle_A, rcvd_idle_B] MRS constrains_Int;
   28.42 -val sent_idle_AB = [sent_idle_A, sent_idle_B] MRS constrains_Int;
   28.43 -val nondec_AB = [sent_nondec_AB, rcvd_nondec_AB] MRS constrains_Int;
   28.44 -val idle_AB = [rcvd_idle_AB, sent_idle_AB] MRS constrains_Int;
   28.45 -val nondec_idle = [nondec_AB, idle_AB] MRS constrains_Int;
   28.46 -
   28.47 -by (rtac constrainsI 1);
   28.48 -by (dtac ([rs_AB, nondec_idle] MRS constrains_Int RS constrainsD) 1);
   28.49 -by (assume_tac 1);
   28.50 -by (ALLGOALS Asm_full_simp_tac);
   28.51 -by (blast_tac (HOL_cs addIs [order_refl]) 1);
   28.52 -by (Clarify_tac 1);
   28.53 -by (subgoals_tac ["s' (Aproc, Rcvd) = s (Aproc, Rcvd)",
   28.54 -		  "s' (Bproc, Rcvd) = s (Bproc, Rcvd)"] 1);
   28.55 -by (REPEAT 
   28.56 -    (blast_tac (claset() addIs [order_antisym, le_trans, eq_imp_le]) 2));
   28.57 -by (Asm_simp_tac 1);
   28.58 -result();
   28.59 -
   28.60 -
   28.61 -
   28.62 -
    29.1 --- a/src/HOL/UNITY/Network.thy	Mon Mar 05 12:31:31 2001 +0100
    29.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.3 @@ -1,21 +0,0 @@
    29.4 -(*  Title:      HOL/UNITY/Network
    29.5 -    ID:         $Id$
    29.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    29.7 -    Copyright   1998  University of Cambridge
    29.8 -
    29.9 -The Communication Network
   29.10 -
   29.11 -From Misra, "A Logic for Concurrent Programming" (1994), section 5.7
   29.12 -*)
   29.13 -
   29.14 -Network = UNITY +
   29.15 -
   29.16 -(*The state assigns a number to each process variable*)
   29.17 -
   29.18 -datatype pvar = Sent | Rcvd | Idle
   29.19 -
   29.20 -datatype pname = Aproc | Bproc
   29.21 -
   29.22 -types state = "pname * pvar => nat"
   29.23 -
   29.24 -end
    30.1 --- a/src/HOL/UNITY/Priority.ML	Mon Mar 05 12:31:31 2001 +0100
    30.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.3 @@ -1,239 +0,0 @@
    30.4 -(*  Title:      HOL/UNITY/Priority
    30.5 -    ID:         $Id$
    30.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    30.7 -    Copyright   2001  University of Cambridge
    30.8 -
    30.9 -The priority system
   30.10 -
   30.11 -From Charpentier and Chandy,
   30.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   30.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   30.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   30.15 -*)
   30.16 -
   30.17 -Addsimps [Component_def RS def_prg_Init];
   30.18 -program_defs_ref := [Component_def, system_def];
   30.19 -Addsimps [highest_def, lowest_def];
   30.20 -Addsimps [simp_of_act  act_def];
   30.21 -Addsimps (map simp_of_set [Highest_def, Lowest_def]);
   30.22 -
   30.23 -
   30.24 -
   30.25 -
   30.26 -(**** Component correctness proofs  ****)
   30.27 -
   30.28 -(* neighbors is stable  *)
   30.29 -Goal "Component i: stable {s. neighbors k s = n}";
   30.30 -by (constrains_tac 1);
   30.31 -by Auto_tac;
   30.32 -qed "Component_neighbors_stable";
   30.33 -
   30.34 -(* property 4 *)
   30.35 -Goal 
   30.36 -"Component i: {s. ((i,j):s) = b} Int (- Highest i) co {s. ((i,j):s)=b}";
   30.37 -by (constrains_tac 1);
   30.38 -qed "Component_waits_priority";  
   30.39 -
   30.40 -(* property 5: charpentier and Chandy mistakenly express it as
   30.41 - 'transient Highest i'. Consider the case where i has neighbors *)
   30.42 -Goal
   30.43 - "Component i: {s. neighbors i s ~= {}} Int Highest i \
   30.44 -\              ensures - Highest i";
   30.45 -by (ensures_tac "act i" 1);
   30.46 -by (REPEAT(Fast_tac 1));
   30.47 -qed "Component_yields_priority"; 
   30.48 -
   30.49 -(* or better *)
   30.50 -Goal "Component i: Highest i ensures Lowest i";
   30.51 -by (ensures_tac "act i" 1);
   30.52 -by (REPEAT(Fast_tac 1));
   30.53 -qed "Component_yields_priority'";
   30.54 -
   30.55 -(* property 6: Component doesn't introduce cycle *)
   30.56 -Goal "Component i: Highest i co Highest i Un Lowest i";
   30.57 -by (constrains_tac 1);
   30.58 -by (Fast_tac 1);
   30.59 -qed "Component_well_behaves"; 
   30.60 -
   30.61 -(* property 7: local axiom *)
   30.62 -Goal "Component i: stable {s. ALL j k. j~=i & k~=i--> ((j,k):s) = b j k}";
   30.63 -by (constrains_tac 1);
   30.64 -qed "locality";  
   30.65 -
   30.66 -
   30.67 -(**** System  properties  ****)
   30.68 -(* property 8: strictly universal *)
   30.69 -
   30.70 -Goalw [Safety_def] 
   30.71 -    "system: stable Safety";
   30.72 -by (rtac stable_INT 1);
   30.73 -by (constrains_tac 1);
   30.74 -by (Fast_tac 1);
   30.75 -qed "Safety"; 
   30.76 -
   30.77 -(* property 13: universal *)
   30.78 -Goal
   30.79 -"system: {s. s = q} co {s. s=q} Un {s. EX i. derive i q s}";
   30.80 -by (constrains_tac 1);
   30.81 -by (Blast_tac 1);
   30.82 -qed "p13";
   30.83 -
   30.84 -(* property 14: the 'above set' of a Component that hasn't got 
   30.85 -      priority doesn't increase *)
   30.86 -Goal
   30.87 -"ALL j. system: -Highest i Int {s. j~:above i s} co {s. j~:above i s}";
   30.88 -by (Clarify_tac 1);
   30.89 -by (cut_inst_tac [("i", "j")] reach_lemma 1);
   30.90 -by (constrains_tac 1);
   30.91 -by (auto_tac (claset(), simpset() addsimps [trancl_converse]));
   30.92 -qed "above_not_increase";  
   30.93 -
   30.94 -Goal 
   30.95 -"system: -Highest i Int {s. above i s = x} co {s. above i s <= x}";
   30.96 -by (cut_inst_tac [("i", "i")] above_not_increase 1);
   30.97 -by (asm_full_simp_tac (simpset() addsimps 
   30.98 -                 [trancl_converse, constrains_def]) 1); 
   30.99 -by (Blast_tac 1);
  30.100 -qed "above_not_increase'";  
  30.101 -
  30.102 -
  30.103 -
  30.104 -(* p15: universal property: all Components well behave  *)
  30.105 -Goal "ALL i. system: Highest i co Highest i Un Lowest i";
  30.106 -by (Clarify_tac 1);
  30.107 -by (constrains_tac 1);
  30.108 -by Auto_tac;
  30.109 -qed "system_well_behaves";  
  30.110 -
  30.111 -
  30.112 -Goal "Acyclic = (INT i. {s. i~:above i s})";
  30.113 -by (auto_tac (claset(), simpset() 
  30.114 -   addsimps [Acyclic_def, acyclic_def, trancl_converse]));
  30.115 -qed "Acyclic_eq";
  30.116 -
  30.117 -
  30.118 -val lemma = [above_not_increase RS spec, 
  30.119 -           system_well_behaves RS spec] MRS constrains_Un;
  30.120 -Goal 
  30.121 -"system: stable Acyclic";
  30.122 -by (auto_tac (claset() addSIs [stable_INT, stableI, 
  30.123 -                               lemma RS constrains_weaken],
  30.124 -              simpset() addsimps [Acyclic_eq, 
  30.125 -                    image0_r_iff_image0_trancl,trancl_converse]));
  30.126 -qed "Acyclic_stable";
  30.127 -
  30.128 -
  30.129 -Goalw [Acyclic_def, Maximal_def]
  30.130 -"Acyclic <= Maximal";
  30.131 -by (Clarify_tac 1);
  30.132 -by (dtac above_lemma_b 1);
  30.133 -by Auto_tac;
  30.134 -qed "Acyclic_subset_Maximal";
  30.135 -
  30.136 -(* property 17: original one is an invariant *)
  30.137 -Goal 
  30.138 -"system: stable (Acyclic Int Maximal)";
  30.139 -by (simp_tac (simpset() addsimps 
  30.140 -     [Acyclic_subset_Maximal RS Int_absorb2, Acyclic_stable]) 1);
  30.141 -qed "Acyclic_Maximal_stable";  
  30.142 -
  30.143 -
  30.144 -(* propert 5: existential property *)
  30.145 -
  30.146 -Goal "system: Highest i leadsTo Lowest i";
  30.147 -by (ensures_tac "act i" 1);
  30.148 -by (auto_tac (claset(), simpset() addsimps [Component_def]));
  30.149 -qed "Highest_leadsTo_Lowest";
  30.150 -
  30.151 -(* a lowest i can never be in any abover set *) 
  30.152 -Goal "Lowest i <= (INT k. {s. i~:above k s})";
  30.153 -by (auto_tac (claset(), 
  30.154 -          simpset() addsimps [image0_r_iff_image0_trancl, trancl_converse]));
  30.155 -qed  "Lowest_above_subset";
  30.156 -
  30.157 -(* property 18: a simpler proof than the original, one which uses psp *)
  30.158 -Goal "system: Highest i leadsTo (INT k. {s. i~:above k s})";
  30.159 -by (rtac leadsTo_weaken_R 1);
  30.160 -by (rtac Lowest_above_subset 2);
  30.161 -by (rtac Highest_leadsTo_Lowest 1);
  30.162 -qed "Highest_escapes_above";
  30.163 -
  30.164 -Goal 
  30.165 -"system: Highest j Int {s. j:above i s} leadsTo {s. j~:above i s}";
  30.166 -by (blast_tac (claset() addIs 
  30.167 -   [[Highest_escapes_above, Int_lower1, INT_lower] MRS leadsTo_weaken]) 1);
  30.168 -qed "Highest_escapes_above'"; 
  30.169 -
  30.170 -(*** The main result: above set decreases ***)
  30.171 -(* The original proof of the following formula was wrong *)
  30.172 -val above_decreases_lemma = 
  30.173 -[Highest_escapes_above', above_not_increase'] MRS psp RS leadsTo_weaken;
  30.174 -
  30.175 -Goal "Highest i = {s. above i s ={}}";
  30.176 -by (auto_tac (claset(), 
  30.177 -        simpset() addsimps [image0_trancl_iff_image0_r]));
  30.178 -qed "Highest_iff_above0";
  30.179 -
  30.180 -
  30.181 -Goal 
  30.182 -"system: (UN j. {s. above i s = x} Int {s. j:above i s} Int Highest j) \
  30.183 -\          leadsTo {s. above i s < x}";
  30.184 -by (rtac leadsTo_UN 1);
  30.185 -by (rtac single_leadsTo_I 1);
  30.186 -by (Clarify_tac 1);
  30.187 -by (res_inst_tac [("x2", "above i x")] above_decreases_lemma 1);
  30.188 -by (ALLGOALS(full_simp_tac (simpset() delsimps [Highest_def]
  30.189 -                  addsimps [Highest_iff_above0])));
  30.190 -by (REPEAT(Blast_tac 1));
  30.191 -qed "above_decreases";  
  30.192 -
  30.193 -(** Just a massage of conditions to have the desired form ***)
  30.194 -Goalw [Maximal_def, Maximal'_def, Highest_def]
  30.195 -"Maximal = Maximal'";
  30.196 -by (Blast_tac 1);
  30.197 -qed "Maximal_eq_Maximal'";
  30.198 -
  30.199 -Goal "x~={} ==> \
  30.200 -\   Acyclic Int {s. above i s = x} <= \
  30.201 -\   (UN j. {s. above i s = x} Int {s. j:above i s} Int Highest j)";
  30.202 -by (res_inst_tac [("B", "Maximal' Int {s. above i s = x}")] subset_trans 1);
  30.203 -by (simp_tac (simpset() addsimps [Maximal_eq_Maximal' RS sym]) 1);
  30.204 -by (blast_tac (claset() addIs [Acyclic_subset_Maximal RS subsetD]) 1);
  30.205 -by (simp_tac (simpset() delsimps [above_def] addsimps [Maximal'_def, Highest_iff_above0]) 1);
  30.206 -by (Blast_tac 1);
  30.207 -qed "Acyclic_subset";
  30.208 -
  30.209 -val above_decreases' = [above_decreases, Acyclic_subset] MRS leadsTo_weaken_L;
  30.210 -val above_decreases_psp = [above_decreases', Acyclic_stable] MRS psp_stable;
  30.211 -
  30.212 -Goal 
  30.213 -"x~={}==> \
  30.214 -\ system: Acyclic Int {s. above i s = x} leadsTo Acyclic Int {s. above i s < x}";
  30.215 -by (etac (above_decreases_psp RS leadsTo_weaken) 1);
  30.216 -by (Blast_tac 1);
  30.217 -by Auto_tac;
  30.218 -qed "above_decreases_psp'";
  30.219 -
  30.220 -
  30.221 -val finite_psubset_induct = wf_finite_psubset RS leadsTo_wf_induct;
  30.222 -val leadsTo_weaken_L' = rotate_prems 1 leadsTo_weaken_L;
  30.223 -
  30.224 -
  30.225 -Goal "system: Acyclic leadsTo Highest i";
  30.226 -by (res_inst_tac [("f", "%s. above i s")] finite_psubset_induct 1);
  30.227 -by (asm_simp_tac (simpset() delsimps [Highest_def, above_def] 
  30.228 -                            addsimps [Highest_iff_above0,
  30.229 -                                      vimage_def, finite_psubset_def]) 1); 
  30.230 -by (Clarify_tac 1);
  30.231 -by (case_tac "m={}" 1);
  30.232 -by (rtac (Int_lower2 RS leadsTo_weaken_L') 1);
  30.233 -by (force_tac (claset(), simpset() addsimps [leadsTo_refl]) 1);
  30.234 -by (res_inst_tac [("A'", "Acyclic Int {x. above i x < m}")] 
  30.235 -    leadsTo_weaken_R 1);
  30.236 -by (REPEAT(blast_tac (claset() addIs [above_decreases_psp']) 1));
  30.237 -qed "Progress";
  30.238 -
  30.239 -(* We have proved all (relevant) theorems given in the paper *)
  30.240 -(* We didn't assume any thing about the relation r *)
  30.241 -(* It is not necessary that r be a priority relation as assumed in the original proof *)
  30.242 -(* It suffices that we start from a state which is finite and acyclic *)
    31.1 --- a/src/HOL/UNITY/Priority.thy	Mon Mar 05 12:31:31 2001 +0100
    31.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.3 @@ -1,68 +0,0 @@
    31.4 -(*  Title:      HOL/UNITY/Priority
    31.5 -    ID:         $Id$
    31.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    31.7 -    Copyright   2001  University of Cambridge
    31.8 -
    31.9 -The priority system
   31.10 -
   31.11 -From Charpentier and Chandy,
   31.12 -Examples of Program Composition Illustrating the Use of Universal Properties
   31.13 -   In J. Rolim (editor), Parallel and Distributed Processing,
   31.14 -   Spriner LNCS 1586 (1999), pages 1215-1227.
   31.15 -*)
   31.16 -
   31.17 -Priority = PriorityAux + Comp + SubstAx +
   31.18 -
   31.19 -types state = "(vertex*vertex)set"
   31.20 -types command = "vertex=>(state*state)set"
   31.21 -  
   31.22 -consts
   31.23 -  (* the initial state *)
   31.24 -  init :: "(vertex*vertex)set"  
   31.25 -
   31.26 -constdefs
   31.27 -  (* from the definitions given in section 4.4 *)
   31.28 -  (* i has highest priority in r *)
   31.29 -  highest :: "[vertex, (vertex*vertex)set]=>bool"
   31.30 -  "highest i r == A i r = {}"
   31.31 -  
   31.32 -  (* i has lowest priority in r *)
   31.33 -  lowest :: "[vertex, (vertex*vertex)set]=>bool"
   31.34 -  "lowest i r == R i r = {}"
   31.35 -
   31.36 -  act :: command
   31.37 -  "act i == {(s, s'). s'=reverse i s & highest i s}"
   31.38 -
   31.39 -  (* All components start with the same initial state *)
   31.40 -  Component :: "vertex=>state program"
   31.41 -  "Component i == mk_program({init}, {act i}, UNIV)"
   31.42 -
   31.43 -  (* Abbreviations *)
   31.44 -  Highest :: "vertex=>state set"
   31.45 -  "Highest i == {s. highest i s}"
   31.46 -
   31.47 -  Lowest :: "vertex=>state set"
   31.48 -  "Lowest i == {s. lowest i s}"
   31.49 -
   31.50 -  Acyclic :: "state set"
   31.51 -  "Acyclic == {s. acyclic s}"
   31.52 -
   31.53 -  (* Every above set has a maximal vertex: two equivalent defs. *)
   31.54 -
   31.55 -  Maximal :: "state set"
   31.56 -  "Maximal == INT i. {s. ~highest i s-->(EX j:above i  s. highest j s)}"
   31.57 -
   31.58 -  Maximal' :: "state set"
   31.59 -  "Maximal' == INT i. Highest i Un (UN j. {s. j:above i s} Int Highest j)"
   31.60 -
   31.61 -  
   31.62 -  Safety :: "state set"
   31.63 -  "Safety == INT i. {s. highest i s --> (ALL j:neighbors i s. ~highest j s)}"
   31.64 -
   31.65 -
   31.66 -  (* Composition of a finite set of component;
   31.67 -     the vertex 'UNIV' is finite by assumption *)
   31.68 -  
   31.69 -  system :: "state program"
   31.70 -  "system == JN i. Component i"
   31.71 -end
   31.72 \ No newline at end of file
    32.1 --- a/src/HOL/UNITY/PriorityAux.ML	Mon Mar 05 12:31:31 2001 +0100
    32.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.3 @@ -1,116 +0,0 @@
    32.4 -(*  Title:      HOL/UNITY/PriorityAux
    32.5 -    ID:         $Id$
    32.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    32.7 -    Copyright   2001  University of Cambridge
    32.8 -
    32.9 -Auxiliary definitions needed in Priority.thy
   32.10 -*)
   32.11 -
   32.12 -Addsimps [derive_def, derive1_def, symcl_def, A_def, R_def,  
   32.13 -          above_def, reach_def, reverse_def, neighbors_def];
   32.14 -
   32.15 -(*All vertex sets are finite \\<dots>*)
   32.16 -AddIffs [[subset_UNIV, finite_vertex_univ] MRS finite_subset];
   32.17 -
   32.18 -(* and relatons over vertex are finite too *)
   32.19 -AddIffs [[subset_UNIV, [finite_vertex_univ, finite_vertex_univ] 
   32.20 -           MRS finite_Prod_UNIV] MRS finite_subset];
   32.21 -
   32.22 -
   32.23 -(* The equalities (above i r = {}) = (A i r = {}) 
   32.24 -   and (reach i r = {}) = (R i r) rely on the following theorem  *)
   32.25 -
   32.26 -Goal "((r^+)``{i} = {}) = (r``{i} = {})";
   32.27 -by Auto_tac;
   32.28 -by (etac trancl_induct 1);
   32.29 -by Auto_tac;
   32.30 -qed "image0_trancl_iff_image0_r";
   32.31 -
   32.32 -(* Another form usefull in some situation *)
   32.33 -Goal "(r``{i}={}) = (ALL x. ((i,x):r^+) = False)";
   32.34 -by Auto_tac;
   32.35 -by (dtac (image0_trancl_iff_image0_r RS ssubst) 1);
   32.36 -by Auto_tac;
   32.37 -qed "image0_r_iff_image0_trancl";
   32.38 -
   32.39 -
   32.40 -(* In finite universe acyclic coincides with wf *)
   32.41 -Goal 
   32.42 -"!!r::(vertex*vertex)set. acyclic r = wf r";
   32.43 -by (auto_tac (claset(), simpset() addsimps [wf_iff_acyclic_if_finite]));
   32.44 -qed "acyclic_eq_wf";
   32.45 -
   32.46 -(* derive and derive1 are equivalent *)
   32.47 -Goal "derive i r q = derive1 i r q";
   32.48 -by Auto_tac;
   32.49 -qed "derive_derive1_eq";
   32.50 -
   32.51 -(* Lemma 1 *)
   32.52 -Goalw [reach_def]
   32.53 -"[| x:reach i q; derive1 k r q |] ==> x~=k --> x:reach i r";
   32.54 -by (etac ImageE 1);
   32.55 -by (etac trancl_induct 1);
   32.56 -by (case_tac "i=k" 1);
   32.57 -by (auto_tac (claset() addIs [r_into_trancl], simpset()));
   32.58 -by (dres_inst_tac [("x", "y")] spec 1);
   32.59 -by (rotate_tac ~1 1);
   32.60 -by (dres_inst_tac [("x", "z")] spec 1);
   32.61 -by (auto_tac (claset() addDs [r_into_trancl] addIs [trancl_trans], simpset()));
   32.62 -qed "lemma1_a";
   32.63 -
   32.64 -Goal "ALL k r q. derive k r q -->(reach i q <= (reach i r Un {k}))";
   32.65 -by (REPEAT(rtac allI 1));
   32.66 -by (rtac impI 1);
   32.67 -by (rtac subsetI 1 THEN dtac lemma1_a 1);
   32.68 -by (auto_tac (claset(), simpset() addsimps [derive_derive1_eq]
   32.69 -                    delsimps [reach_def, derive_def, derive1_def]));
   32.70 -qed "reach_lemma";
   32.71 -
   32.72 -(* An other possible formulation of the above theorem based on
   32.73 -   the equivalence x:reach y r = y:above x r                  *)
   32.74 -Goal 
   32.75 -"(ALL i. reach i q <= (reach i r Un {k})) =\
   32.76 -\ (ALL x. x~=k --> (ALL i. i~:above x r --> i~:above x q))";
   32.77 -by (auto_tac (claset(), simpset() addsimps [trancl_converse]));
   32.78 -qed "reach_above_lemma";
   32.79 -
   32.80 -(* Lemma 2 *)
   32.81 -Goal 
   32.82 -"(z, i):r^+ ==> (ALL y. (y, z):r --> (y, i)~:r^+) = ((r^-1)``{z}={})";
   32.83 -by Auto_tac;
   32.84 -by (forw_inst_tac [("r", "r")] trancl_into_trancl2 1);
   32.85 -by Auto_tac;
   32.86 -qed "maximal_converse_image0";
   32.87 -
   32.88 -Goal
   32.89 - "acyclic r ==> A i r~={}-->(EX j:above i r. A j r = {})";
   32.90 -by (full_simp_tac (simpset() 
   32.91 -            addsimps [acyclic_eq_wf, wf_eq_minimal]) 1);
   32.92 -by (dres_inst_tac [("x", "((r^-1)^+)``{i}")] spec 1);
   32.93 -by Auto_tac;
   32.94 -by (rotate_tac ~1 1);
   32.95 -by (asm_full_simp_tac (simpset() 
   32.96 -        addsimps [maximal_converse_image0, trancl_converse]) 1);
   32.97 -qed "above_lemma_a";
   32.98 -
   32.99 -
  32.100 -Goal
  32.101 - "acyclic r ==> above i r~={}-->(EX j:above i r. above j r = {})";
  32.102 -by (dtac above_lemma_a 1);
  32.103 -by (auto_tac (claset(), simpset() 
  32.104 -        addsimps [image0_trancl_iff_image0_r]));
  32.105 -qed "above_lemma_b";
  32.106 -
  32.107 -
  32.108 -
  32.109 -
  32.110 -
  32.111 -
  32.112 -
  32.113 -
  32.114 -
  32.115 -
  32.116 -
  32.117 -
  32.118 -
  32.119 -
    33.1 --- a/src/HOL/UNITY/PriorityAux.thy	Mon Mar 05 12:31:31 2001 +0100
    33.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.3 @@ -1,53 +0,0 @@
    33.4 -(*  Title:      HOL/UNITY/PriorityAux
    33.5 -    ID:         $Id$
    33.6 -    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    33.7 -    Copyright   2001  University of Cambridge
    33.8 -
    33.9 -Auxiliary definitions needed in Priority.thy
   33.10 -*)
   33.11 -
   33.12 -PriorityAux  =  Main +
   33.13 -
   33.14 -types vertex
   33.15 -arities vertex::term
   33.16 -  
   33.17 -constdefs
   33.18 -  (* symmetric closure: removes the orientation of a relation *)
   33.19 -  symcl :: "(vertex*vertex)set=>(vertex*vertex)set"
   33.20 -  "symcl r == r Un (r^-1)"
   33.21 -
   33.22 -  (* Neighbors of a vertex i *)
   33.23 -  neighbors :: "[vertex, (vertex*vertex)set]=>vertex set"
   33.24 - "neighbors i r == ((r Un r^-1)``{i}) - {i}"
   33.25 -
   33.26 -  R :: "[vertex, (vertex*vertex)set]=>vertex set"
   33.27 -  "R i r == r``{i}"
   33.28 -
   33.29 -  A :: "[vertex, (vertex*vertex)set]=>vertex set"
   33.30 -  "A i r == (r^-1)``{i}"
   33.31 -
   33.32 -  (* reachable and above vertices: the original notation was R* and A* *)  
   33.33 -  reach :: "[vertex, (vertex*vertex)set]=> vertex set"
   33.34 -  "reach i r == (r^+)``{i}"
   33.35 -
   33.36 -  above :: "[vertex, (vertex*vertex)set]=> vertex set"
   33.37 -  "above i r == ((r^-1)^+)``{i}"  
   33.38 -
   33.39 -  reverse :: "[vertex, (vertex*vertex) set]=>(vertex*vertex)set"
   33.40 -  "reverse i r == (r - {(x,y). x=i | y=i} Int r) Un ({(x,y). x=i|y=i} Int r)^-1"
   33.41 -
   33.42 -  (* The original definition *)
   33.43 -  derive1 :: "[vertex, (vertex*vertex)set, (vertex*vertex)set]=>bool"
   33.44 -  "derive1 i r q == symcl r = symcl q &
   33.45 -                    (ALL k k'. k~=i & k'~=i -->((k,k'):r) = ((k,k'):q)) &
   33.46 -                    A i r = {} & R i q = {}"
   33.47 -
   33.48 -  (* Our alternative definition *)
   33.49 -  derive :: "[vertex, (vertex*vertex)set, (vertex*vertex)set]=>bool"
   33.50 -  "derive i r q == A i r = {} & (q = reverse i r)"
   33.51 -
   33.52 -rules
   33.53 -  (* we assume that the universe of vertices is finite  *)
   33.54 -  finite_vertex_univ "finite (UNIV :: vertex set)"
   33.55 -
   33.56 -end
    34.1 --- a/src/HOL/UNITY/README.html	Mon Mar 05 12:31:31 2001 +0100
    34.2 +++ b/src/HOL/UNITY/README.html	Mon Mar 05 15:25:11 2001 +0100
    34.3 @@ -23,32 +23,18 @@
    34.4  in the propositions-as-types paradigm.  The resulting style is readable if
    34.5  unconventional.
    34.6  
    34.7 -<P>
    34.8 -The directory presents a few small examples, mostly taken from Misra's 1994
    34.9 -paper:
   34.10 -<UL>
   34.11 -<LI>common meeting time
   34.12 -
   34.13 -<LI>the token ring
   34.14 -
   34.15 -<LI>the communication network
   34.16 -
   34.17 -<LI>the lift controller (a standard benchmark)
   34.18 -
   34.19 -<LI>a mutual exclusion algorithm
   34.20 -
   34.21 -<LI><EM>n</EM>-process deadlock
   34.22 -
   34.23 -<LI>unordered channel
   34.24 -
   34.25 -<LI>reachability in directed graphs (section 6.4 of the book)
   34.26 -</UL>
   34.27 -
   34.28  <P> Safety proofs (invariants) are often proved automatically.  Progress
   34.29  proofs involving ENSURES can sometimes be proved automatically.  The
   34.30  level of automation appears to be about the same as in HOL-UNITY by Flemming
   34.31  Andersen et al.
   34.32  
   34.33 +<P>
   34.34 +The directory <A HREF="Simple/"><CODE>Simple</CODE></A>
   34.35 +presents a few examples, mostly taken from Misra's 1994
   34.36 +paper, involving single programs.
   34.37 +The directory <A HREF="Comp/"><CODE>Comp</CODE></A>
   34.38 +presents examples of proofs involving program composition.
   34.39 +
   34.40  <HR>
   34.41  <P>Last modified on $Date$
   34.42  
    35.1 --- a/src/HOL/UNITY/ROOT.ML	Mon Mar 05 12:31:31 2001 +0100
    35.2 +++ b/src/HOL/UNITY/ROOT.ML	Mon Mar 05 15:25:11 2001 +0100
    35.3 @@ -6,35 +6,39 @@
    35.4  Root file for UNITY proofs.
    35.5  *)
    35.6  
    35.7 -time_use_thy "UNITY";
    35.8 -time_use_thy "Deadlock";
    35.9 +(*Basic meta-theory*)
   35.10 +time_use_thy "FP";
   35.11  time_use_thy "WFair";
   35.12 -time_use_thy "Common";
   35.13 -time_use_thy "Network";
   35.14 -time_use_thy "Token";
   35.15 -time_use_thy "Channel";
   35.16 -time_use_thy "Mutex";
   35.17 -time_use_thy "FP";
   35.18 -time_use_thy "Reach";
   35.19 -time_use_thy "Handshake";
   35.20 -time_use_thy "Lift";
   35.21 +
   35.22 +(*Simple examples: no composition*)
   35.23 +time_use_thy "Simple/Deadlock";
   35.24 +time_use_thy "Simple/Common";
   35.25 +time_use_thy "Simple/Network";
   35.26 +time_use_thy "Simple/Token";
   35.27 +time_use_thy "Simple/Channel";
   35.28 +time_use_thy "Simple/Lift";
   35.29 +time_use_thy "Simple/Mutex";
   35.30 +time_use_thy "Simple/Reach";
   35.31 +time_use_thy "Simple/Reachability";
   35.32 +
   35.33 +with_path "../Auth"  (*to find Public.thy*)
   35.34 +  time_use_thy"Simple/NSP_Bad";
   35.35 +
   35.36 +(*Example of composition*)
   35.37  time_use_thy "Comp";
   35.38 -time_use_thy "Reachability";
   35.39 +time_use_thy "Comp/Handshake";
   35.40  
   35.41  (*Universal properties examples*)
   35.42 -time_use_thy "Counter";
   35.43 -time_use_thy "Counterc";
   35.44 -time_use_thy "Priority";
   35.45 +time_use_thy "Comp/Counter";
   35.46 +time_use_thy "Comp/Counterc";
   35.47 +time_use_thy "Comp/Priority";
   35.48  
   35.49  (*Allocator example*)
   35.50  time_use_thy "PPROD";
   35.51 -time_use_thy "TimerArray";
   35.52 +time_use_thy "Comp/TimerArray";
   35.53  
   35.54 -time_use_thy "Alloc";
   35.55 -time_use_thy "AllocImpl";
   35.56 -time_use_thy "Client";
   35.57 +time_use_thy "Comp/Alloc";
   35.58 +time_use_thy "Comp/AllocImpl";
   35.59 +time_use_thy "Comp/Client";
   35.60  
   35.61  time_use_thy "ELT";  (*obsolete*)
   35.62 -
   35.63 -with_path "../Auth"  (*to find Public.thy*)
   35.64 -  time_use_thy"NSP_Bad";
    36.1 --- a/src/HOL/UNITY/Reach.ML	Mon Mar 05 12:31:31 2001 +0100
    36.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.3 @@ -1,142 +0,0 @@
    36.4 -(*  Title:      HOL/UNITY/Reach.thy
    36.5 -    ID:         $Id$
    36.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    36.7 -    Copyright   1998  University of Cambridge
    36.8 -
    36.9 -Reachability in Directed Graphs.  From Chandy and Misra, section 6.4.
   36.10 -	[ this example took only four days!]
   36.11 -*)
   36.12 -
   36.13 -(*TO SIMPDATA.ML??  FOR CLASET??  *)
   36.14 -val major::prems = goal thy 
   36.15 -    "[| if P then Q else R;    \
   36.16 -\       [| P;   Q |] ==> S;    \
   36.17 -\       [| ~ P; R |] ==> S |] ==> S";
   36.18 -by (cut_facts_tac [major] 1);
   36.19 -by (blast_tac (claset() addSDs [if_bool_eq_disj RS iffD1] addIs prems) 1);
   36.20 -qed "ifE";
   36.21 -
   36.22 -AddSEs [ifE];
   36.23 -
   36.24 -
   36.25 -Addsimps [Rprg_def RS def_prg_Init];
   36.26 -program_defs_ref := [Rprg_def];
   36.27 -
   36.28 -Addsimps [simp_of_act asgt_def];
   36.29 -
   36.30 -(*All vertex sets are finite*)
   36.31 -AddIffs [[subset_UNIV, finite_graph] MRS finite_subset];
   36.32 -
   36.33 -Addsimps [simp_of_set reach_invariant_def];
   36.34 -
   36.35 -Goal "Rprg : Always reach_invariant";
   36.36 -by (always_tac 1);
   36.37 -by (blast_tac (claset() addIs [rtrancl_trans]) 1);
   36.38 -qed "reach_invariant";
   36.39 -
   36.40 -
   36.41 -(*** Fixedpoint ***)
   36.42 -
   36.43 -(*If it reaches a fixedpoint, it has found a solution*)
   36.44 -Goalw [fixedpoint_def]
   36.45 -     "fixedpoint Int reach_invariant = { %v. (init, v) : edges^* }";
   36.46 -by (rtac equalityI 1);
   36.47 -by (auto_tac (claset() addSIs [ext], simpset()));
   36.48 -by (blast_tac (claset() addIs [rtrancl_trans]) 2);
   36.49 -by (etac rtrancl_induct 1);
   36.50 -by Auto_tac;
   36.51 -qed "fixedpoint_invariant_correct";
   36.52 -
   36.53 -Goalw [FP_def, fixedpoint_def, stable_def, constrains_def, Rprg_def]
   36.54 -     "FP Rprg <= fixedpoint";
   36.55 -by Auto_tac;
   36.56 -by (dtac bspec 1 THEN atac 1);
   36.57 -by (asm_full_simp_tac (simpset() addsimps [Image_singleton, image_iff]) 1);
   36.58 -by (dtac fun_cong 1);
   36.59 -by Auto_tac;
   36.60 -val lemma1 = result();
   36.61 -
   36.62 -Goalw [FP_def, fixedpoint_def, stable_def, constrains_def, Rprg_def]
   36.63 -     "fixedpoint <= FP Rprg";
   36.64 -by (auto_tac (claset() addSIs [ext], simpset()));
   36.65 -val lemma2 = result();
   36.66 -
   36.67 -Goal "FP Rprg = fixedpoint";
   36.68 -by (rtac ([lemma1,lemma2] MRS equalityI) 1);
   36.69 -qed "FP_fixedpoint";
   36.70 -
   36.71 -
   36.72 -(*If we haven't reached a fixedpoint then there is some edge for which u but
   36.73 -  not v holds.  Progress will be proved via an ENSURES assertion that the
   36.74 -  metric will decrease for each suitable edge.  A union over all edges proves
   36.75 -  a LEADSTO assertion that the metric decreases if we are not at a fixedpoint.
   36.76 -  *)
   36.77 -
   36.78 -Goal "- fixedpoint = (UN (u,v): edges. {s. s u & ~ s v})";
   36.79 -by (simp_tac (simpset() addsimps
   36.80 -	      [Compl_FP, UN_UN_flatten, FP_fixedpoint RS sym, Rprg_def]) 1);
   36.81 -by Auto_tac;
   36.82 -by (rtac fun_upd_idem 1);
   36.83 -by Auto_tac;
   36.84 -by (force_tac (claset() addSIs [rev_bexI], 
   36.85 -	       simpset() addsimps [fun_upd_idem_iff]) 1);
   36.86 -qed "Compl_fixedpoint";
   36.87 -
   36.88 -Goal "A - fixedpoint = (UN (u,v): edges. A Int {s. s u & ~ s v})";
   36.89 -by (simp_tac (simpset() addsimps [Diff_eq, Compl_fixedpoint]) 1);
   36.90 -by (Blast_tac 1);
   36.91 -qed "Diff_fixedpoint";
   36.92 -
   36.93 -
   36.94 -(*** Progress ***)
   36.95 -
   36.96 -Goalw [metric_def] "~ s x ==> Suc (metric (s(x:=True))) = metric s";
   36.97 -by (subgoal_tac "{v. ~ (s(x:=True)) v} = {v. ~ s v} - {x}" 1);
   36.98 -by (Force_tac 2);
   36.99 -by (asm_full_simp_tac (simpset() addsimps [card_Suc_Diff1]) 1);
  36.100 -qed "Suc_metric";
  36.101 -
  36.102 -Goal "~ s x ==> metric (s(x:=True)) < metric s";
  36.103 -by (etac (Suc_metric RS subst) 1);
  36.104 -by (Blast_tac 1);
  36.105 -qed "metric_less";
  36.106 -AddSIs [metric_less];
  36.107 -
  36.108 -Goal "metric (s(y:=s x | s y)) <= metric s";
  36.109 -by (case_tac "s x --> s y" 1);
  36.110 -by (auto_tac (claset() addIs [less_imp_le],
  36.111 -	      simpset() addsimps [fun_upd_idem]));
  36.112 -qed "metric_le";
  36.113 -
  36.114 -Goal "Rprg : ((metric-`{m}) - fixedpoint) LeadsTo (metric-`(lessThan m))";
  36.115 -by (simp_tac (simpset() addsimps [Diff_fixedpoint]) 1);
  36.116 -by (rtac LeadsTo_UN 1);
  36.117 -by Auto_tac;
  36.118 -by (ensures_tac "asgt a b" 1);
  36.119 -by (Blast_tac 2);
  36.120 -by (full_simp_tac (simpset() addsimps [not_less_iff_le]) 1);
  36.121 -by (dtac (metric_le RS order_antisym) 1);
  36.122 -by (auto_tac (claset() addEs [less_not_refl3 RSN (2, rev_notE)],
  36.123 -	      simpset()));
  36.124 -qed "LeadsTo_Diff_fixedpoint";
  36.125 -
  36.126 -Goal "Rprg : (metric-`{m}) LeadsTo (metric-`(lessThan m) Un fixedpoint)";
  36.127 -by (rtac ([LeadsTo_Diff_fixedpoint RS LeadsTo_weaken_R,
  36.128 -	   subset_imp_LeadsTo] MRS LeadsTo_Diff) 1);
  36.129 -by Auto_tac;
  36.130 -qed "LeadsTo_Un_fixedpoint";
  36.131 -
  36.132 -
  36.133 -(*Execution in any state leads to a fixedpoint (i.e. can terminate)*)
  36.134 -Goal "Rprg : UNIV LeadsTo fixedpoint";
  36.135 -by (rtac LessThan_induct 1);
  36.136 -by Auto_tac;
  36.137 -by (rtac LeadsTo_Un_fixedpoint 1);
  36.138 -qed "LeadsTo_fixedpoint";
  36.139 -
  36.140 -Goal "Rprg : UNIV LeadsTo { %v. (init, v) : edges^* }";
  36.141 -by (stac (fixedpoint_invariant_correct RS sym) 1);
  36.142 -by (rtac ([reach_invariant, LeadsTo_fixedpoint] 
  36.143 -	  MRS Always_LeadsTo_weaken) 1); 
  36.144 -by Auto_tac;
  36.145 -qed "LeadsTo_correct";
    37.1 --- a/src/HOL/UNITY/Reach.thy	Mon Mar 05 12:31:31 2001 +0100
    37.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.3 @@ -1,43 +0,0 @@
    37.4 -(*  Title:      HOL/UNITY/Reach.thy
    37.5 -    ID:         $Id$
    37.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    37.7 -    Copyright   1998  University of Cambridge
    37.8 -
    37.9 -Reachability in Directed Graphs.  From Chandy and Misra, section 6.4.
   37.10 -*)
   37.11 -
   37.12 -Reach = FP + SubstAx +
   37.13 -
   37.14 -types   vertex
   37.15 -        state = "vertex=>bool"
   37.16 -
   37.17 -arities vertex :: term
   37.18 -
   37.19 -consts
   37.20 -  init ::  "vertex"
   37.21 -
   37.22 -  edges :: "(vertex*vertex) set"
   37.23 -
   37.24 -constdefs
   37.25 -
   37.26 -  asgt  :: "[vertex,vertex] => (state*state) set"
   37.27 -    "asgt u v == {(s,s'). s' = s(v:= s u | s v)}"
   37.28 -
   37.29 -  Rprg :: state program
   37.30 -    "Rprg == mk_program ({%v. v=init}, UN (u,v): edges. {asgt u v}, UNIV)"
   37.31 -
   37.32 -  reach_invariant :: state set
   37.33 -    "reach_invariant == {s. (ALL v. s v --> (init, v) : edges^*) & s init}"
   37.34 -
   37.35 -  fixedpoint :: state set
   37.36 -    "fixedpoint == {s. ALL (u,v): edges. s u --> s v}"
   37.37 -
   37.38 -  metric :: state => nat
   37.39 -    "metric s == card {v. ~ s v}"
   37.40 -
   37.41 -rules
   37.42 -
   37.43 -  (*We assume that the set of vertices is finite*)
   37.44 -  finite_graph "finite (UNIV :: vertex set)"
   37.45 -  
   37.46 -end
    38.1 --- a/src/HOL/UNITY/Reachability.ML	Mon Mar 05 12:31:31 2001 +0100
    38.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.3 @@ -1,308 +0,0 @@
    38.4 -(*  Title:      HOL/UNITY/Reachability
    38.5 -    ID:         $Id$
    38.6 -    Author:     Tanja Vos, Cambridge University Computer Laboratory
    38.7 -    Copyright   2000  University of Cambridge
    38.8 -
    38.9 -Reachability in Graphs
   38.10 -
   38.11 -From Chandy and Misra, "Parallel Program Design" (1989), sections 6.2 and 11.3
   38.12 -*)
   38.13 -
   38.14 -bind_thm("E_imp_in_V_L", Graph2 RS conjunct1);
   38.15 -bind_thm("E_imp_in_V_R", Graph2 RS conjunct2);
   38.16 -
   38.17 -Goal "(v,w) : E ==> F : reachable v LeadsTo nmsg_eq 0 (v,w) Int reachable v";
   38.18 -by (rtac (MA7 RS PSP_Stable RS LeadsTo_weaken_L) 1);
   38.19 -by (rtac MA6 3);
   38.20 -by (auto_tac (claset(), simpset() addsimps [E_imp_in_V_L, E_imp_in_V_R]));
   38.21 -qed "lemma2";
   38.22 -
   38.23 -Goal "(v,w) : E ==> F : reachable v LeadsTo reachable w";
   38.24 -by (rtac (MA4 RS Always_LeadsTo_weaken) 1);
   38.25 -by (rtac lemma2 2);
   38.26 -by (auto_tac (claset(), simpset() addsimps [nmsg_eq_def, nmsg_gt_def]));
   38.27 -qed "Induction_base";
   38.28 -
   38.29 -Goal "(v,w) : REACHABLE ==> F : reachable v LeadsTo reachable w";
   38.30 -by (etac REACHABLE.induct 1);
   38.31 -by (rtac subset_imp_LeadsTo 1);
   38.32 -by (Blast_tac 1);
   38.33 -by (blast_tac (claset() addIs [LeadsTo_Trans, Induction_base]) 1);
   38.34 -qed "REACHABLE_LeadsTo_reachable";
   38.35 -
   38.36 -Goal "F : {s. (root,v) : REACHABLE} LeadsTo reachable v";
   38.37 -by (rtac single_LeadsTo_I 1);
   38.38 -by (full_simp_tac (simpset() addsplits [split_if_asm]) 1);
   38.39 -by (rtac (MA1 RS Always_LeadsToI) 1);
   38.40 -by (etac (REACHABLE_LeadsTo_reachable RS LeadsTo_weaken_L) 1);
   38.41 -by Auto_tac;
   38.42 -qed "Detects_part1";
   38.43 -
   38.44 -
   38.45 -Goalw [Detects_def]
   38.46 -     "v : V ==> F : (reachable v) Detects {s. (root,v) : REACHABLE}";
   38.47 -by Auto_tac;
   38.48 -by (blast_tac (claset() addIs [MA2 RS Always_weaken]) 2);
   38.49 -by (rtac (Detects_part1 RS LeadsTo_weaken_L) 1);
   38.50 -by (Blast_tac 1);
   38.51 -qed "Reachability_Detected";
   38.52 -
   38.53 -
   38.54 -Goal "v : V ==> F : UNIV LeadsTo (reachable v <==> {s. (root,v) : REACHABLE})";
   38.55 -by (etac (Reachability_Detected RS Detects_Imp_LeadstoEQ) 1);
   38.56 -qed "LeadsTo_Reachability";
   38.57 -
   38.58 -(* ------------------------------------ *)
   38.59 -
   38.60 -(* Some lemmas about <==> *)
   38.61 -
   38.62 -Goalw [Equality_def]
   38.63 -     "(reachable v <==> {s. (root,v) : REACHABLE}) = \
   38.64 -\     {s. ((s : reachable v) = ((root,v) : REACHABLE))}";
   38.65 -by (Blast_tac 1);
   38.66 -qed "Eq_lemma1";
   38.67 -
   38.68 -
   38.69 -Goalw [Equality_def]
   38.70 -     "(reachable v <==> (if (root,v) : REACHABLE then UNIV else {})) = \
   38.71 -\     {s. ((s : reachable v) = ((root,v) : REACHABLE))}";
   38.72 -by Auto_tac;
   38.73 -qed "Eq_lemma2";
   38.74 -
   38.75 -(* ------------------------------------ *)
   38.76 -
   38.77 -
   38.78 -(* Some lemmas about final (I don't need all of them!)  *)
   38.79 -
   38.80 -Goalw [final_def, Equality_def]
   38.81 -     "(INT v: V. INT w:V. {s. ((s : reachable v) = ((root,v) : REACHABLE)) & \
   38.82 -\                             s : nmsg_eq 0 (v,w)}) \
   38.83 -\     <= final";
   38.84 -by Auto_tac;
   38.85 -by (ftac E_imp_in_V_R 1);
   38.86 -by (ftac E_imp_in_V_L 1);
   38.87 -by (Blast_tac 1);
   38.88 -qed "final_lemma1";
   38.89 -
   38.90 -Goalw [final_def, Equality_def] 
   38.91 - "E~={} \
   38.92 -\ ==> (INT v: V. INT e: E. {s. ((s : reachable v) = ((root,v) : REACHABLE))} \
   38.93 -\                          Int nmsg_eq 0 e)    <=  final";
   38.94 -by (auto_tac (claset(), simpset() addsplits [split_if_asm]));
   38.95 -by (ftac E_imp_in_V_L 1);
   38.96 -by (Blast_tac 1);
   38.97 -qed "final_lemma2";
   38.98 -
   38.99 -Goal "E~={} \
  38.100 -\     ==> (INT v: V. INT e: E. \
  38.101 -\          (reachable v <==> {s. (root,v) : REACHABLE}) Int nmsg_eq 0 e) \
  38.102 -\         <= final";
  38.103 -by (ftac final_lemma2 1);
  38.104 -by (simp_tac (simpset() addsimps [Eq_lemma2]) 1);
  38.105 -qed "final_lemma3";
  38.106 -
  38.107 -
  38.108 -Goal "E~={} \
  38.109 -\     ==> (INT v: V. INT e: E. \
  38.110 -\          {s. ((s : reachable v) = ((root,v) : REACHABLE))} Int nmsg_eq 0 e) \
  38.111 -\         = final";
  38.112 -by (rtac subset_antisym 1);
  38.113 -by (etac final_lemma2 1);
  38.114 -by (rewrite_goals_tac [final_def,Equality_def]);
  38.115 -by (Blast_tac 1); 
  38.116 -qed "final_lemma4";
  38.117 -
  38.118 -Goal "E~={} \
  38.119 -\     ==> (INT v: V. INT e: E. \
  38.120 -\          ((reachable v) <==> {s. (root,v) : REACHABLE}) Int nmsg_eq 0 e) \
  38.121 -\         = final";
  38.122 -by (ftac final_lemma4 1);
  38.123 -by (simp_tac (simpset() addsimps [Eq_lemma2]) 1);
  38.124 -qed "final_lemma5";
  38.125 -
  38.126 -
  38.127 -Goal "(INT v: V. INT w: V. \
  38.128 -\      (reachable v <==> {s. (root,v) : REACHABLE}) Int nmsg_eq 0 (v,w)) \
  38.129 -\     <= final";
  38.130 -by (simp_tac (simpset() addsimps [Eq_lemma2, Int_def]) 1);
  38.131 -by (rtac final_lemma1 1);
  38.132 -qed "final_lemma6";
  38.133 -
  38.134 -
  38.135 -Goalw [final_def] 
  38.136 -     "final = \
  38.137 -\     (INT v: V. INT w: V. \
  38.138 -\      ((reachable v) <==> {s. (root,v) : REACHABLE}) Int \
  38.139 -\      (-{s. (v,w) : E} Un (nmsg_eq 0 (v,w))))";
  38.140 -by (rtac subset_antisym 1);
  38.141 -by (Blast_tac 1);
  38.142 -by (auto_tac (claset(), simpset() addsplits [split_if_asm]));
  38.143 -by (ftac E_imp_in_V_R 1);
  38.144 -by (ftac E_imp_in_V_L 1);
  38.145 -by (Blast_tac 1);
  38.146 -qed "final_lemma7"; 
  38.147 -
  38.148 -(* ------------------------------------ *)
  38.149 -
  38.150 -
  38.151 -(* ------------------------------------ *)
  38.152 -
  38.153 -(* Stability theorems *)
  38.154 -
  38.155 -
  38.156 -Goal "[| v : V; (root,v) ~: REACHABLE |] ==> F : Stable (- reachable v)";
  38.157 -by (dtac (MA2 RS AlwaysD) 1);
  38.158 -by Auto_tac;
  38.159 -qed "not_REACHABLE_imp_Stable_not_reachable";
  38.160 -
  38.161 -Goal "v : V ==> F : Stable (reachable v <==> {s. (root,v) : REACHABLE})";
  38.162 -by (simp_tac (simpset() addsimps [Equality_def, Eq_lemma2]) 1);
  38.163 -by (blast_tac (claset() addIs [MA6,not_REACHABLE_imp_Stable_not_reachable]) 1);
  38.164 -qed "Stable_reachable_EQ_R";
  38.165 -
  38.166 -
  38.167 -Goalw [nmsg_gte_def, nmsg_lte_def,nmsg_gt_def, nmsg_eq_def]
  38.168 -     "((nmsg_gte 0 (v,w) Int nmsg_lte 1 (v,w)) Int (- nmsg_gt 0 (v,w) Un A)) \
  38.169 -\     <= A Un nmsg_eq 0 (v,w)";
  38.170 -by Auto_tac;
  38.171 -qed "lemma4";
  38.172 -
  38.173 -
  38.174 -Goalw [nmsg_gte_def,nmsg_lte_def,nmsg_gt_def, nmsg_eq_def]
  38.175 -     "reachable v Int nmsg_eq 0 (v,w) = \
  38.176 -\     ((nmsg_gte 0 (v,w) Int nmsg_lte 1 (v,w)) Int \
  38.177 -\      (reachable v Int nmsg_lte 0 (v,w)))";
  38.178 -by Auto_tac;
  38.179 -qed "lemma5";
  38.180 -
  38.181 -Goalw [nmsg_gte_def,nmsg_lte_def,nmsg_gt_def, nmsg_eq_def]
  38.182 -     "- nmsg_gt 0 (v,w) Un reachable v <= nmsg_eq 0 (v,w) Un reachable v";
  38.183 -by Auto_tac;
  38.184 -qed "lemma6";
  38.185 -
  38.186 -Goal "[|v : V; w : V|] ==> F : Always (reachable v Un nmsg_eq 0 (v,w))";
  38.187 -by (rtac ([MA5, MA3] MRS Always_Int_I RS Always_weaken) 1);
  38.188 -by (rtac lemma4 5); 
  38.189 -by Auto_tac;
  38.190 -qed "Always_reachable_OR_nmsg_0";
  38.191 -
  38.192 -Goal "[|v : V; w : V|] ==> F : Stable (reachable v Int nmsg_eq 0 (v,w))";
  38.193 -by (stac lemma5 1);
  38.194 -by (blast_tac (claset() addIs [MA5, Always_imp_Stable RS Stable_Int, MA6b]) 1);
  38.195 -qed "Stable_reachable_AND_nmsg_0";
  38.196 -
  38.197 -Goal "[|v : V; w : V|] ==> F : Stable (nmsg_eq 0 (v,w) Un reachable v)";
  38.198 -by (blast_tac (claset() addSIs [Always_weaken RS Always_imp_Stable,
  38.199 -			       lemma6, MA3]) 1);
  38.200 -qed "Stable_nmsg_0_OR_reachable";
  38.201 -
  38.202 -Goal "[| v : V; w:V; (root,v) ~: REACHABLE |] \
  38.203 -\     ==> F : Stable (- reachable v Int nmsg_eq 0 (v,w))";
  38.204 -by (rtac ([MA2 RS Always_imp_Stable, Stable_nmsg_0_OR_reachable] MRS 
  38.205 -	  Stable_Int RS Stable_eq) 1);
  38.206 -by (Blast_tac 4);
  38.207 -by Auto_tac;
  38.208 -qed "not_REACHABLE_imp_Stable_not_reachable_AND_nmsg_0";
  38.209 -
  38.210 -Goal "[| v : V; w:V |] \
  38.211 -\     ==> F : Stable ((reachable v <==> {s. (root,v) : REACHABLE}) Int \
  38.212 -\                     nmsg_eq 0 (v,w))";
  38.213 -by (asm_simp_tac
  38.214 -    (simpset() addsimps [Equality_def, Eq_lemma2,
  38.215 -			 not_REACHABLE_imp_Stable_not_reachable_AND_nmsg_0,
  38.216 -			 Stable_reachable_AND_nmsg_0]) 1);
  38.217 -qed "Stable_reachable_EQ_R_AND_nmsg_0";
  38.218 -
  38.219 -
  38.220 -(* ------------------------------------ *)
  38.221 -
  38.222 -
  38.223 -(* LeadsTo final predicate (Exercise 11.2 page 274) *)
  38.224 -
  38.225 -Goal "UNIV <= (INT v: V. UNIV)";
  38.226 -by (Blast_tac 1);
  38.227 -val UNIV_lemma = result();
  38.228 -
  38.229 -val UNIV_LeadsTo_completion = 
  38.230 -    [Finite_stable_completion, UNIV_lemma] MRS LeadsTo_weaken_L;
  38.231 -
  38.232 -Goalw [final_def] "E={} ==> F : UNIV LeadsTo final";
  38.233 -by (Asm_full_simp_tac 1);
  38.234 -by (rtac UNIV_LeadsTo_completion 1);
  38.235 -by Safe_tac;
  38.236 -by (etac (simplify (simpset()) LeadsTo_Reachability) 1);
  38.237 -by (dtac Stable_reachable_EQ_R 1);
  38.238 -by (Asm_full_simp_tac 1);
  38.239 -qed "LeadsTo_final_E_empty";
  38.240 -
  38.241 -
  38.242 -Goal "[| v : V; w:V |] \
  38.243 -\  ==> F : UNIV LeadsTo \
  38.244 -\          ((reachable v <==> {s. (root,v): REACHABLE}) Int nmsg_eq 0 (v,w))";
  38.245 -by (rtac (LeadsTo_Reachability RS LeadsTo_Trans) 1);
  38.246 -by (Blast_tac 1);
  38.247 -by (subgoal_tac "F : (reachable v <==> {s. (root,v) : REACHABLE}) Int UNIV LeadsTo (reachable v <==> {s. (root,v) : REACHABLE}) Int nmsg_eq 0 (v,w)" 1);
  38.248 -by (Asm_full_simp_tac 1);
  38.249 -by (rtac PSP_Stable2 1);
  38.250 -by (rtac MA7 1); 
  38.251 -by (rtac Stable_reachable_EQ_R 3);
  38.252 -by Auto_tac;
  38.253 -qed "Leadsto_reachability_AND_nmsg_0";
  38.254 -
  38.255 -
  38.256 -Goal "E~={} ==> F : UNIV LeadsTo final";
  38.257 -by (rtac ([LeadsTo_weaken_R, UNIV_lemma] MRS LeadsTo_weaken_L) 1);
  38.258 -by (rtac final_lemma6 2);
  38.259 -by (rtac Finite_stable_completion 1);
  38.260 -by (Blast_tac 1); 
  38.261 -by (rtac UNIV_LeadsTo_completion 1);
  38.262 -by (REPEAT
  38.263 -    (blast_tac (claset() addIs [Stable_INT,
  38.264 -				Stable_reachable_EQ_R_AND_nmsg_0,
  38.265 -				Leadsto_reachability_AND_nmsg_0]) 1));
  38.266 -qed "LeadsTo_final_E_NOT_empty";
  38.267 -
  38.268 -
  38.269 -Goal "F : UNIV LeadsTo final";
  38.270 -by (case_tac "E={}" 1);
  38.271 -by (rtac LeadsTo_final_E_NOT_empty 2);
  38.272 -by (rtac LeadsTo_final_E_empty 1);
  38.273 -by Auto_tac;
  38.274 -qed "LeadsTo_final";
  38.275 -
  38.276 -(* ------------------------------------ *)
  38.277 -
  38.278 -(* Stability of final (Exercise 11.2 page 274) *)
  38.279 -
  38.280 -Goalw [final_def] "E={} ==> F : Stable final";
  38.281 -by (Asm_full_simp_tac 1);
  38.282 -by (rtac Stable_INT 1); 
  38.283 -by (dtac Stable_reachable_EQ_R 1);
  38.284 -by (Asm_full_simp_tac 1);
  38.285 -qed "Stable_final_E_empty";
  38.286 -
  38.287 -
  38.288 -Goal "E~={} ==> F : Stable final";
  38.289 -by (stac final_lemma7 1); 
  38.290 -by (rtac Stable_INT 1); 
  38.291 -by (rtac Stable_INT 1); 
  38.292 -by (simp_tac (simpset() addsimps [Eq_lemma2]) 1);
  38.293 -by Safe_tac;
  38.294 -by (rtac Stable_eq 1);
  38.295 -by (subgoal_tac "({s. (s : reachable v) = ((root,v) : REACHABLE)} Int nmsg_eq 0 (v,w)) = \
  38.296 -\                ({s. (s : reachable v) = ((root,v) : REACHABLE)} Int (- UNIV Un nmsg_eq 0 (v,w)))" 2);
  38.297 -by (Blast_tac 2); by (Blast_tac 2);
  38.298 -by (rtac (simplify (simpset() addsimps [Eq_lemma2]) Stable_reachable_EQ_R_AND_nmsg_0) 1);
  38.299 -by (Blast_tac 1);by (Blast_tac 1);
  38.300 -by (rtac Stable_eq 1);
  38.301 -by (subgoal_tac "({s. (s : reachable v) = ((root,v) : REACHABLE)}) = ({s. (s : reachable v) = ((root,v) : REACHABLE)} Int (- {} Un nmsg_eq 0 (v,w)))" 2);
  38.302 -by (Blast_tac 2); by (Blast_tac 2);
  38.303 -by (rtac (simplify (simpset() addsimps [Eq_lemma2]) Stable_reachable_EQ_R) 1);
  38.304 -by Auto_tac;
  38.305 -qed "Stable_final_E_NOT_empty";
  38.306 -
  38.307 -Goal "F : Stable final";
  38.308 -by (case_tac "E={}" 1);
  38.309 -by (blast_tac (claset() addIs [Stable_final_E_NOT_empty]) 2);
  38.310 -by (blast_tac (claset() addIs [Stable_final_E_empty]) 1);
  38.311 -qed "Stable_final";
    39.1 --- a/src/HOL/UNITY/Reachability.thy	Mon Mar 05 12:31:31 2001 +0100
    39.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.3 @@ -1,72 +0,0 @@
    39.4 -(*  Title:      HOL/UNITY/Reachability
    39.5 -    ID:         $Id$
    39.6 -    Author:     Tanja Vos, Cambridge University Computer Laboratory
    39.7 -    Copyright   2000  University of Cambridge
    39.8 -
    39.9 -Reachability in Graphs
   39.10 -
   39.11 -From Chandy and Misra, "Parallel Program Design" (1989), sections 6.2 and 11.3
   39.12 -*)
   39.13 -
   39.14 -Reachability = Detects + 
   39.15 -
   39.16 -types  edge = "(vertex*vertex)"
   39.17 -
   39.18 -record state =
   39.19 -  reach :: vertex => bool
   39.20 -  nmsg  :: edge => nat
   39.21 -
   39.22 -consts REACHABLE :: edge set
   39.23 -       root :: vertex
   39.24 -       E :: edge set
   39.25 -       V :: vertex set
   39.26 -
   39.27 -inductive "REACHABLE"
   39.28 -  intrs
   39.29 -   base "v : V ==> ((v,v) : REACHABLE)"
   39.30 -   step "((u,v) : REACHABLE) & (v,w) : E ==> ((u,w) : REACHABLE)"
   39.31 -
   39.32 -constdefs
   39.33 -  reachable :: vertex => state set
   39.34 -  "reachable p == {s. reach s p}"
   39.35 -
   39.36 -  nmsg_eq :: nat => edge  => state set
   39.37 -  "nmsg_eq k == %e. {s. nmsg s e = k}"
   39.38 -
   39.39 -  nmsg_gt :: nat => edge  => state set
   39.40 -  "nmsg_gt k  == %e. {s. k < nmsg s e}"
   39.41 -
   39.42 -  nmsg_gte :: nat => edge => state set
   39.43 -  "nmsg_gte k == %e. {s. k <= nmsg s e}"
   39.44 -
   39.45 -  nmsg_lte  :: nat => edge => state set
   39.46 -  "nmsg_lte k  == %e. {s. nmsg s e <= k}"
   39.47 -
   39.48 -  
   39.49 -
   39.50 -  final :: state set
   39.51 -  "final == (INTER V (%v. reachable v <==> {s. (root, v) : REACHABLE})) Int (INTER E (nmsg_eq 0))"
   39.52 -
   39.53 -rules
   39.54 -    Graph1 "root : V"
   39.55 -
   39.56 -    Graph2 "(v,w) : E ==> (v : V) & (w : V)"
   39.57 -
   39.58 -    MA1  "F : Always (reachable root)"
   39.59 -
   39.60 -    MA2  "[|v:V|] ==> F : Always (- reachable v Un {s. ((root,v) : REACHABLE)})"
   39.61 -
   39.62 -    MA3  "[|v:V;w:V|] ==> F : Always (-(nmsg_gt 0 (v,w)) Un (reachable v))"
   39.63 -
   39.64 -    MA4  "[|(v,w) : E|] ==> F : Always (-(reachable v) Un (nmsg_gt 0 (v,w)) Un (reachable w))"
   39.65 -
   39.66 -    MA5  "[|v:V;w:V|] ==> F : Always (nmsg_gte 0 (v,w) Int nmsg_lte 1 (v,w))"
   39.67 -
   39.68 -    MA6  "[|v:V|] ==> F : Stable (reachable v)"
   39.69 -
   39.70 -    MA6b "[|v:V;w:W|] ==> F : Stable (reachable v Int nmsg_lte k (v,w))"
   39.71 -
   39.72 -    MA7  "[|v:V;w:V|] ==> F : UNIV LeadsTo nmsg_eq 0 (v,w)"
   39.73 -
   39.74 -end
   39.75 -
    40.1 --- a/src/HOL/UNITY/TimerArray.ML	Mon Mar 05 12:31:31 2001 +0100
    40.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.3 @@ -1,53 +0,0 @@
    40.4 -(*  Title:      HOL/UNITY/TimerArray.thy
    40.5 -    ID:         $Id$
    40.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    40.7 -    Copyright   1998  University of Cambridge
    40.8 -
    40.9 -A trivial example of reasoning about an array of processes
   40.10 -*)
   40.11 -
   40.12 -Addsimps [Timer_def RS def_prg_Init];
   40.13 -program_defs_ref := [Timer_def];
   40.14 -
   40.15 -Addsimps [count_def, decr_def];
   40.16 -
   40.17 -(*Demonstrates induction, but not used in the following proof*)
   40.18 -Goal "Timer : UNIV leadsTo {s. count s = 0}";
   40.19 -by (res_inst_tac [("f", "count")] lessThan_induct 1);
   40.20 -by (Simp_tac 1);
   40.21 -by (case_tac "m" 1);
   40.22 -by (force_tac (claset() addSIs [subset_imp_leadsTo], simpset()) 1);
   40.23 -by (ensures_tac "decr" 1);
   40.24 -qed "Timer_leadsTo_zero";
   40.25 -
   40.26 -Goal "Timer : preserves snd";
   40.27 -by (rtac preservesI 1);
   40.28 -by (constrains_tac 1);
   40.29 -qed "Timer_preserves_snd";
   40.30 -AddIffs [Timer_preserves_snd];
   40.31 -
   40.32 -Addsimps [PLam_stable];
   40.33 -
   40.34 -Goal "finite I \
   40.35 -\     ==> (plam i: I. Timer) : UNIV leadsTo {(s,uu). ALL i:I. s i = 0}";
   40.36 -by (eres_inst_tac [("A'1", "%i. lift_set i ({0} <*> UNIV)")]
   40.37 -    (finite_stable_completion RS leadsTo_weaken) 1);
   40.38 -by Auto_tac;
   40.39 -(*Safety property, already reduced to the single Timer case*)
   40.40 -by (constrains_tac 2);
   40.41 -(*Progress property for the array of Timers*)
   40.42 -by (res_inst_tac [("f", "sub i o fst")] lessThan_induct 1);
   40.43 -by (case_tac "m" 1);
   40.44 -(*Annoying need to massage the conditions to have the form (... <*> UNIV)*)
   40.45 -by (auto_tac (claset() addIs [subset_imp_leadsTo], 
   40.46 -	      simpset() addsimps [insert_absorb, lessThan_Suc RS sym,
   40.47 -				  lift_set_Un_distrib RS sym,
   40.48 -				  Times_Un_distrib1 RS sym,
   40.49 -				  Times_Diff_distrib1 RS sym]));
   40.50 -by (rename_tac "n" 1);
   40.51 -by (rtac PLam_leadsTo_Basis 1);
   40.52 -by (auto_tac (claset(), simpset() addsimps [lessThan_Suc RS sym]));
   40.53 -by (constrains_tac 1);
   40.54 -by (res_inst_tac [("act", "decr")] transientI 1);
   40.55 -by (auto_tac (claset(), simpset() addsimps [Timer_def]));
   40.56 -qed "TimerArray_leadsTo_zero";
    41.1 --- a/src/HOL/UNITY/TimerArray.thy	Mon Mar 05 12:31:31 2001 +0100
    41.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.3 @@ -1,23 +0,0 @@
    41.4 -(*  Title:      HOL/UNITY/TimerArray.thy
    41.5 -    ID:         $Id$
    41.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    41.7 -    Copyright   1998  University of Cambridge
    41.8 -
    41.9 -A trivial example of reasoning about an array of processes
   41.10 -*)
   41.11 -
   41.12 -TimerArray = PPROD +
   41.13 -
   41.14 -types 'a state = "nat * 'a"   (*second component allows new variables*)
   41.15 -
   41.16 -constdefs
   41.17 -  count  :: "'a state => nat"
   41.18 -    "count s == fst s"
   41.19 -  
   41.20 -  decr  :: "('a state * 'a state) set"
   41.21 -    "decr == UN n uu. {((Suc n, uu), (n,uu))}"
   41.22 -  
   41.23 -  Timer :: 'a state program
   41.24 -    "Timer == mk_program (UNIV, {decr}, UNIV)"
   41.25 -
   41.26 -end
    42.1 --- a/src/HOL/UNITY/Token.ML	Mon Mar 05 12:31:31 2001 +0100
    42.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.3 @@ -1,101 +0,0 @@
    42.4 -(*  Title:      HOL/UNITY/Token
    42.5 -    ID:         $Id$
    42.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    42.7 -    Copyright   1998  University of Cambridge
    42.8 -
    42.9 -The Token Ring.
   42.10 -
   42.11 -From Misra, "A Logic for Concurrent Programming" (1994), sections 5.2 and 13.2.
   42.12 -*)
   42.13 -
   42.14 -val Token_defs = [HasTok_def, H_def, E_def, T_def];
   42.15 -
   42.16 -Goalw [HasTok_def] "[| s: HasTok i; s: HasTok j |] ==> i=j";
   42.17 -by Auto_tac;
   42.18 -qed "HasToK_partition";
   42.19 -
   42.20 -Goalw Token_defs "(s ~: E i) = (s : H i | s : T i)";
   42.21 -by (Simp_tac 1);
   42.22 -by (case_tac "proc s i" 1);
   42.23 -by Auto_tac;
   42.24 -qed "not_E_eq";
   42.25 -
   42.26 -Open_locale "Token";
   42.27 -
   42.28 -val TR2 = thm "TR2";
   42.29 -val TR3 = thm "TR3";
   42.30 -val TR4 = thm "TR4";
   42.31 -val TR5 = thm "TR5";
   42.32 -val TR6 = thm "TR6";
   42.33 -val TR7 = thm "TR7";
   42.34 -val nodeOrder_def = thm "nodeOrder_def";
   42.35 -val next_def = thm "next_def";
   42.36 -
   42.37 -AddIffs [thm "N_positive"];
   42.38 -
   42.39 -Goalw [stable_def] "F : stable (-(E i) Un (HasTok i))";
   42.40 -by (rtac constrains_weaken 1);
   42.41 -by (rtac ([[TR2, TR4] MRS constrains_Un, TR5] MRS constrains_Un) 1);
   42.42 -by (auto_tac (claset(), simpset() addsimps [not_E_eq]));
   42.43 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [H_def, E_def, T_def])));
   42.44 -qed "token_stable";
   42.45 -
   42.46 -
   42.47 -(*** Progress under weak fairness ***)
   42.48 -
   42.49 -Goalw [nodeOrder_def] "wf(nodeOrder j)";
   42.50 -by (rtac (wf_less_than RS wf_inv_image RS wf_subset) 1);
   42.51 -by (Blast_tac 1);
   42.52 -qed"wf_nodeOrder";
   42.53 -
   42.54 -Goalw [nodeOrder_def, next_def, inv_image_def]
   42.55 -    "[| i<N; j<N |] ==> ((next i, i) : nodeOrder j) = (i ~= j)";
   42.56 -by (auto_tac (claset(), simpset() addsimps [mod_Suc, mod_geq]));
   42.57 -by (auto_tac (claset(), 
   42.58 -              simpset() addsplits [nat_diff_split]
   42.59 -                        addsimps [linorder_neq_iff, mod_geq]));
   42.60 -qed "nodeOrder_eq";
   42.61 -
   42.62 -(*From "A Logic for Concurrent Programming", but not used in Chapter 4.
   42.63 -  Note the use of case_tac.  Reasoning about leadsTo takes practice!*)
   42.64 -Goal "[| i<N; j<N |] ==>   \
   42.65 -\     F : (HasTok i) leadsTo ({s. (token s, i) : nodeOrder j} Un HasTok j)";
   42.66 -by (case_tac "i=j" 1);
   42.67 -by (blast_tac (claset() addIs [subset_imp_leadsTo]) 1);
   42.68 -by (rtac (TR7 RS leadsTo_weaken_R) 1);
   42.69 -by (auto_tac (claset(), simpset() addsimps [HasTok_def, nodeOrder_eq]));
   42.70 -qed "TR7_nodeOrder";
   42.71 -
   42.72 -
   42.73 -(*Chapter 4 variant, the one actually used below.*)
   42.74 -Goal "[| i<N; j<N; i~=j |]    \
   42.75 -\     ==> F : (HasTok i) leadsTo {s. (token s, i) : nodeOrder j}";
   42.76 -by (rtac (TR7 RS leadsTo_weaken_R) 1);
   42.77 -by (auto_tac (claset(), simpset() addsimps [HasTok_def, nodeOrder_eq]));
   42.78 -qed "TR7_aux";
   42.79 -
   42.80 -Goal "({s. token s < N} Int token -` {m}) = (if m<N then token -` {m} else {})";
   42.81 -by Auto_tac;
   42.82 -val token_lemma = result();
   42.83 -
   42.84 -
   42.85 -(*Misra's TR9: the token reaches an arbitrary node*)
   42.86 -Goal "j<N ==> F : {s. token s < N} leadsTo (HasTok j)";
   42.87 -by (rtac leadsTo_weaken_R 1);
   42.88 -by (res_inst_tac [("I", "-{j}"), ("f", "token"), ("B", "{}")]
   42.89 -     (wf_nodeOrder RS bounded_induct) 1);
   42.90 -by (ALLGOALS (asm_simp_tac (simpset() addsimps [token_lemma, vimage_Diff,
   42.91 -						HasTok_def])));
   42.92 -by (Blast_tac 2);
   42.93 -by (Clarify_tac 1);
   42.94 -by (rtac (TR7_aux RS leadsTo_weaken) 1);
   42.95 -by (auto_tac (claset(), simpset() addsimps [HasTok_def, nodeOrder_def]));
   42.96 -qed "leadsTo_j";
   42.97 -
   42.98 -(*Misra's TR8: a hungry process eventually eats*)
   42.99 -Goal "j<N ==> F : ({s. token s < N} Int H j) leadsTo (E j)";
  42.100 -by (rtac (leadsTo_cancel1 RS leadsTo_Un_duplicate) 1);
  42.101 -by (rtac TR6 2);
  42.102 -by (rtac ([leadsTo_j, TR3] MRS psp RS leadsTo_weaken) 1);
  42.103 -by (ALLGOALS Blast_tac);
  42.104 -qed "token_progress";
    43.1 --- a/src/HOL/UNITY/Token.thy	Mon Mar 05 12:31:31 2001 +0100
    43.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.3 @@ -1,66 +0,0 @@
    43.4 -(*  Title:      HOL/UNITY/Token
    43.5 -    ID:         $Id$
    43.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    43.7 -    Copyright   1998  University of Cambridge
    43.8 -
    43.9 -The Token Ring.
   43.10 -
   43.11 -From Misra, "A Logic for Concurrent Programming" (1994), sections 5.2 and 13.2.
   43.12 -*)
   43.13 -
   43.14 -
   43.15 -Token = WFair + 
   43.16 -
   43.17 -(*process states*)
   43.18 -datatype pstate = Hungry | Eating | Thinking
   43.19 -
   43.20 -record state =
   43.21 -  token :: nat
   43.22 -  proc  :: nat => pstate
   43.23 -
   43.24 -
   43.25 -constdefs
   43.26 -  HasTok :: nat => state set
   43.27 -    "HasTok i == {s. token s = i}"
   43.28 -
   43.29 -  H :: nat => state set
   43.30 -    "H i == {s. proc s i = Hungry}"
   43.31 -
   43.32 -  E :: nat => state set
   43.33 -    "E i == {s. proc s i = Eating}"
   43.34 -
   43.35 -  T :: nat => state set
   43.36 -    "T i == {s. proc s i = Thinking}"
   43.37 -
   43.38 -
   43.39 -locale Token =
   43.40 -  fixes
   43.41 -    N         :: nat	 (*number of nodes in the ring*)
   43.42 -    F         :: state program
   43.43 -    nodeOrder :: "nat => (nat*nat)set"
   43.44 -    next      :: nat => nat
   43.45 -
   43.46 -  assumes
   43.47 -    N_positive "0<N"
   43.48 -
   43.49 -    TR2  "F : (T i) co (T i Un H i)"
   43.50 -
   43.51 -    TR3  "F : (H i) co (H i Un E i)"
   43.52 -
   43.53 -    TR4  "F : (H i - HasTok i) co (H i)"
   43.54 -
   43.55 -    TR5  "F : (HasTok i) co (HasTok i Un -(E i))"
   43.56 -
   43.57 -    TR6  "F : (H i Int HasTok i) leadsTo (E i)"
   43.58 -
   43.59 -    TR7  "F : (HasTok i) leadsTo (HasTok (next i))"
   43.60 -
   43.61 -  defines
   43.62 -    nodeOrder_def
   43.63 -      "nodeOrder j == (inv_image less_than (%i. ((j+N)-i) mod N))  Int
   43.64 -		      (lessThan N <*> lessThan N)"
   43.65 -
   43.66 -    next_def
   43.67 -      "next i == (Suc i) mod N"
   43.68 -
   43.69 -end