| author | wenzelm | 
| Mon, 11 Sep 2000 17:40:41 +0200 | |
| changeset 9919 | 3cf12ab0b8ac | 
| parent 9403 | aad13b59b8d9 | 
| child 10064 | 1a77667b21ef | 
| permissions | -rw-r--r-- | 
| 6828 | 1 | (* Title: HOL/UNITY/Alloc | 
| 2 | ID: $Id$ | |
| 3 | Author: Lawrence C Paulson, Cambridge University Computer Laboratory | |
| 4 | Copyright 1998 University of Cambridge | |
| 5 | ||
| 6 | Specification of Chandy and Charpentier's Allocator | |
| 7 | *) | |
| 8 | ||
| 8948 
b797cfa3548d
restructuring: LessThan.ML mostly moved to HOL/SetInterval.ML
 paulson parents: 
8930diff
changeset | 9 | (*Perhaps equalities.ML shouldn't add this in the first place!*) | 
| 
b797cfa3548d
restructuring: LessThan.ML mostly moved to HOL/SetInterval.ML
 paulson parents: 
8930diff
changeset | 10 | Delsimps [image_Collect]; | 
| 
b797cfa3548d
restructuring: LessThan.ML mostly moved to HOL/SetInterval.ML
 paulson parents: 
8930diff
changeset | 11 | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 12 | AddIs [impOfSubs subset_preserves_o]; | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 13 | Addsimps [funPair_o_distrib]; | 
| 8327 | 14 | Addsimps [Always_INT_distrib]; | 
| 8067 | 15 | Delsimps [o_apply]; | 
| 16 | ||
| 8314 | 17 | (*Eliminate the "o" operator*) | 
| 7841 | 18 | val o_simp = simplify (simpset() addsimps [o_def]); | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 19 | |
| 8314 | 20 | (*For rewriting of specifications related by "guarantees"*) | 
| 21 | Addsimps [rename_image_constrains, rename_image_stable, | |
| 22 | rename_image_increasing, rename_image_invariant, | |
| 23 | rename_image_Constrains, rename_image_Stable, | |
| 24 | rename_image_Increasing, rename_image_Always, | |
| 8327 | 25 | rename_image_leadsTo, rename_image_LeadsTo, | 
| 26 | rename_preserves, | |
| 27 | bij_image_INT, bij_is_inj RS image_Int, bij_image_Collect_eq]; | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 28 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 29 | (*Splits up conjunctions & intersections: like CONJUNCTS in the HOL system*) | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 30 | fun list_of_Int th = | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 31 | (list_of_Int (th RS conjunct1) @ list_of_Int (th RS conjunct2)) | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 32 | handle THM _ => (list_of_Int (th RS IntD1) @ list_of_Int (th RS IntD2)) | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 33 | handle THM _ => (list_of_Int (th RS INT_D)) | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 34 | handle THM _ => [th]; | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 35 | |
| 8314 | 36 | (*Used just once, for Alloc_Increasing*) | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 37 | val lessThanBspec = lessThan_iff RS iffD2 RSN (2, bspec); | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 38 | fun normalize th = | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 39 | normalize (th RS spec | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 40 | handle THM _ => th RS lessThanBspec | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 41 | handle THM _ => th RS bspec | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 42 | handle THM _ => th RS (guarantees_INT_right_iff RS iffD1)) | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 43 | handle THM _ => th; | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 44 | |
| 8067 | 45 | |
| 8314 | 46 | |
| 47 | (*** bijectivity of sysOfAlloc [MUST BE AUTOMATED] ***) | |
| 48 | ||
| 8849 | 49 | val record_auto_tac = | 
| 50 | auto_tac (claset() addIs [ext] addSWrapper record_split_wrapper, | |
| 51 | simpset() addsimps [sysOfAlloc_def, sysOfClient_def, | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 52 | client_map_def, non_dummy_def, funPair_def, | 
| 8849 | 53 | o_apply, Let_def]); | 
| 54 | ||
| 55 | ||
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 56 | Goalw [sysOfAlloc_def, Let_def] "inj sysOfAlloc"; | 
| 6828 | 57 | by (rtac injI 1); | 
| 8849 | 58 | by record_auto_tac; | 
| 6828 | 59 | qed "inj_sysOfAlloc"; | 
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 60 | AddIffs [inj_sysOfAlloc]; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 61 | |
| 8314 | 62 | (*We need the inverse; also having it simplifies the proof of surjectivity*) | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 63 | Goal "!!s. inv sysOfAlloc s = \ | 
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 64 | \ (| allocGiv = allocGiv s, \ | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 65 | \ allocAsk = allocAsk s, \ | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 66 | \ allocRel = allocRel s, \ | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 67 | \ allocState_d.dummy = (client s, dummy s) |)"; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 68 | by (rtac (inj_sysOfAlloc RS inv_f_eq) 1); | 
| 8849 | 69 | by record_auto_tac; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 70 | qed "inv_sysOfAlloc_eq"; | 
| 7538 | 71 | Addsimps [inv_sysOfAlloc_eq]; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 72 | |
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 73 | Goal "surj sysOfAlloc"; | 
| 8327 | 74 | by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1); | 
| 8849 | 75 | by record_auto_tac; | 
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 76 | qed "surj_sysOfAlloc"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 77 | AddIffs [surj_sysOfAlloc]; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 78 | |
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 79 | Goal "bij sysOfAlloc"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 80 | by (blast_tac (claset() addIs [bijI]) 1); | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 81 | qed "bij_sysOfAlloc"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 82 | AddIffs [bij_sysOfAlloc]; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 83 | |
| 8314 | 84 | |
| 85 | (*** bijectivity of sysOfClient ***) | |
| 86 | ||
| 7347 | 87 | Goalw [sysOfClient_def] "inj sysOfClient"; | 
| 88 | by (rtac injI 1); | |
| 8849 | 89 | by record_auto_tac; | 
| 7347 | 90 | qed "inj_sysOfClient"; | 
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 91 | AddIffs [inj_sysOfClient]; | 
| 6828 | 92 | |
| 7347 | 93 | Goal "!!s. inv sysOfClient s = \ | 
| 94 | \ (client s, \ | |
| 95 | \ (| allocGiv = allocGiv s, \ | |
| 96 | \ allocAsk = allocAsk s, \ | |
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 97 | \ allocRel = allocRel s, \ | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 98 | \ allocState_d.dummy = systemState.dummy s|) )"; | 
| 7347 | 99 | by (rtac (inj_sysOfClient RS inv_f_eq) 1); | 
| 8849 | 100 | by record_auto_tac; | 
| 7365 | 101 | qed "inv_sysOfClient_eq"; | 
| 7689 | 102 | Addsimps [inv_sysOfClient_eq]; | 
| 6837 | 103 | |
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 104 | Goal "surj sysOfClient"; | 
| 8327 | 105 | by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1); | 
| 8849 | 106 | by record_auto_tac; | 
| 8286 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 107 | qed "surj_sysOfClient"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 108 | AddIffs [surj_sysOfClient]; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 109 | |
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 110 | Goal "bij sysOfClient"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 111 | by (blast_tac (claset() addIs [bijI]) 1); | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 112 | qed "bij_sysOfClient"; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 113 | AddIffs [bij_sysOfClient]; | 
| 
d4b895d3afa7
not working yet.  partial conversion to use "rename" instead of "extend"
 paulson parents: 
