1 2open HolKernel boolLib bossLib Parse; 3open pred_setTheory wordsTheory wordsLib arithmeticTheory; 4open set_sepTheory progTheory lpc_devicesTheory; 5open listTheory pairTheory combinTheory addressTheory; 6 7val _ = new_theory "lpc_prog"; 8 9 10infix \\ 11val op \\ = op THEN; 12 13val RW = REWRITE_RULE; 14val RW1 = ONCE_REWRITE_RULE; 15 16 17(* ----------------------------------------------------------------------------- *) 18(* The LPC set *) 19(* ----------------------------------------------------------------------------- *) 20 21val _ = Hol_datatype ` 22 lpc_el = tReg of word4 => word32 23 | tStatus of arm_bit => bool 24 | tRom of word32 => word8 option 25 | tRam of word32 => word8 option 26 | tTime of num 27 | tUart0 of (word8 list # num # word8 list # num) 28 | tUndef of bool`; 29 30val lpc_el_11 = DB.fetch "-" "lpc_el_11"; 31val lpc_el_distinct = DB.fetch "-" "lpc_el_distinct"; 32 33val _ = Parse.type_abbrev("lpc_set",``:lpc_el set``); 34 35 36(* ----------------------------------------------------------------------------- *) 37(* State reader functions *) 38(* ----------------------------------------------------------------------------- *) 39 40val ty = (type_of o snd o dest_comb) ``LPC_NEXT s1 s2`` 41val _ = Parse.type_abbrev("lpc_state",ty); 42 43val LPC_READ_REG_def = Define ` 44 LPC_READ_REG a ((s,p):lpc_state) = ARM_READ_REG a s`; 45 46val LPC_READ_STATUS_def = Define ` 47 LPC_READ_STATUS a ((s,p):lpc_state) = ARM_READ_STATUS a s`; 48 49val LPC_READ_TIME_def = Define ` 50 LPC_READ_TIME ((s,(time,rom,ram,p)):lpc_state) = time`; 51 52val LPC_READ_ROM_def = Define ` 53 LPC_READ_ROM a ((s,(time,rom,ram,p)):lpc_state) = rom a`; 54 55val LPC_READ_RAM_def = Define ` 56 LPC_READ_RAM a ((s,(time,rom,ram,p)):lpc_state) = ram a`; 57 58val LPC_READ_UART0_def = Define ` 59 LPC_READ_UART0 ((s,(time,rom,ram,uart0,p)):lpc_state) = UART0_READ uart0`; 60 61val ARM_OK_def = Define ` 62 ARM_OK state = 63 (ARM_ARCH state = ARMv4) /\ (ARM_EXTENSIONS state = {}) /\ 64 (ARM_UNALIGNED_SUPPORT state) /\ (ARM_READ_EVENT_REGISTER state) /\ 65 ~(ARM_READ_INTERRUPT_WAIT state) /\ ~(ARM_READ_SCTLR sctlrV state) /\ 66 (ARM_READ_SCTLR sctlrA state) /\ ~(ARM_READ_SCTLR sctlrU state) /\ 67 (ARM_READ_IT state = 0w) /\ ~(ARM_READ_STATUS psrJ state) /\ 68 ~(ARM_READ_STATUS psrT state) /\ ~(ARM_READ_STATUS psrE state) /\ 69 (ARM_MODE state = 16w)`; 70 71val LPC_READ_UNDEF_def = Define ` 72 LPC_READ_UNDEF ((s,p):lpc_state) = ~ARM_OK s /\ ~PERIPHERALS_OK p`; 73 74 75(* ----------------------------------------------------------------------------- *) 76(* Converting from lpc_state to lpc_set *) 77(* ----------------------------------------------------------------------------- *) 78 79val lpc2set'_def = Define ` 80 lpc2set' (rs,st:arm_bit set,is,ms,tt:unit set,ua:unit set,ud:unit set) (s:lpc_state) = 81 IMAGE (\a. tReg a (LPC_READ_REG a s)) rs UNION 82 IMAGE (\a. tStatus a (LPC_READ_STATUS a s)) st UNION 83 IMAGE (\a. tRom a (LPC_READ_ROM a s)) is UNION 84 IMAGE (\a. tRam a (LPC_READ_RAM a s)) ms UNION 85 IMAGE (\a. tTime (LPC_READ_TIME s)) tt UNION 86 IMAGE (\a. tUart0 (LPC_READ_UART0 s)) ua UNION 87 IMAGE (\a. tUndef (LPC_READ_UNDEF s)) ud`; 88 89val lpc2set_def = Define `lpc2set s = lpc2set' (UNIV,UNIV,UNIV,UNIV,UNIV,UNIV,UNIV) s`; 90val lpc2set''_def = Define `lpc2set'' x s = lpc2set s DIFF lpc2set' x s`; 91 92(* theorems *) 93 94val lpc2set'_SUBSET_lpc2set = prove( 95 ``!y s. lpc2set' y s SUBSET lpc2set s``, 96 SIMP_TAC std_ss [pairTheory.FORALL_PROD] 97 \\ SIMP_TAC std_ss [SUBSET_DEF,lpc2set'_def,lpc2set_def,IN_IMAGE,IN_UNION,IN_UNIV] 98 \\ METIS_TAC [NOT_IN_EMPTY]); 99 100val SPLIT_lpc2set = prove( 101 ``!x s. SPLIT (lpc2set s) (lpc2set' x s, lpc2set'' x s)``, 102 REPEAT STRIP_TAC 103 \\ ASM_SIMP_TAC std_ss [SPLIT_def,EXTENSION,IN_UNION,IN_DIFF,lpc2set''_def] 104 \\ `lpc2set' x s SUBSET lpc2set s` by METIS_TAC [lpc2set'_SUBSET_lpc2set] 105 \\ SIMP_TAC bool_ss [DISJOINT_DEF,EXTENSION,IN_INTER,NOT_IN_EMPTY,IN_DIFF] 106 \\ METIS_TAC [SUBSET_DEF]); 107 108val SUBSET_lpc2set = prove( 109 ``!u s. u SUBSET lpc2set s = ?y. u = lpc2set' y s``, 110 REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC 111 \\ ASM_REWRITE_TAC [lpc2set'_SUBSET_lpc2set] 112 \\ Q.EXISTS_TAC `( 113 { a |a| ?x. tReg a x IN u }, 114 { a |a| ?x. tStatus a x IN u }, 115 { a |a| ?x. tRom a x IN u }, 116 { a |a| ?x. tRam a x IN u }, 117 { a |a| ?x. tTime x IN u }, 118 { a |a| ?x. tUart0 x IN u }, 119 { a |a| ?x. tUndef x IN u })` 120 \\ FULL_SIMP_TAC std_ss [lpc2set'_def,lpc2set_def,EXTENSION,SUBSET_DEF,IN_IMAGE, 121 IN_UNION,GSPECIFICATION,IN_INSERT,NOT_IN_EMPTY,IN_UNIV] 122 \\ STRIP_TAC \\ ASM_REWRITE_TAC [] \\ EQ_TAC \\ REPEAT STRIP_TAC THEN1 METIS_TAC [] 123 \\ PAT_ASSUM ``!x:'a. b:bool`` IMP_RES_TAC \\ FULL_SIMP_TAC std_ss [lpc_el_11,lpc_el_distinct]); 124 125val SPLIT_lpc2set_EXISTS = prove( 126 ``!s u v. SPLIT (lpc2set s) (u,v) = ?y. (u = lpc2set' y s) /\ (v = lpc2set'' y s)``, 127 REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC \\ ASM_REWRITE_TAC [SPLIT_lpc2set] 128 \\ FULL_SIMP_TAC bool_ss [SPLIT_def,lpc2set'_def,lpc2set''_def] 129 \\ `u SUBSET (lpc2set s)` by 130 (FULL_SIMP_TAC std_ss [EXTENSION,SUBSET_DEF,IN_UNION] \\ METIS_TAC []) 131 \\ FULL_SIMP_TAC std_ss [SUBSET_lpc2set] \\ Q.EXISTS_TAC `y` \\ REWRITE_TAC [] 132 \\ FULL_SIMP_TAC std_ss [EXTENSION,IN_DIFF,IN_UNION,DISJOINT_DEF,NOT_IN_EMPTY,IN_INTER] 133 \\ METIS_TAC []); 134 135val IN_lpc2set = (SIMP_RULE std_ss [oneTheory.one] o prove)(`` 136 (!a x s. tReg a x IN (lpc2set s) = (x = LPC_READ_REG a s)) /\ 137 (!a x s. tReg a x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_REG a s) /\ a IN rs) /\ 138 (!a x s. tReg a x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_REG a s) /\ ~(a IN rs)) /\ 139 (!a x s. tStatus a x IN (lpc2set s) = (x = LPC_READ_STATUS a s)) /\ 140 (!a x s. tStatus a x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_STATUS a s) /\ a IN st) /\ 141 (!a x s. tStatus a x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_STATUS a s) /\ ~(a IN st)) /\ 142 (!a x s. tRom a x IN (lpc2set s) = (x = LPC_READ_ROM a s)) /\ 143 (!a x s. tRom a x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_ROM a s) /\ a IN is) /\ 144 (!a x s. tRom a x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_ROM a s) /\ ~(a IN is)) /\ 145 (!a x s. tRam a x IN (lpc2set s) = (x = LPC_READ_RAM a s)) /\ 146 (!a x s. tRam a x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_RAM a s) /\ a IN ms) /\ 147 (!a x s. tRam a x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_RAM a s) /\ ~(a IN ms)) /\ 148 (!a x s. tTime x IN (lpc2set s) = (x = LPC_READ_TIME s)) /\ 149 (!a x s. tTime x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_TIME s) /\ a IN tt) /\ 150 (!a x s. tTime x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_TIME s) /\ ~(a IN tt)) /\ 151 (!a x s. tUart0 x IN (lpc2set s) = (x = LPC_READ_UART0 s)) /\ 152 (!a x s. tUart0 x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_UART0 s) /\ a IN ua) /\ 153 (!a x s. tUart0 x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_UART0 s) /\ ~(a IN ua)) /\ 154 (!a x s. tUndef x IN (lpc2set s) = (x = LPC_READ_UNDEF s)) /\ 155 (!a x s. tUndef x IN (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_UNDEF s) /\ a IN ud) /\ 156 (!a x s. tUndef x IN (lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = (x = LPC_READ_UNDEF s) /\ ~(a IN ud))``, 157 SRW_TAC [] [lpc2set'_def,lpc2set''_def,lpc2set_def,IN_UNION,IN_DIFF,oneTheory.one] 158 \\ METIS_TAC []); 159 160val SET_NOT_EQ = prove( 161 ``!x y. ~(x = y:'a set) = ?a. ~(a IN x = a IN y)``, 162 FULL_SIMP_TAC std_ss [EXTENSION]) 163 164val lpc2set''_11 = prove( 165 ``!y y' s s'. (lpc2set'' y' s' = lpc2set'' y s) ==> (y = y')``, 166 REPEAT STRIP_TAC 167 \\ `?rs st is ms tt ua ud. y = (rs,st,is,ms,tt,ua,ud)` by METIS_TAC [PAIR] 168 \\ `?rs2 st2 is2 ms2 tt2 ua2 ud2. y' = (rs2,st2,is2,ms2,tt2,ua2,ud2)` by METIS_TAC [PAIR] 169 \\ FULL_SIMP_TAC std_ss [] \\ CCONTR_TAC 170 \\ FULL_SIMP_TAC std_ss [EXTENSION] 171 THEN1 (`~((?y. tReg x y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 172 (?y. tReg x y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 173 FULL_SIMP_TAC std_ss [IN_lpc2set] THEN1 METIS_TAC []) 174 THEN1 (`~((?y. tStatus x y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 175 (?y. tStatus x y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 176 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC []) 177 THEN1 (`~((?y. tRom x y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 178 (?y. tRom x y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 179 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC []) 180 THEN1 (`~((?y. tRam x y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 181 (?y. tRam x y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 182 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC []) 183 THEN1 (`~((?y. tTime y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 184 (?y. tTime y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 185 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC []) 186 THEN1 (`~((?y. tUart0 y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 187 (?y. tUart0 y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 188 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC []) 189 THEN1 (`~((?y. tUndef y IN lpc2set'' (rs,st,is,ms,tt,ua,ud) s) = 190 (?y. tUndef y IN lpc2set'' (rs2,st2,is2,ms2,tt2,ua2,ud2) s'))` by 191 FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] THEN1 METIS_TAC [])); 192 193val DELETE_lpc2set = (SIMP_RULE std_ss [oneTheory.one] o prove)(`` 194 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tReg a (LPC_READ_REG a s) = 195 (lpc2set' (rs DELETE a,st,is,ms,tt,ua,ud) s)) /\ 196 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tStatus a (LPC_READ_STATUS a s) = 197 (lpc2set' (rs,st DELETE a,is,ms,tt,ua,ud) s)) /\ 198 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tRom a (LPC_READ_ROM a s) = 199 (lpc2set' (rs,st,is DELETE a,ms,tt,ua,ud) s)) /\ 200 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tRam a (LPC_READ_RAM a s) = 201 (lpc2set' (rs,st,is,ms DELETE a,tt,ua,ud) s)) /\ 202 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tTime (LPC_READ_TIME s) = 203 (lpc2set' (rs,st,is,ms,tt DELETE a,ua,ud) s)) /\ 204 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tUart0 (LPC_READ_UART0 s) = 205 (lpc2set' (rs,st,is,ms,tt,ua DELETE a,ud) s)) /\ 206 (!a s. (lpc2set' (rs,st,is,ms,tt,ua,ud) s) DELETE tUndef (LPC_READ_UNDEF s) = 207 (lpc2set' (rs,st,is,ms,tt,ua,ud DELETE a) s))``, 208 SRW_TAC [] [lpc2set'_def,EXTENSION,IN_UNION,GSPECIFICATION,LEFT_AND_OVER_OR, 209 EXISTS_OR_THM,IN_DELETE,IN_INSERT,NOT_IN_EMPTY,oneTheory.one] 210 \\ Cases_on `x` \\ SRW_TAC [] [] \\ METIS_TAC []); 211 212val EMPTY_lpc2set = prove(`` 213 (lpc2set' (rs,st,is,ms,tt,ua,ud) s = {}) = 214 (rs = {}) /\ (st = {}) /\ (is = {}) /\ (ms = {}) /\ (tt = {}) /\ (ua = {}) /\ (ud = {})``, 215 SRW_TAC [] [lpc2set'_def,EXTENSION,IN_UNION,GSPECIFICATION,LEFT_AND_OVER_OR,EXISTS_OR_THM] 216 \\ METIS_TAC []); 217 218 219(* ----------------------------------------------------------------------------- *) 220(* Defining the LPC_MODEL *) 221(* ----------------------------------------------------------------------------- *) 222 223val tR_def = Define `tR a x = SEP_EQ {tReg a x}`; 224val tM_def = Define `tM a x = SEP_EQ {tRam a x}`; 225val tS_def = Define `tS a x = SEP_EQ {tStatus a x}`; 226val tU_def = Define `tU x = SEP_EQ {tUndef x}`; 227val tT_def = Define `tT x = SEP_EQ {tTime x}`; 228val tUART0_def = Define `tUART0 x = SEP_EQ {tUart0 x}`; 229 230val tPC_def = Define `tPC x = tR 15w x * tU F * cond (ALIGNED x)`; 231 232val LPC_ROM_def = Define `LPC_ROM (a,w:word32) = 233 { tRom (a+3w) (SOME ((31 >< 24) w)) ; 234 tRom (a+2w) (SOME ((23 >< 16) w)) ; 235 tRom (a+1w) (SOME ((15 >< 8) w)) ; 236 tRom (a+0w) (SOME (( 7 >< 0) w)) }`; 237 238val LPC_MODEL_def = Define ` 239 LPC_MODEL = (lpc2set, LPC_NEXT, LPC_ROM, (\x y. (x:lpc_state) = y))`; 240 241 242(* theorems *) 243 244val lemma = 245 METIS_PROVE [SPLIT_lpc2set] 246 ``p (lpc2set' y s) ==> (?u v. SPLIT (lpc2set s) (u,v) /\ p u /\ (\v. v = lpc2set'' y s) v)``; 247 248val LPC_SPEC_SEMANTICS = store_thm("LPC_SPEC_SEMANTICS", 249 ``SPEC LPC_MODEL p {} q = 250 !y s seq. p (lpc2set' y s) /\ rel_sequence LPC_NEXT seq s ==> 251 ?k. q (lpc2set' y (seq k)) /\ (lpc2set'' y s = lpc2set'' y (seq k))``, 252 SIMP_TAC bool_ss [GSYM RUN_EQ_SPEC,RUN_def,LPC_MODEL_def,STAR_def,SEP_REFINE_def] 253 \\ REPEAT STRIP_TAC \\ REVERSE EQ_TAC \\ REPEAT STRIP_TAC 254 THEN1 (FULL_SIMP_TAC bool_ss [SPLIT_lpc2set_EXISTS] \\ METIS_TAC []) 255 \\ Q.PAT_ASSUM `!s r. b` (STRIP_ASSUME_TAC o UNDISCH o SPEC_ALL o 256 (fn th => MATCH_MP th (UNDISCH lemma)) o Q.SPECL [`s`,`(\v. v = lpc2set'' y s)`]) 257 \\ FULL_SIMP_TAC bool_ss [SPLIT_lpc2set_EXISTS] 258 \\ IMP_RES_TAC lpc2set''_11 \\ Q.EXISTS_TAC `i` \\ METIS_TAC []); 259 260 261(* ----------------------------------------------------------------------------- *) 262(* Theorems for construction of |- SPEC LPC_MODEL ... *) 263(* ----------------------------------------------------------------------------- *) 264 265val SEP_EQ_STAR_LEMMA = prove( 266 ``!p s t. (SEP_EQ t * p) s <=> t SUBSET s /\ (t SUBSET s ==> p (s DIFF t))``, 267 METIS_TAC [EQ_STAR]); 268 269val FLIP_CONJ = prove(``!b c. b /\ (b ==> c) = b /\ c``,METIS_TAC []); 270 271val EXPAND_STAR = 272 GEN_ALL o (SIMP_CONV std_ss [tR_def,tM_def,tS_def,tU_def,tT_def,tUART0_def, 273 SEP_EQ_STAR_LEMMA,INSERT_SUBSET,IN_lpc2set,DELETE_lpc2set, 274 DIFF_INSERT,DIFF_EMPTY,EMPTY_SUBSET] THENC SIMP_CONV std_ss [FLIP_CONJ] 275 THENC REWRITE_CONV [GSYM CONJ_ASSOC]) 276 277val STAR_lpc2set = save_thm("STAR_lpc2set",LIST_CONJ (map EXPAND_STAR 278 [``(tR a x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``, 279 ``(tM a x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``, 280 ``(tS a x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``, 281 ``(tU x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``, 282 ``(tT x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``, 283 ``(tUART0 x * p) (lpc2set' (rs,st,is,ms,tt,ua,ud) s)``])); 284 285val CODE_POOL_lpc2set_LEMMA = prove( 286 ``!x y z. (x = z INSERT y) = (z INSERT y) SUBSET x /\ (x DIFF (z INSERT y) = {})``, 287 SIMP_TAC std_ss [EXTENSION,SUBSET_DEF,IN_INSERT,NOT_IN_EMPTY,IN_DIFF] \\ METIS_TAC []); 288 289val CODE_POOL_lpc2set = store_thm("CODE_POOL_lpc2set", 290 ``CODE_POOL LPC_ROM {(p,c)} (lpc2set' (rs,st,is,ms,tt,ua,ud) s) = 291 ({p+3w;p+2w;p+1w;p} = is) /\ (rs = {}) /\ (st = {}) /\ (ms = {}) /\ (tt = {}) /\ (ua = {}) /\ (ud = {}) /\ 292 (LPC_READ_ROM (p + 0w) s = SOME (( 7 >< 0) c)) /\ 293 (LPC_READ_ROM (p + 1w) s = SOME ((15 >< 8) c)) /\ 294 (LPC_READ_ROM (p + 2w) s = SOME ((23 >< 16) c)) /\ 295 (LPC_READ_ROM (p + 3w) s = SOME ((31 >< 24) c))``, 296 SIMP_TAC bool_ss [CODE_POOL_def,IMAGE_INSERT,IMAGE_EMPTY,BIGUNION_INSERT, 297 BIGUNION_EMPTY,UNION_EMPTY,LPC_ROM_def,CODE_POOL_lpc2set_LEMMA, 298 GSYM DELETE_DEF, INSERT_SUBSET, EMPTY_SUBSET,IN_lpc2set] 299 \\ REPEAT STRIP_TAC \\ EQ_TAC \\ ASM_SIMP_TAC std_ss [] 300 \\ ASM_SIMP_TAC std_ss [DELETE_lpc2set,EMPTY_lpc2set,DIFF_INSERT,WORD_ADD_0] 301 \\ ASM_SIMP_TAC std_ss [GSYM AND_IMP_INTRO,DELETE_lpc2set,EMPTY_lpc2set,DIFF_EMPTY] 302 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 303 \\ ASM_SIMP_TAC std_ss [DELETE_lpc2set,EMPTY_lpc2set]); 304 305val LPC_SPEC_CODE = (RW [GSYM LPC_MODEL_def] o SIMP_RULE std_ss [LPC_MODEL_def] o prove) 306 (``SPEC LPC_MODEL (CODE_POOL (FST (SND (SND LPC_MODEL))) c * p) {} 307 (CODE_POOL (FST (SND (SND LPC_MODEL))) c * q) = 308 SPEC LPC_MODEL p c q``, 309 REWRITE_TAC [SPEC_CODE]); 310 311val IMP_LPC_SPEC_LEMMA = prove( 312 ``!p q. 313 (!s s2 y. 314 p (lpc2set' y s) ==> 315 (?s1. LPC_NEXT s s1) /\ 316 (LPC_NEXT s s2 ==> q (lpc2set' y s2) /\ (lpc2set'' y s = lpc2set'' y s2))) ==> 317 SPEC LPC_MODEL p {} q``, 318 REWRITE_TAC [LPC_SPEC_SEMANTICS] \\ REPEAT STRIP_TAC \\ RES_TAC 319 \\ FULL_SIMP_TAC bool_ss [rel_sequence_def] 320 \\ Q.EXISTS_TAC `SUC 0` \\ METIS_TAC []); 321 322val IMP_LPC_SPEC = save_thm("IMP_LPC_SPEC", 323 (RW1 [STAR_COMM] o RW [LPC_SPEC_CODE] o 324 SPECL [``CODE_POOL LPC_ROM {(p,c)} * p1``, 325 ``CODE_POOL LPC_ROM {(p,c)} * q1``]) IMP_LPC_SPEC_LEMMA); 326 327val lpc2set''_thm = store_thm("lpc2set''_thm", 328 ``(lpc2set'' (rs,st,is,ms,tt,ua,ud) s1 = lpc2set'' (rs,st,is,ms,tt,ua,ud) s2) = 329 (!a. ~(a IN rs) ==> (LPC_READ_REG a s1 = LPC_READ_REG a s2)) /\ 330 (!a. ~(a IN st) ==> (LPC_READ_STATUS a s1 = LPC_READ_STATUS a s2)) /\ 331 (!a. ~(a IN is) ==> (LPC_READ_ROM a s1 = LPC_READ_ROM a s2)) /\ 332 (!a. ~(a IN ms) ==> (LPC_READ_RAM a s1 = LPC_READ_RAM a s2)) /\ 333 (!a. ~(a IN tt) ==> (LPC_READ_TIME s1 = LPC_READ_TIME s2)) /\ 334 (!a. ~(a IN ua) ==> (LPC_READ_UART0 s1 = LPC_READ_UART0 s2)) /\ 335 (!a. ~(a IN ud) ==> (LPC_READ_UNDEF s1 = LPC_READ_UNDEF s2))``, 336 SIMP_TAC std_ss [oneTheory.one] 337 \\ REPEAT STRIP_TAC \\ REVERSE EQ_TAC \\ REPEAT STRIP_TAC 338 \\ FULL_SIMP_TAC std_ss [EXTENSION] 339 THEN1 (Cases \\ ASM_SIMP_TAC std_ss [IN_lpc2set] \\ METIS_TAC []) 340 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tReg a (LPC_READ_REG a s1)`) 341 \\ METIS_TAC [IN_lpc2set]) 342 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tStatus a (LPC_READ_STATUS a s1)`) 343 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC []) 344 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tRom a (LPC_READ_ROM a s1)`) 345 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC []) 346 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tRam a (LPC_READ_RAM a s1)`) 347 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC []) 348 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tTime (LPC_READ_TIME s1)`) 349 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC []) 350 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tUart0 (LPC_READ_UART0 s1)`) 351 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC []) 352 THEN1 (Q.PAT_ASSUM `!x.bb` (ASSUME_TAC o Q.SPEC `tUndef (LPC_READ_UNDEF s1)`) 353 \\ FULL_SIMP_TAC std_ss [IN_lpc2set,oneTheory.one] \\ METIS_TAC [])); 354 355 356val _ = export_theory(); 357