8251diff
changeset | 114 | |
| 6837 | 115 | |
| 8314 | 116 | (*** bijectivity of client_map ***) | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 117 | |
| 8849 | 118 | Goalw [inj_on_def] "inj client_map"; | 
| 119 | by record_auto_tac; | |
| 8314 | 120 | qed "inj_client_map"; | 
| 121 | AddIffs [inj_client_map]; | |
| 122 | ||
| 123 | Goal "!!s. inv client_map s = \ | |
| 124 | \ (%(x,y).(|giv = giv x, ask = ask x, rel = rel x, \ | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 125 | \ clientState_d.dummy = y|)) s"; | 
| 8314 | 126 | by (rtac (inj_client_map RS inv_f_eq) 1); | 
| 8849 | 127 | by record_auto_tac; | 
| 8314 | 128 | qed "inv_client_map_eq"; | 
| 129 | Addsimps [inv_client_map_eq]; | |
| 130 | ||
| 131 | Goal "surj client_map"; | |
| 8327 | 132 | by (simp_tac (simpset() addsimps [surj_iff, expand_fun_eq, o_apply]) 1); | 
| 8849 | 133 | by record_auto_tac; | 
| 8314 | 134 | qed "surj_client_map"; | 
| 135 | AddIffs [surj_client_map]; | |
| 136 | ||
| 137 | Goal "bij client_map"; | |
| 138 | by (blast_tac (claset() addIs [bijI]) 1); | |
| 139 | qed "bij_client_map"; | |
| 140 | AddIffs [bij_client_map]; | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 141 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 142 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 143 | (** o-simprules for client_map **) | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 144 | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 145 | Goalw [client_map_def] "fst o client_map = non_dummy"; | 
| 8327 | 146 | by (rtac fst_o_funPair 1); | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 147 | qed "fst_o_client_map"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 148 | Addsimps (make_o_equivs fst_o_client_map); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 149 | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 150 | Goalw [client_map_def] "snd o client_map = clientState_d.dummy"; | 
| 8327 | 151 | by (rtac snd_o_funPair 1); | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 152 | qed "snd_o_client_map"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 153 | Addsimps (make_o_equivs snd_o_client_map); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 154 | |
| 8327 | 155 | (** o-simprules for sysOfAlloc [MUST BE AUTOMATED] **) | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 156 | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 157 | Goal "client o sysOfAlloc = fst o allocState_d.dummy "; | 
| 8849 | 158 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 159 | qed "client_o_sysOfAlloc"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 160 | Addsimps (make_o_equivs client_o_sysOfAlloc); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 161 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 162 | Goal "allocGiv o sysOfAlloc = allocGiv"; | 
| 8849 | 163 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 164 | qed "allocGiv_o_sysOfAlloc_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 165 | Addsimps (make_o_equivs allocGiv_o_sysOfAlloc_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 166 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 167 | Goal "allocAsk o sysOfAlloc = allocAsk"; | 
| 8849 | 168 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 169 | qed "allocAsk_o_sysOfAlloc_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 170 | Addsimps (make_o_equivs allocAsk_o_sysOfAlloc_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 171 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 172 | Goal "allocRel o sysOfAlloc = allocRel"; | 
| 8849 | 173 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 174 | qed "allocRel_o_sysOfAlloc_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 175 | Addsimps (make_o_equivs allocRel_o_sysOfAlloc_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 176 | |
| 8327 | 177 | (** o-simprules for sysOfClient [MUST BE AUTOMATED] **) | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 178 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 179 | Goal "client o sysOfClient = fst"; | 
| 8849 | 180 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 181 | qed "client_o_sysOfClient"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 182 | Addsimps (make_o_equivs client_o_sysOfClient); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 183 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 184 | Goal "allocGiv o sysOfClient = allocGiv o snd "; | 
| 8849 | 185 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 186 | qed "allocGiv_o_sysOfClient_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 187 | Addsimps (make_o_equivs allocGiv_o_sysOfClient_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 188 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 189 | Goal "allocAsk o sysOfClient = allocAsk o snd "; | 
| 8849 | 190 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 191 | qed "allocAsk_o_sysOfClient_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 192 | Addsimps (make_o_equivs allocAsk_o_sysOfClient_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 193 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 194 | Goal "allocRel o sysOfClient = allocRel o snd "; | 
| 8849 | 195 | by record_auto_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 196 | qed "allocRel_o_sysOfClient_eq"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 197 | Addsimps (make_o_equivs allocRel_o_sysOfClient_eq); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 198 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 199 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 200 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 201 | (** | 
| 7365 | 202 | Open_locale "System"; | 
| 203 | ||
| 204 | val Alloc = thm "Alloc"; | |
| 205 | val Client = thm "Client"; | |
| 206 | val Network = thm "Network"; | |
| 207 | val System_def = thm "System_def"; | |
| 8314 | 208 | |
| 209 | (*CANNOT use bind_thm: it puts the theorem into standard form, in effect | |
| 210 | exporting it from the locale*) | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 211 | **) | 
| 7365 | 212 | |
| 213 | AddIffs [finite_lessThan]; | |
| 214 | ||
| 215 | (*Client : <unfolded specification> *) | |
| 216 | val Client_Spec = | |
| 217 | rewrite_rule [client_spec_def, client_increasing_def, | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 218 | client_bounded_def, client_progress_def, | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 219 | client_preserves_def] Client; | 
| 7365 | 220 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 221 | val [Client_Increasing_ask, Client_Increasing_rel, | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 222 | Client_Bounded, Client_Progress, Client_preserves_giv, | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 223 | Client_preserves_dummy] = | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 224 | Client_Spec | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 225 | |> simplify (simpset() addsimps [guarantees_Int_right]) | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 226 | |> list_of_Int; | 
| 7365 | 227 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 228 | AddIffs [Client_Increasing_ask, Client_Increasing_rel, Client_Bounded, | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 229 | Client_preserves_giv, Client_preserves_dummy]; | 
| 6828 | 230 | |
| 231 | ||
| 7365 | 232 | (*Network : <unfolded specification> *) | 
| 233 | val Network_Spec = | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 234 | rewrite_rule [network_spec_def, network_ask_def, network_giv_def, | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 235 | network_rel_def, network_preserves_def] Network; | 
| 7365 | 236 | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 237 | val [Network_Ask, Network_Giv, Network_Rel, | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 238 | Network_preserves_allocGiv, Network_preserves_rel_ask] = | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 239 | list_of_Int Network_Spec; | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 240 | |
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 241 | AddIffs [Network_preserves_allocGiv]; | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 242 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 243 | Addsimps (Network_preserves_rel_ask |> simplify (simpset()) |> list_of_Int); | 
| 7365 | 244 | |
| 245 | ||
| 246 | (*Alloc : <unfolded specification> *) | |
| 247 | val Alloc_Spec = | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 248 | rewrite_rule [alloc_spec_def, alloc_increasing_def, alloc_safety_def, | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 249 | alloc_progress_def, alloc_preserves_def] Alloc; | 
| 7365 | 250 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 251 | val [Alloc_Increasing_0, Alloc_Safety, | 
| 8069 
19b9f92ca503
working with weak LeadsTo in guarantees precondition\!
 paulson parents: 
8067diff
changeset | 252 | Alloc_Progress, Alloc_preserves] = list_of_Int Alloc_Spec; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 253 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 254 | (*Strip off the INT in the guarantees postcondition*) | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 255 | val Alloc_Increasing = normalize Alloc_Increasing_0; | 
| 7365 | 256 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 257 | AddIffs (Alloc_preserves |> simplify (simpset()) |> list_of_Int); | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 258 | |
| 8327 | 259 | (** Components lemmas [MUST BE AUTOMATED] **) | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 260 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 261 | Goal "Network Join \ | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 262 | \ ((rename sysOfClient \ | 
| 8985 | 263 | \ (plam x: (lessThan Nclients). rename client_map Client)) Join \ | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 264 | \ rename sysOfAlloc Alloc) \ | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 265 | \ = System"; | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 266 | by (simp_tac (simpset() addsimps System_def::Join_ac) 1); | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 267 | qed "Network_component_System"; | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 268 | |
| 8314 | 269 | Goal "(rename sysOfClient \ | 
| 8985 | 270 | \ (plam x: (lessThan Nclients). rename client_map Client)) Join \ | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 271 | \ (Network Join rename sysOfAlloc Alloc) = System"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 272 | by (simp_tac (simpset() addsimps System_def::Join_ac) 1); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 273 | qed "Client_component_System"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 274 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 275 | Goal "rename sysOfAlloc Alloc Join \ | 
| 8985 | 276 | \ ((rename sysOfClient (plam x: (lessThan Nclients). rename client_map Client)) Join \ | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 277 | \ Network) = System"; | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 278 | by (simp_tac (simpset() addsimps System_def::Join_ac) 1); | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 279 | qed "Alloc_component_System"; | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 280 | |
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 281 | AddIffs [Client_component_System, Network_component_System, | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 282 | Alloc_component_System]; | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 283 | |
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 284 | (** These preservation laws should be generated automatically **) | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 285 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 286 | AddIs [impOfSubs subset_preserves_o]; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 287 | Addsimps [impOfSubs subset_preserves_o]; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 288 | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 289 | |
| 8872 | 290 | (*The proofs of rename_Client_Increasing, rename_Client_Bounded and | 
| 291 | rename_Client_Progress are similar. All require copying out the original | |
| 292 | Client property. A forward proof can be constructed as follows: | |
| 8327 | 293 | |
| 294 | Client_Increasing_ask RS | |
| 295 | (bij_client_map RS rename_rename_guarantees_eq RS iffD2) | |
| 296 | RS (lift_lift_guarantees_eq RS iffD2) | |
| 297 | RS guarantees_PLam_I | |
| 298 | RS (bij_sysOfClient RS rename_rename_guarantees_eq RS iffD2) | |
| 299 | |> simplify (simpset() addsimps [lift_image_eq_rename, o_def, split_def, | |
| 300 | surj_rename RS surj_range]); | |
| 301 | ||
| 302 | However, the "preserves" property remains to be discharged, and the unfolding | |
| 303 | of "o" and "sub" complicates subsequent reasoning. | |
| 8872 | 304 | |
| 305 | The following tactic works for all three proofs, though it certainly looks | |
| 306 | ad-hoc! | |
| 8327 | 307 | *) | 
| 8872 | 308 | val rename_client_map_tac = | 
| 309 | EVERY [ | |
| 310 | simp_tac (simpset() addsimps [rename_guarantees_eq_rename_inv]) 1, | |
| 311 | rtac guarantees_PLam_I 1, | |
| 312 | assume_tac 2, | |
| 313 | (*preserves: routine reasoning*) | |
| 314 | asm_simp_tac (simpset() addsimps [lift_preserves_sub]) 2, | |
| 315 | (*the guarantee for "lift i (rename client_map Client)" *) | |
| 316 | asm_simp_tac | |
| 317 | (simpset() addsimps [lift_guarantees_eq_lift_inv, | |
| 318 | rename_guarantees_eq_rename_inv, | |
| 319 | bij_imp_bij_inv, surj_rename RS surj_range, | |
| 320 | inv_inv_eq]) 1, | |
| 321 | asm_simp_tac | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 322 | (simpset() addsimps [o_def, non_dummy_def, guarantees_Int_right]) 1]; | 
| 8872 | 323 | |
| 324 | ||
| 325 | (*Lifting Client_Increasing to systemState*) | |
| 326 | Goal "i : I \ | |
| 327 | \ ==> rename sysOfClient (plam x: I. rename client_map Client) : \ | |
| 328 | \ UNIV \ | |
| 329 | \ guarantees[(funPair rel ask) o sub i o client] \ | |
| 330 | \ Increasing (ask o sub i o client) Int \ | |
| 331 | \ Increasing (rel o sub i o client)"; | |
| 332 | by rename_client_map_tac; | |
| 333 | qed "rename_Client_Increasing"; | |
| 8327 | 334 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 335 | Goal "i < Nclients \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 336 | \ ==> System : Increasing (ask o sub i o client) Int \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 337 | \ Increasing (rel o sub i o client)"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 338 | by (rtac ([rename_Client_Increasing, | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 339 | Client_component_System] MRS component_guaranteesD) 1); | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 340 | by Auto_tac; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 341 | qed "System_Increasing"; | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 342 | |
| 8327 | 343 | bind_thm ("rename_guarantees_sysOfAlloc_I",
 | 
| 344 | bij_sysOfAlloc RS rename_rename_guarantees_eq RS iffD2); | |
| 345 | ||
| 346 | ||
| 8314 | 347 | (*Lifting Alloc_Increasing up to the level of systemState*) | 
| 348 | val rename_Alloc_Increasing = | |
| 8327 | 349 | Alloc_Increasing RS rename_guarantees_sysOfAlloc_I | 
| 350 | |> simplify (simpset() addsimps [surj_rename RS surj_range, o_def]); | |
| 8314 | 351 | |
| 7841 | 352 | Goalw [System_def] | 
| 353 | "i < Nclients ==> System : Increasing (sub i o allocGiv)"; | |
| 8314 | 354 | by (simp_tac (simpset() addsimps [o_def]) 1); | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 355 | by (rtac (rename_Alloc_Increasing RS guarantees_Join_I1 RS guaranteesD) 1); | 
| 7841 | 356 | by Auto_tac; | 
| 357 | qed "System_Increasing_allocGiv"; | |
| 7365 | 358 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 359 | AddSIs (list_of_Int System_Increasing); | 
| 6828 | 360 | |
| 7841 | 361 | (** Follows consequences. | 
| 362 | The "Always (INT ...) formulation expresses the general safety property | |
| 363 | and allows it to be combined using Always_Int_rule below. **) | |
| 364 | ||
| 8067 | 365 | Goal | 
| 366 | "i < Nclients ==> System : ((sub i o allocRel) Fols (rel o sub i o client))"; | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 367 | by (auto_tac (claset() addSIs [Network_Rel RS component_guaranteesD], | 
| 8067 | 368 | simpset())); | 
| 369 | qed "System_Follows_rel"; | |
| 370 | ||
| 371 | Goal | |
| 372 | "i < Nclients ==> System : ((sub i o allocAsk) Fols (ask o sub i o client))"; | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 373 | by (auto_tac (claset() addSIs [Network_Ask RS component_guaranteesD], | 
| 8067 | 374 | simpset())); | 
| 375 | qed "System_Follows_ask"; | |
| 376 | ||
| 377 | Goal | |
| 378 | "i < Nclients ==> System : (giv o sub i o client) Fols (sub i o allocGiv)"; | |
| 379 | by (auto_tac (claset() addSIs [Network_Giv RS component_guaranteesD, | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 380 | rename_Alloc_Increasing RS component_guaranteesD], | 
| 8067 | 381 | simpset())); | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 382 | by (ALLGOALS (simp_tac (simpset() addsimps [o_def, non_dummy_def]))); | 
| 8314 | 383 | by (auto_tac | 
| 384 | (claset() addSIs [rename_Alloc_Increasing RS component_guaranteesD], | |
| 385 | simpset())); | |
| 8067 | 386 | qed "System_Follows_allocGiv"; | 
| 387 | ||
| 8985 | 388 | Goal "System : Always (INT i: lessThan Nclients. \ | 
| 7841 | 389 | \                      {s. (giv o sub i o client) s <= (sub i o allocGiv) s})";
 | 
| 8327 | 390 | by Auto_tac; | 
| 8067 | 391 | by (etac (System_Follows_allocGiv RS Follows_Bounded) 1); | 
| 7841 | 392 | qed "Always_giv_le_allocGiv"; | 
| 393 | ||
| 8985 | 394 | Goal "System : Always (INT i: lessThan Nclients. \ | 
| 7841 | 395 | \                      {s. (sub i o allocAsk) s <= (ask o sub i o client) s})";
 | 
| 8327 | 396 | by Auto_tac; | 
| 8067 | 397 | by (etac (System_Follows_ask RS Follows_Bounded) 1); | 
| 7841 | 398 | qed "Always_allocAsk_le_ask"; | 
| 399 | ||
| 8985 | 400 | Goal "System : Always (INT i: lessThan Nclients. \ | 
| 7841 | 401 | \                      {s. (sub i o allocRel) s <= (rel o sub i o client) s})";
 | 
| 8067 | 402 | by (auto_tac (claset() addSIs [Follows_Bounded, System_Follows_rel], | 
| 8327 | 403 | simpset())); | 
| 7841 | 404 | qed "Always_allocRel_le_rel"; | 
| 405 | ||
| 406 | ||
| 407 | (*** Proof of the safety property (1) ***) | |
| 408 | ||
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 409 | (*safety (1), step 1 is System_Follows_rel*) | 
| 7841 | 410 | |
| 7689 | 411 | (*safety (1), step 2*) | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 412 | (* i < Nclients ==> System : Increasing (sub i o allocRel) *) | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 413 | bind_thm ("System_Increasing_allocRel", 
 | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 414 | System_Follows_rel RS Follows_Increasing1); | 
| 6828 | 415 | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 416 | (*Lifting Alloc_safety up to the level of systemState. | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 417 | Simplififying with o_def gets rid of the translations but it unfortunately | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 418 | gets rid of the other "o"s too.*) | 
| 8314 | 419 | val rename_Alloc_Safety = | 
| 8327 | 420 | Alloc_Safety RS rename_guarantees_sysOfAlloc_I | 
| 421 | |> simplify (simpset() addsimps [o_def]); | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 422 | |
| 7689 | 423 | (*safety (1), step 3*) | 
| 8930 | 424 | Goal | 
| 9109 | 425 |   "System : Always {s. setsum (%i. (tokens o sub i o allocGiv) s) \
 | 
| 426 | \ (lessThan Nclients) \ | |
| 427 | \ <= NbT + setsum (%i. (tokens o sub i o allocRel) s) \ | |
| 428 | \ (lessThan Nclients)}"; | |
| 8327 | 429 | by (simp_tac (simpset() addsimps [o_apply]) 1); | 
| 430 | by (rtac (rename_Alloc_Safety RS component_guaranteesD) 1); | |
| 431 | by (auto_tac (claset(), | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 432 | simpset() addsimps [o_simp System_Increasing_allocRel])); | 
| 7538 | 433 | qed "System_sum_bounded"; | 
| 7537 | 434 | |
| 8314 | 435 | |
| 7841 | 436 | (** Follows reasoning **) | 
| 437 | ||
| 8985 | 438 | Goal "System : Always (INT i: lessThan Nclients. \ | 
| 7540 | 439 | \                         {s. (tokens o giv o sub i o client) s \
 | 
| 440 | \ <= (tokens o sub i o allocGiv) s})"; | |
| 7841 | 441 | by (rtac (Always_giv_le_allocGiv RS Always_weaken) 1); | 
| 8067 | 442 | by (auto_tac (claset() addIs [tokens_mono_prefix], | 
| 443 | simpset() addsimps [o_apply])); | |
| 7841 | 444 | qed "Always_tokens_giv_le_allocGiv"; | 
| 7540 | 445 | |
| 8985 | 446 | Goal "System : Always (INT i: lessThan Nclients. \ | 
| 7540 | 447 | \                         {s. (tokens o sub i o allocRel) s \
 | 
| 448 | \ <= (tokens o rel o sub i o client) s})"; | |
| 7841 | 449 | by (rtac (Always_allocRel_le_rel RS Always_weaken) 1); | 
| 8067 | 450 | by (auto_tac (claset() addIs [tokens_mono_prefix], | 
| 451 | simpset() addsimps [o_apply])); | |
| 7841 | 452 | qed "Always_tokens_allocRel_le_rel"; | 
| 7540 | 453 | |
| 7841 | 454 | (*safety (1), step 4 (final result!) *) | 
| 8128 | 455 | Goalw [system_safety_def] "System : system_safety"; | 
| 7841 | 456 | by (rtac (Always_Int_rule [System_sum_bounded, Always_tokens_giv_le_allocGiv, | 
| 457 | Always_tokens_allocRel_le_rel] RS Always_weaken) 1); | |
| 7538 | 458 | by Auto_tac; | 
| 9109 | 459 | by (rtac (setsum_fun_mono RS order_trans) 1); | 
| 7540 | 460 | by (dtac order_trans 2); | 
| 9109 | 461 | by (rtac ([order_refl, setsum_fun_mono] MRS add_le_mono) 2); | 
| 7540 | 462 | by (assume_tac 3); | 
| 7482 | 463 | by Auto_tac; | 
| 7540 | 464 | qed "System_safety"; | 
| 7399 
cf780c2bcccf
changed "component" infix in HOL/UNITY/Comp.thy to be overloaded <
 paulson parents: 
7365diff
changeset | 465 | |
| 7689 | 466 | |
| 467 | (*** Proof of the progress property (2) ***) | |
| 468 | ||
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 469 | (*progress (2), step 1 is System_Follows_ask and System_Follows_rel*) | 
| 7689 | 470 | |
| 7841 | 471 | (*progress (2), step 2; see also System_Increasing_allocRel*) | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 472 | (* i < Nclients ==> System : Increasing (sub i o allocAsk) *) | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 473 | bind_thm ("System_Increasing_allocAsk",
 | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 474 | System_Follows_ask RS Follows_Increasing1); | 
| 7689 | 475 | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 476 | (*progress (2), step 3: lifting "Client_Bounded" to systemState*) | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 477 | Goal "i : I \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 478 | \ ==> rename sysOfClient (plam x: I. rename client_map Client) : \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 479 | \ UNIV \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 480 | \ guarantees[ask o sub i o client] \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 481 | \           Always {s. ALL elt : set ((ask o sub i o client) s). elt <= NbT}";
 | 
| 8872 | 482 | by rename_client_map_tac; | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 483 | qed "rename_Client_Bounded"; | 
| 7841 | 484 | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 485 | Goal "i < Nclients \ | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 486 | \ ==> System : Always \ | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 487 | \                   {s. ALL elt : set ((ask o sub i o client) s). elt <= NbT}";
 | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 488 | by (rtac ([rename_Client_Bounded, | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 489 | Client_component_System] MRS component_guaranteesD) 1); | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 490 | by Auto_tac; | 
| 7841 | 491 | qed "System_Bounded_ask"; | 
| 492 | ||
| 8930 | 493 | Goal "{x. ALL y. P y --> Q x y} = (INT y: {y. P y}. {x. Q x y})";
 | 
| 494 | by (Blast_tac 1); | |
| 495 | qed "Collect_all_imp_eq"; | |
| 496 | ||
| 7841 | 497 | (*progress (2), step 4*) | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 498 | Goal "System : Always {s. ALL i<Nclients. \
 | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 499 | \ ALL elt : set ((sub i o allocAsk) s). elt <= NbT}"; | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 500 | by (auto_tac (claset(), simpset() addsimps [Collect_all_imp_eq])); | 
| 7841 | 501 | by (rtac (Always_Int_rule [Always_allocAsk_le_ask, System_Bounded_ask] | 
| 502 | RS Always_weaken) 1); | |
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 503 | by (auto_tac (claset() addDs [set_mono], simpset())); | 
| 7841 | 504 | qed "System_Bounded_allocAsk"; | 
| 505 | ||
| 7965 | 506 | (*progress (2), step 5 is System_Increasing_allocGiv*) | 
| 7841 | 507 | |
| 7965 | 508 | (*progress (2), step 6*) | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 509 | (* i < Nclients ==> System : Increasing (giv o sub i o client) *) | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 510 | bind_thm ("System_Increasing_giv",
 | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 511 | System_Follows_allocGiv RS Follows_Increasing1); | 
| 7841 | 512 | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 513 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 514 | Goal "i: I \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 515 | \ ==> rename sysOfClient (plam x: I. rename client_map Client) \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 516 | \ : Increasing (giv o sub i o client) \ | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 517 | \ guarantees[funPair rel ask o sub i o client] \ | 
| 8314 | 518 | \         (INT h. {s. h <= (giv o sub i o client) s & \
 | 
| 519 | \ h pfixGe (ask o sub i o client) s} \ | |
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 520 | \                 LeadsTo {s. tokens h <= (tokens o rel o sub i o client) s})";
 | 
| 8872 | 521 | by rename_client_map_tac; | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 522 | by (asm_simp_tac (simpset() addsimps [o_simp Client_Progress]) 1); | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 523 | qed "rename_Client_Progress"; | 
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 524 | |
| 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 525 | |
| 7965 | 526 | (*progress (2), step 7*) | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 527 | Goal | 
| 8985 | 528 | "System : (INT i : (lessThan Nclients). \ | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 529 | \           INT h. {s. h <= (giv o sub i o client) s & \
 | 
| 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 530 | \ h pfixGe (ask o sub i o client) s} \ | 
| 8314 | 531 | \               LeadsTo {s. tokens h <= (tokens o rel o sub i o client) s})";
 | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 532 | by (rtac INT_I 1); | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 533 | (*Couldn't have just used Auto_tac since the "INT h" must be kept*) | 
| 8311 
6218522253e7
new mostly working version; Alloc nearly converted to "Rename"
 paulson parents: 
8286diff
changeset | 534 | by (rtac ([rename_Client_Progress, | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 535 | Client_component_System] MRS component_guaranteesD) 1); | 
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 536 | by (auto_tac (claset(), simpset() addsimps [System_Increasing_giv])); | 
| 8065 
658e0d4e4ed9
first working version to Alloc/System_Client_Progress;
 paulson parents: 
8055diff
changeset | 537 | qed "System_Client_Progress"; | 
| 8055 
bb15396278fb
abolition of localTo: instead "guarantees" has local vars as extra argument
 paulson parents: 
8041diff
changeset | 538 | |
| 8314 | 539 | (*Concludes | 
| 540 |  System : {s. k <= (sub i o allocGiv) s} 
 | |
| 541 | LeadsTo | |
| 542 |           {s. (sub i o allocAsk) s <= (ask o sub i o client) s} Int
 | |
| 543 |           {s. k <= (giv o sub i o client) s} *)
 | |
| 8067 | 544 | val lemma = | 
| 545 | [System_Follows_ask RS Follows_Bounded, | |
| 546 | System_Follows_allocGiv RS Follows_LeadsTo] MRS Always_LeadsToD; | |
| 8041 | 547 | |
| 8314 | 548 | (*A more complicated variant of the previous one*) | 
| 8067 | 549 | val lemma2 = [lemma, | 
| 550 | System_Follows_ask RS Follows_Increasing1 RS IncreasingD] | |
| 551 | MRS PSP_Stable; | |
| 552 | ||
| 553 | Goal "i < Nclients \ | |
| 554 | \     ==> System : {s. h <= (sub i o allocGiv) s &      \
 | |
| 555 | \ h pfixGe (sub i o allocAsk) s} \ | |
| 556 | \ LeadsTo \ | |
| 557 | \                  {s. h <= (giv o sub i o client) s &  \
 | |
| 558 | \ h pfixGe (ask o sub i o client) s}"; | |
| 559 | by (rtac single_LeadsTo_I 1); | |
| 560 | by (res_inst_tac [("k6", "h"), ("x2", "(sub i o allocAsk) s")]
 | |
| 561 | (lemma2 RS LeadsTo_weaken) 1); | |
| 562 | by Auto_tac; | |
| 563 | by (blast_tac (claset() addIs [trans_Ge RS trans_genPrefix RS transD, | |
| 564 | prefix_imp_pfixGe]) 1); | |
| 565 | val lemma3 = result(); | |
| 566 | ||
| 567 | ||
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 568 | (*progress (2), step 8: Client i's "release" action is visible system-wide*) | 
| 8075 | 569 | Goal "i < Nclients \ | 
| 570 | \     ==> System : {s. h <= (sub i o allocGiv) s & \
 | |
| 8067 | 571 | \ h pfixGe (sub i o allocAsk) s} \ | 
| 8075 | 572 | \                  LeadsTo {s. tokens h <= (tokens o sub i o allocRel) s}";
 | 
| 8067 | 573 | by (rtac LeadsTo_Trans 1); | 
| 574 | by (dtac (System_Follows_rel RS impOfSubs (mono_tokens RS mono_Follows_o) RS | |
| 8113 | 575 | Follows_LeadsTo) 2); | 
| 8067 | 576 | by (asm_full_simp_tac (simpset() addsimps [o_assoc]) 2); | 
| 577 | by (rtac LeadsTo_Trans 1); | |
| 578 | by (cut_facts_tac [System_Client_Progress] 2); | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 579 | by (blast_tac (claset() addIs [LeadsTo_Basis]) 2); | 
| 8067 | 580 | by (etac lemma3 1); | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 581 | qed "System_Alloc_Client_Progress"; | 
| 8069 
19b9f92ca503
working with weak LeadsTo in guarantees precondition\!
 paulson parents: 
8067diff
changeset | 582 | |
| 8314 | 583 | (*Lifting Alloc_Progress up to the level of systemState*) | 
| 584 | val rename_Alloc_Progress = | |
| 8327 | 585 | Alloc_Progress RS rename_guarantees_sysOfAlloc_I | 
| 586 | |> simplify (simpset() addsimps [o_def]); | |
| 8075 | 587 | |
| 8069 
19b9f92ca503
working with weak LeadsTo in guarantees precondition\!
 paulson parents: 
8067diff
changeset | 588 | (*progress (2), step 9*) | 
| 
19b9f92ca503
working with weak LeadsTo in guarantees precondition\!
 paulson parents: 
8067diff
changeset | 589 | Goal | 
| 8985 | 590 | "System : (INT i : (lessThan Nclients). \ | 
| 8069 
19b9f92ca503
working with weak LeadsTo in guarantees precondition\!
 paulson parents: 
8067diff
changeset | 591 | \           INT h. {s. h <= (sub i o allocAsk) s}  \
 | 
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 592 | \                  LeadsTo {s. h pfixLe (sub i o allocGiv) s})";
 | 
| 8314 | 593 | (*Can't use simpset(): the "INT h" must be kept*) | 
| 8327 | 594 | by (simp_tac (HOL_ss addsimps [o_apply, sub_def]) 1); | 
| 595 | by (rtac (rename_Alloc_Progress RS component_guaranteesD) 1); | |
| 8075 | 596 | by (auto_tac (claset(), | 
| 8314 | 597 | simpset() addsimps [o_simp System_Increasing_allocRel, | 
| 598 | o_simp System_Increasing_allocAsk, | |
| 599 | o_simp System_Bounded_allocAsk, | |
| 600 | o_simp System_Alloc_Client_Progress])); | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 601 | qed "System_Alloc_Progress"; | 
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 602 | |
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 603 | |
| 8128 | 604 | (*progress (2), step 10 (final result!) *) | 
| 605 | Goalw [system_progress_def] "System : system_progress"; | |
| 9403 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 606 | by (cut_facts_tac [System_Alloc_Progress] 1); | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 607 | by (blast_tac (claset() addIs [LeadsTo_Trans, | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 608 | System_Follows_allocGiv RS Follows_LeadsTo_pfixLe, | 
| 
aad13b59b8d9
much tidying in connection with the 2nd UNITY paper
 paulson parents: 
9109diff
changeset | 609 | System_Follows_ask RS Follows_LeadsTo]) 1); | 
| 8128 | 610 | qed "System_Progress"; | 
| 611 | ||
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 612 | |
| 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 613 | (*Ultimate goal*) | 
| 8128 | 614 | Goalw [system_spec_def] "System : system_spec"; | 
| 615 | by (blast_tac (claset() addIs [System_safety, System_Progress]) 1); | |
| 616 | qed "System_correct"; | |
| 8122 
b43ad07660b9
working version, with Alloc now working on the same state space as the whole
 paulson parents: 
8113diff
changeset | 617 | |
| 8314 | 618 |