1open HolKernel Parse boolLib bossLib; 2 3(* 4quietdec := true; 5loadPath := 6 (concat [Globals.HOLDIR, "/examples/decidable_separationLogic/src"]) :: 7 !loadPath; 8 9map load ["finite_mapTheory", "relationTheory", "congLib", "sortingTheory", 10 "rich_listTheory"]; 11show_assums := true; 12*) 13 14open finite_mapTheory relationTheory pred_setTheory congLib sortingTheory 15 listTheory rich_listTheory; 16 17(* 18load "decidable_separationLogicTheory"; 19open decidable_separationLogicTheory; 20 21quietdec := false; 22*) 23 24val _ = new_theory "decidable_separationLogic"; 25 26 27 28(*general stuff*) 29 30fun MP_FREE_VAR_TAC var = 31 POP_ASSUM_LIST (fn thmL => 32 EVERY (rev 33 (map (fn thm => if (mem var (free_vars (concl thm))) then MP_TAC thm else ASSUME_TAC thm) thmL))); 34 35local 36 val thm = prove (``(!x. (P x = Q x)) ==> ((?x. P x) = (?x. Q x))``, METIS_TAC[]); 37in 38 val STRIP_EQ_EXISTS_TAC = 39 HO_MATCH_MP_TAC thm THEN 40 GEN_TAC 41end 42 43 44local 45 val thm = prove (``(!x. (P x = Q x)) ==> ((!x. P x) = (!x. Q x))``, METIS_TAC[]); 46in 47 val STRIP_EQ_FORALL_TAC = 48 HO_MATCH_MP_TAC thm THEN 49 GEN_TAC 50end 51 52 53local 54 fun find_in_lists_helper l1 [] l r = r | 55 find_in_lists_helper [] (e::l2) l r = 56 find_in_lists_helper l l2 l r | 57 find_in_lists_helper (e1::l1) (e2::l2) l r = 58 if (aconv e1 e2) then 59 find_in_lists_helper l1 (e2::l2) l (e1::r) else 60 find_in_lists_helper l1 (e2::l2) l r; 61 62 fun find_in_lists l1 l2 = find_in_lists_helper l1 l2 l1 []; 63 64 65 fun strip_conj_disj t = 66 if is_conj t then 67 strip_conj t 68 else 69 strip_disj t; 70 71 fun RHS_LHS_CONV c = 72 (TRY_CONV (RHS_CONV c)) THENC 73 (TRY_CONV (LHS_CONV c)); 74 75in 76 fun STRIP_EQ_BOOL_TAC (asm, g') = 77 let 78 val g'' = (rhs (concl ( 79 (RHS_LHS_CONV (REWR_CONV IMP_DISJ_THM) g')))) handle _ => g'; 80 val (l, r) = dest_eq g''; 81 82 val lL = strip_conj_disj l; 83 val rL = strip_conj_disj r; 84 85 val commonL = find_in_lists lL rL; 86 val commonL = map (fn t => fst (strip_neg t)) commonL; 87 88 val tac = EVERY (map (fn t => (ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])) commonL) 89 in 90 tac (asm, g') 91 end 92end; 93 94 95 96val PAIR_BETA_THM = store_thm ("PAIR_BETA_THM", 97``!f. (\x. f x (FST x) (SND x)) = (\(x1,x2). f (x1,x2) x1 x2)``, 98 99 SIMP_TAC std_ss [FUN_EQ_THM] THEN 100 Cases_on `x` THEN 101 SIMP_TAC std_ss [] 102); 103 104val EL_DISJOINT_FILTER = store_thm ("EL_DISJOINT_FILTER", 105 106 ``!n1 n2 P l. (~(n1 = n2) /\ (n1 < LENGTH l) /\ (n2 < LENGTH l) /\ 107 (EL n1 l = EL n2 l) /\ (P (EL n2 l))) ==> 108 ?n1' n2'. ~(n1' = n2') /\ 109 (n1' < LENGTH (FILTER P l)) /\ 110 (n2' < LENGTH (FILTER P l)) /\ 111 (EL n1' (FILTER P l) = EL n2 l) /\ 112 (EL n2' (FILTER P l) = EL n2 l)``, 113 114 HO_MATCH_MP_TAC (prove (``((!n1 n2. P n1 n2 = P n2 n1) /\ (!n1 n2. (n1 <= n2) ==> P n1 n2)) ==> 115 (!n1 n2. P n1 n2)``, 116 METIS_TAC[arithmeticTheory.LESS_EQ_CASES])) THEN 117 CONJ_TAC THEN1 METIS_TAC[] THEN 118 REPEAT STRIP_TAC THEN 119 120 `l = (FIRSTN (SUC n1) l) ++ (LASTN (LENGTH l - (SUC n1)) l)` by ( 121 MATCH_MP_TAC (GSYM APPEND_FIRSTN_LASTN) THEN 122 ASM_SIMP_TAC arith_ss [] 123 ) THEN 124 Q.ABBREV_TAC `l1 = (FIRSTN (SUC n1) l)` THEN 125 Q.ABBREV_TAC `l2 = (LASTN (LENGTH l - (SUC n1)) l)` THEN 126 `(n1 < LENGTH l1) /\ (LENGTH l1 <= n2)` by ( 127 UNABBREV_ALL_TAC THEN 128 ASM_SIMP_TAC list_ss [LENGTH_FIRSTN] 129 ) THEN 130 FULL_SIMP_TAC list_ss [EL_APPEND2, EL_APPEND1] THEN 131 `n2 - LENGTH l1 < LENGTH l2` by DECIDE_TAC THEN 132 `MEM (EL n1 l1) (FILTER P l1)` by METIS_TAC[MEM_FILTER, MEM_EL] THEN 133 `MEM (EL n1 l1) (FILTER P l2)` by METIS_TAC[MEM_FILTER, MEM_EL] THEN 134 FULL_SIMP_TAC list_ss [MEM_EL, FILTER_APPEND] THEN 135 Q.EXISTS_TAC `n` THEN 136 Q.EXISTS_TAC `LENGTH (FILTER P l1) + n'` THEN 137 ASM_SIMP_TAC list_ss [EL_APPEND1, EL_APPEND2] THEN 138 METIS_TAC[] 139); 140 141 142 143 144val FORALL_LESS_SUC = store_thm ("FORALL_LESS_SUC", 145 ``!P m. ((!n. n < SUC m ==> P n) = 146 (P 0 /\ (!n. n < m ==> P (SUC n))))``, 147 148 REPEAT GEN_TAC THEN 149 EQ_TAC THEN REPEAT STRIP_TAC THENL [ 150 ASM_SIMP_TAC arith_ss [], 151 ASM_SIMP_TAC arith_ss [], 152 153 Cases_on `n` THENL [ 154 ASM_REWRITE_TAC[], 155 ASM_SIMP_TAC arith_ss [] 156 ] 157 ]); 158 159 160 161val IN_FDOM_FOLDR_UNION = store_thm ("IN_FDOM_FOLDR_UNION", 162``!x hL. x IN FDOM (FOLDR FUNION FEMPTY hL) = 163 ?h. MEM h hL /\ x IN FDOM h``, 164 165Induct_on `hL` THENL [ 166 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 167 168 FULL_SIMP_TAC list_ss [FDOM_FUNION, IN_UNION, DISJ_IMP_THM] THEN 169 METIS_TAC[] 170]); 171 172val REPLACE_ELEMENT_def = Define ` 173 (REPLACE_ELEMENT e n [] = []) /\ 174 (REPLACE_ELEMENT e 0 (x::l) = e::l) /\ 175 (REPLACE_ELEMENT e (SUC n) (x::l) = x::REPLACE_ELEMENT e n l)` 176 177 178val REPLACE_ELEMENT_SEM = store_thm ("REPLACE_ELEMENT_SEM", 179 ``!e n l. 180 (LENGTH (REPLACE_ELEMENT e n l) = LENGTH l) /\ 181 (!p. p < LENGTH l ==> 182 (EL p (REPLACE_ELEMENT e n l) = 183 if (p = n) then e else EL p l))``, 184 185 Induct_on `n` THENL [ 186 Cases_on `l` THEN ( 187 SIMP_TAC list_ss [REPLACE_ELEMENT_def] 188 ) THEN 189 Cases_on `p` THEN ( 190 SIMP_TAC list_ss [] 191 ), 192 193 194 Cases_on `l` THEN ( 195 ASM_SIMP_TAC list_ss [REPLACE_ELEMENT_def] 196 ) THEN 197 Cases_on `p` THEN ( 198 ASM_SIMP_TAC list_ss [] 199 ) 200 ]); 201 202 203 204 205val MEM_LAST_FRONT = prove (`` 206!e l h. 207MEM e l /\ ~(e = LAST (h::l)) ==> 208MEM e (FRONT (h::l))``, 209 210Induct_on `l` THENL [ 211 SIMP_TAC list_ss [], 212 213 ASM_SIMP_TAC list_ss [] THEN 214 Cases_on `l` THEN ( 215 FULL_SIMP_TAC list_ss [] THEN 216 METIS_TAC[] 217 ) 218]); 219 220 221val EL_ALL_DISTINCT_EQ = store_thm ("EL_ALL_DISTINCT_EQ", 222 ``!l. ALL_DISTINCT l = 223 (!n1 n2. n1 < LENGTH l /\ n2 < LENGTH l ==> 224 ((EL n1 l = EL n2 l) = (n1 = n2)))``, 225 226 Induct_on `l` THENL [ 227 SIMP_TAC list_ss [], 228 229 ASM_SIMP_TAC list_ss [ALL_DISTINCT] THEN 230 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 231 Cases_on `n1` THEN Cases_on `n2` THENL [ 232 SIMP_TAC list_ss [], 233 234 SIMP_TAC list_ss [] THEN 235 METIS_TAC[MEM_EL], 236 237 SIMP_TAC list_ss [] THEN 238 METIS_TAC[MEM_EL], 239 240 SIMP_TAC list_ss [] THEN 241 METIS_TAC[] 242 ], 243 244 245 STRIP_TAC THENL [ 246 SIMP_TAC std_ss [MEM_EL] THEN 247 GEN_TAC THEN 248 POP_ASSUM (fn thm => ASSUME_TAC (Q.SPECL [`0`, `SUC n`] thm)) THEN 249 FULL_SIMP_TAC list_ss [] THEN 250 METIS_TAC[], 251 252 REPEAT GEN_TAC THEN 253 POP_ASSUM (fn thm => ASSUME_TAC (Q.SPECL [`SUC n1`, `SUC n2`] thm)) THEN 254 FULL_SIMP_TAC list_ss [] THEN 255 METIS_TAC[] 256 ] 257 ] 258 ]); 259 260 261 262val EL_ALL_DISTINCT = store_thm ("EL_ALL_DISTINCT", 263 ``!l n1 n2. ALL_DISTINCT l /\ n1 < LENGTH l /\ n2 < LENGTH l ==> 264 ((EL n1 l = EL n2 l) = (n1 = n2))``, 265 266 METIS_TAC[EL_ALL_DISTINCT_EQ]); 267 268 269val FILTER_ALL_DISTINCT = store_thm ("FILTER_ALL_DISTINCT", 270 ``!P l. ALL_DISTINCT l ==> ALL_DISTINCT (FILTER P l)``, 271 272 Induct_on `l` THENL [ 273 SIMP_TAC list_ss [], 274 275 SIMP_TAC list_ss [] THEN 276 REPEAT STRIP_TAC THEN 277 Cases_on `P h` THENL [ 278 ASM_SIMP_TAC list_ss [MEM_FILTER], 279 ASM_SIMP_TAC list_ss [] 280 ] 281 ]) 282 283 284val PERM_ALL_DISTINCT = store_thm ("PERM_ALL_DISTINCT", 285`` !l1 l2. (ALL_DISTINCT l1 /\ ALL_DISTINCT l2 /\ 286 (!x. MEM x l1 = MEM x l2)) ==> 287 PERM l1 l2``, 288 289Induct_on `l1` THENL [ 290 Cases_on `l2` THEN SIMP_TAC list_ss [FORALL_AND_THM, PERM_REFL], 291 292 SIMP_TAC list_ss [] THEN 293 REPEAT STRIP_TAC THEN 294 295 `?l2'. l2' = FILTER (\x. x = h) l2 ++ (FILTER ($~ o (\x. x = h)) l2)` by METIS_TAC[] THEN 296 `PERM l2 l2'` by METIS_TAC[PERM_SPLIT] THEN 297 `PERM (h::l1) l2'` suffices_by (STRIP_TAC THEN 298 METIS_TAC[PERM_TRANS, PERM_SYM] 299 ) THEN 300 `FILTER (\x. x = h) l2 = [h]` by ( 301 Q.PAT_X_ASSUM `ALL_DISTINCT l2` MP_TAC THEN 302 `MEM h l2` by METIS_TAC[] THEN 303 POP_ASSUM MP_TAC THEN 304 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 305 Induct_on `l2` THENL [ 306 SIMP_TAC list_ss [], 307 308 SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM] THEN 309 REPEAT STRIP_TAC THENL [ 310 Q.PAT_X_ASSUM `MEM h l2 ==> X` (K ALL_TAC) THEN 311 Induct_on `l2` THENL [ 312 SIMP_TAC list_ss [], 313 ASM_SIMP_TAC list_ss [] 314 ], 315 316 317 FULL_SIMP_TAC std_ss [] THEN 318 METIS_TAC[] 319 ] 320 ] 321 ) THEN 322 ASM_SIMP_TAC list_ss [PERM_CONS_IFF] THEN 323 324 Q.PAT_X_ASSUM `!l2. P l2 ==> PERM l1 l2` MATCH_MP_TAC THEN 325 ASM_SIMP_TAC list_ss [MEM_FILTER] THEN 326 CONJ_TAC THENL [ 327 MATCH_MP_TAC FILTER_ALL_DISTINCT THEN 328 ASM_REWRITE_TAC[], 329 330 METIS_TAC[] 331 ] 332]); 333 334 335val PERM_MAP = store_thm ("PERM_MAP", 336``!l1 l2. PERM l1 l2 ==> !f. (PERM (MAP f l1) (MAP f l2))``, 337 338 HO_MATCH_MP_TAC PERM_IND THEN 339 SIMP_TAC list_ss [] THEN 340 REPEAT STRIP_TAC THENL [ 341 REWRITE_TAC[PERM_REFL], 342 ASM_REWRITE_TAC[PERM_CONS_IFF], 343 ASM_REWRITE_TAC[PERM_SWAP_AT_FRONT], 344 PROVE_TAC [PERM_TRANS, PERM_SYM] 345 ]); 346 347 348val PERM_APPEND_IFF = store_thm ("PERM_APPEND_IFF", 349``(!l:'a list l1 l2. PERM (l++l1) (l++l2) = PERM l1 l2) /\ 350 (!l:'a list l1 l2. PERM (l1++l) (l2++l) = PERM l1 l2)``, 351 352 MATCH_MP_TAC (prove (``(a /\ (a ==> b)) ==> (a /\ b)``, PROVE_TAC[])) THEN 353 CONJ_TAC THENL [ 354 Induct_on `l` THENL [ 355 SIMP_TAC list_ss [], 356 ASM_SIMP_TAC list_ss [PERM_CONS_IFF] 357 ], 358 359 METIS_TAC[PERM_APPEND, PERM_TRANS] 360 ] 361); 362 363val PERM_FILTER = store_thm ("PERM_FILTER", 364``!l1 l2. PERM l1 l2 ==> !P. (PERM (FILTER P l1) (FILTER P l2))``, 365 366 HO_MATCH_MP_TAC PERM_IND THEN 367 SIMP_TAC list_ss [] THEN 368 REPEAT STRIP_TAC THENL [ 369 REWRITE_TAC[PERM_REFL], 370 Cases_on `P x` THEN ASM_REWRITE_TAC[PERM_CONS_IFF], 371 372 Cases_on `P x` THEN Cases_on `P y` THEN 373 ASM_REWRITE_TAC[PERM_SWAP_AT_FRONT, PERM_CONS_IFF], 374 375 PROVE_TAC [PERM_TRANS, PERM_SYM] 376 ]); 377 378 379 380val EL_HD_LAST = store_thm ("EL_HD_LAST", 381 ``!l. 0 < LENGTH l ==> 382 ((HD l = EL 0 l) /\ 383 (LAST l = EL (PRE (LENGTH l)) l))``, 384 385 SIMP_TAC list_ss [] THEN 386 Induct_on `l` THENL [ 387 SIMP_TAC list_ss [], 388 389 SIMP_TAC list_ss [] THEN 390 Cases_on `l` THENL [ 391 SIMP_TAC list_ss [], 392 FULL_SIMP_TAC list_ss [] 393 ] 394 ]); 395 396val MEM_FRONT = store_thm ("MEM_FRONT", 397 ``!l y. MEM y (FRONT (e::l)) ==> MEM y (e::l)``, 398 399Induct_on `l` THENL [ 400 SIMP_TAC list_ss [], 401 402 Cases_on `l` THEN 403 FULL_SIMP_TAC list_ss [DISJ_IMP_THM] THEN 404 METIS_TAC[] 405]); 406 407 408val LAST_APPEND = store_thm ("LAST_APPEND", 409 ``LAST (l1 ++ (e::l2)) = LAST (e::l2)``, 410 Induct_on `l1` THENL [ 411 SIMP_TAC list_ss [], 412 ASM_SIMP_TAC list_ss [LAST_DEF] 413 ]) 414 415val MEM_LAST = store_thm ("MEM_LAST", 416 ``!e l. MEM (LAST (e::l)) (e::l)``, 417 Induct_on `l` THENL [ 418 ASM_SIMP_TAC list_ss [], 419 420 SIMP_TAC std_ss [Once MEM, LAST_CONS] THEN 421 ASM_SIMP_TAC std_ss [] 422 ]) 423 424 425val ALL_DISTINCT_APPEND = store_thm ("ALL_DISTINCT_APPEND", 426 ``!l1 l2. ALL_DISTINCT (l1++l2) = 427 (ALL_DISTINCT l1 /\ ALL_DISTINCT l2 /\ 428 (!e. MEM e l1 ==> ~(MEM e l2)))``, 429 430 Induct_on `l1` THENL [ 431 SIMP_TAC list_ss [], 432 433 ASM_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM] THEN 434 PROVE_TAC[] 435 ]) 436 437val ALL_DISTINCT_SNOC = store_thm ("ALL_DISTINCT_SNOC", 438 ``!x l. ALL_DISTINCT (SNOC x l) = 439 ~(MEM x l) /\ (ALL_DISTINCT l)``, 440 441 SIMP_TAC list_ss [SNOC_APPEND, ALL_DISTINCT_APPEND] THEN 442 METIS_TAC[]) 443 444 445val FUNION_EQ_FEMPTY = store_thm ("FUNION_EQ_FEMPTY", 446``!h1 h2. (FUNION h1 h2 = FEMPTY) = ((h1 = FEMPTY) /\ (h2 = FEMPTY))``, 447 448 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FDOM_FEMPTY, FUNION_DEF, 449 NOT_IN_EMPTY, IN_UNION, DISJ_IMP_THM, FORALL_AND_THM] THEN 450 METIS_TAC[]); 451 452 453 454val SUBMAP___FUNION_EQ = store_thm ("SUBMAP___FUNION_EQ", 455``(!f1 f2 f3. DISJOINT (FDOM f1) (FDOM f2) ==> (((f1 SUBMAP (FUNION f2 f3)) = (f1 SUBMAP f3)))) /\ 456 (!f1 f2 f3. DISJOINT (FDOM f1) (FDOM f3 DIFF (FDOM f2)) ==> (((f1 SUBMAP (FUNION f2 f3)) = (f1 SUBMAP f2))))``, 457 458 SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, DISJOINT_DEF, EXTENSION, 459 NOT_IN_EMPTY, IN_INTER, IN_DIFF] THEN 460 METIS_TAC[]) 461 462 463val SUBMAP___FUNION = store_thm ("SUBMAP___FUNION", 464``!f1 f2 f3. (f1 SUBMAP f2) \/ ((DISJOINT (FDOM f1) (FDOM f2) /\ (f1 SUBMAP f3))) ==> (f1 SUBMAP (FUNION f2 f3))``, 465 466SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, DISJOINT_DEF, EXTENSION, 467 NOT_IN_EMPTY, IN_INTER] THEN 468METIS_TAC[]); 469 470val SUBMAP___FUNION___ID = store_thm ("SUBMAP___FUNION___ID", 471``(!f1 f2. (f1 SUBMAP (FUNION f1 f2))) /\ 472(!f1 f2. (DISJOINT (FDOM f1) (FDOM f2)) ==> (f2 SUBMAP (FUNION f1 f2)))``, 473 474METIS_TAC[SUBMAP_REFL, SUBMAP___FUNION, DISJOINT_SYM]); 475 476val FEMPTY_SUBMAP = store_thm ("FEMPTY_SUBMAP", 477 ``!h. h SUBMAP FEMPTY = (h = FEMPTY)``, 478 479 SIMP_TAC std_ss [SUBMAP_DEF, FDOM_FEMPTY, NOT_IN_EMPTY, GSYM fmap_EQ_THM, 480 EXTENSION] THEN 481 METIS_TAC[]); 482 483 484val FUNION_EQ = store_thm ("FUNION_EQ", 485``!f1 f2 f3. (DISJOINT (FDOM f1) (FDOM f2) /\ 486 DISJOINT (FDOM f1) (FDOM f3)) ==> 487 (((FUNION f1 f2) = (FUNION f1 f3)) = (f2 = f3))``, 488 489 SIMP_TAC std_ss [GSYM SUBMAP_ANTISYM, SUBMAP_DEF, FUNION_DEF, IN_UNION, DISJOINT_DEF, EXTENSION, 490 NOT_IN_EMPTY, IN_INTER, IN_DIFF] THEN 491 METIS_TAC[]) 492 493val FUNION_EQ___IMPL = store_thm ("FUNION_EQ___IMPL", 494``!f1 f2 f3. (DISJOINT (FDOM f1) (FDOM f2) /\ 495 DISJOINT (FDOM f1) (FDOM f3) /\ (f2 = f3)) ==> 496 ((FUNION f1 f2) = (FUNION f1 f3))``, 497 498 METIS_TAC[FUNION_EQ]); 499 500 501val DOMSUB_FUNION = store_thm ("DOMSUB_FUNION", 502``(FUNION f g) \\ k = FUNION (f \\ k) (g \\ k)``, 503 504SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, FUNION_DEF, EXTENSION, 505 IN_UNION, IN_DELETE] THEN 506REPEAT STRIP_TAC THENL [ 507 METIS_TAC[], 508 ASM_SIMP_TAC std_ss [DOMSUB_FAPPLY_NEQ, FUNION_DEF], 509 ASM_SIMP_TAC std_ss [DOMSUB_FAPPLY_NEQ, FUNION_DEF] 510]); 511 512 513val FUNION___COMM = store_thm ("FUNION___COMM", 514``!f g. (DISJOINT (FDOM f) (FDOM g)) ==> ((FUNION f g) = (FUNION g f))``, 515 516 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 517 METIS_TAC[]) 518 519val FUNION___ASSOC = store_thm ("FUNION___ASSOC", 520``!f g h. ((FUNION f (FUNION g h)) = (FUNION (FUNION f g) h))``, 521 522 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION, EXTENSION] THEN 523 METIS_TAC[]) 524 525val FRONT___APPEND = store_thm ("FRONT___APPEND", 526 527 ``FRONT (l1 ++ e::l2) = l1++FRONT(e::l2)``, 528 529 Induct_on `l1` THEN ASM_SIMP_TAC list_ss [FRONT_DEF]) 530 531 532val FRONT___LENGTH = store_thm ("FRONT___LENGTH", 533 ``!l. ~(l = []) ==> (LENGTH (FRONT l) = PRE (LENGTH l))``, 534 Induct_on `l` THENL [ 535 SIMP_TAC std_ss [], 536 537 ASM_SIMP_TAC list_ss [FRONT_DEF, COND_RATOR, COND_RAND] THEN 538 Cases_on `l` THEN SIMP_TAC list_ss [] 539 ]) 540 541 542val EL_FRONT = store_thm ("EL_FRONT", 543 ``!l n. ((n < LENGTH (FRONT l)) /\ (~(l = []))) ==> 544 (EL n (FRONT l) = EL n l)``, 545 546 Induct_on `l` THENL [ 547 SIMP_TAC list_ss [], 548 549 Cases_on `l` THEN 550 FULL_SIMP_TAC list_ss [FRONT___LENGTH] THEN 551 REPEAT STRIP_TAC THEN 552 Cases_on `n` THENL [ 553 SIMP_TAC list_ss [], 554 FULL_SIMP_TAC list_ss [] 555 ] 556 ]) 557 558 559val BUTFIRSTN___CONCAT_EL = store_thm ("BUTFIRSTN___CONCAT_EL", 560 ``!n. (n < LENGTH l) ==> 561 ((BUTFIRSTN n l) = (EL n l) :: (BUTFIRSTN (SUC n) l))``, 562 563 Induct_on `l` THENL [ 564 FULL_SIMP_TAC list_ss [], 565 566 FULL_SIMP_TAC list_ss [BUTFIRSTN] THEN 567 REPEAT STRIP_TAC THEN 568 Cases_on `n` THENL [ 569 SIMP_TAC list_ss [BUTFIRSTN], 570 FULL_SIMP_TAC list_ss [BUTFIRSTN] 571 ] 572 ]) 573 574 575val ALL_DISJOINT_def = Define ` 576 (ALL_DISJOINT [] = T) /\ 577 (ALL_DISJOINT (e1::l) = (EVERY (\e2. DISJOINT e1 e2) l) /\ ALL_DISJOINT l)` 578 579 580 581val EL_ALL_DISJOINT_EQ = store_thm ("EL_ALL_DISJOINT_EQ", 582 ``!l. ALL_DISJOINT l = 583 (!n1 n2. n1 < LENGTH l /\ n2 < LENGTH l ==> 584 (DISJOINT (EL n1 l) (EL n2 l) = (~(n1 = n2) \/ (EL n1 l = EMPTY))))``, 585 586 Induct_on `l` THENL [ 587 SIMP_TAC list_ss [ALL_DISJOINT_def], 588 589 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM] THEN 590 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 591 Cases_on `n1` THEN Cases_on `n2` THENL [ 592 SIMP_TAC list_ss [DISJOINT_DEF, EXTENSION, IN_INTER], 593 594 SIMP_TAC list_ss [] THEN 595 METIS_TAC[MEM_EL], 596 597 SIMP_TAC list_ss [] THEN 598 METIS_TAC[MEM_EL, DISJOINT_SYM], 599 600 SIMP_TAC list_ss [] THEN 601 METIS_TAC[] 602 ], 603 604 605 STRIP_TAC THENL [ 606 SIMP_TAC std_ss [MEM_EL, GSYM LEFT_FORALL_IMP_THM] THEN 607 GEN_TAC THEN 608 POP_ASSUM (fn thm => ASSUME_TAC (Q.SPECL [`0`, `SUC n`] thm)) THEN 609 FULL_SIMP_TAC list_ss [] THEN 610 METIS_TAC[], 611 612 REPEAT GEN_TAC THEN 613 POP_ASSUM (fn thm => ASSUME_TAC (Q.SPECL [`SUC n1`, `SUC n2`] thm)) THEN 614 FULL_SIMP_TAC list_ss [] 615 ] 616 ] 617 ]); 618 619val MAP_EQ_f = store_thm ("MAP_EQ_f", 620 621 ``!f1 f2 l. (MAP f1 l = MAP f2 l) = (!e. MEM e l ==> (f1 e = f2 e))``, 622 623 Induct_on `l` THENL [ 624 SIMP_TAC list_ss [], 625 626 ASM_SIMP_TAC list_ss [] THEN 627 METIS_TAC[] 628 ]) 629 630 631 632val DRESTRICT_FUNION = store_thm ("DRESTRICT_FUNION", 633 ``!h s1 s2. FUNION (DRESTRICT h s1) (DRESTRICT h s2) = 634 DRESTRICT h (s1 UNION s2)``, 635 636 SIMP_TAC std_ss [DRESTRICT_DEF, GSYM fmap_EQ_THM, EXTENSION, 637 FUNION_DEF, IN_INTER, IN_UNION, DISJ_IMP_THM, 638 LEFT_AND_OVER_OR]); 639 640 641 642val DRESTRICT_EQ_FUNION = store_thm ("DRESTRICT_EQ_FUNION", 643 ``!h h1 h2. (DISJOINT (FDOM h1) (FDOM h2)) /\ (FUNION h1 h2 = h) ==> (h2 = DRESTRICT h (COMPL (FDOM h1)))``, 644 645 SIMP_TAC std_ss [DRESTRICT_DEF, GSYM fmap_EQ_THM, EXTENSION, 646 FUNION_DEF, IN_INTER, IN_UNION, IN_COMPL, DISJOINT_DEF, 647 NOT_IN_EMPTY] THEN 648 METIS_TAC[]); 649 650 651 652val ALL_DISJOINT___PERM = store_thm ("ALL_DISJOINT___PERM", 653 ``!l1 l2. PERM l1 l2 ==> (ALL_DISJOINT l1 = ALL_DISJOINT l2)``, 654 655 `!l1 l2. PERM l1 l2 ==> ((PERM l1 l2) /\ (ALL_DISJOINT l1 = ALL_DISJOINT l2))` suffices_by (STRIP_TAC THEN 656 METIS_TAC[] 657 ) THEN 658 HO_MATCH_MP_TAC PERM_IND THEN 659 SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM] THEN 660 REPEAT STRIP_TAC THENL [ 661 REWRITE_TAC[PERM_REFL], 662 ASM_REWRITE_TAC[PERM_CONS_IFF], 663 METIS_TAC[PERM_MEM_EQ], 664 ASM_REWRITE_TAC[PERM_SWAP_AT_FRONT], 665 METIS_TAC[DISJOINT_SYM, PERM_MEM_EQ], 666 PROVE_TAC [PERM_TRANS, PERM_SYM] 667 ]) 668 669 670 671val ALL_DISTINCT___PERM = store_thm ("ALL_DISTINCT___PERM", 672 ``!l1 l2. PERM l1 l2 ==> (ALL_DISTINCT l1 = ALL_DISTINCT l2)``, 673 674 `!l1 l2. PERM l1 l2 ==> ((PERM l1 l2) /\ (ALL_DISTINCT l1 = ALL_DISTINCT l2))` suffices_by (STRIP_TAC THEN 675 METIS_TAC[] 676 ) THEN 677 HO_MATCH_MP_TAC PERM_IND THEN 678 SIMP_TAC list_ss [] THEN 679 REPEAT STRIP_TAC THENL [ 680 REWRITE_TAC[PERM_REFL], 681 ASM_REWRITE_TAC[PERM_CONS_IFF], 682 METIS_TAC[PERM_MEM_EQ], 683 ASM_REWRITE_TAC[PERM_SWAP_AT_FRONT], 684 METIS_TAC[DISJOINT_SYM, PERM_MEM_EQ], 685 PROVE_TAC [PERM_TRANS, PERM_SYM] 686 ]) 687 688 689val ALL_DISJOINT___PERM = store_thm ("ALL_DISJOINT___PERM", 690 ``!l1 l2. PERM l1 l2 ==> (ALL_DISJOINT l1 = ALL_DISJOINT l2)``, 691 692 `!l1 l2. PERM l1 l2 ==> ((PERM l1 l2) /\ (ALL_DISJOINT l1 = ALL_DISJOINT l2))` suffices_by (STRIP_TAC THEN 693 METIS_TAC[] 694 ) THEN 695 HO_MATCH_MP_TAC PERM_IND THEN 696 SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM] THEN 697 REPEAT STRIP_TAC THENL [ 698 REWRITE_TAC[PERM_REFL], 699 ASM_REWRITE_TAC[PERM_CONS_IFF], 700 METIS_TAC[PERM_MEM_EQ], 701 ASM_REWRITE_TAC[PERM_SWAP_AT_FRONT], 702 METIS_TAC[DISJOINT_SYM, PERM_MEM_EQ], 703 PROVE_TAC [PERM_TRANS, PERM_SYM] 704 ]) 705 706 707(*----------------------------------------------------------------------------------*) 708 709 710 711 712 713 714val _ = Hol_datatype `ds_value = 715 dsv_nil 716 | dsv_const of 'value` 717 718val ds_value_11 = DB.fetch "-" "ds_value_11"; 719val ds_value_distinct = DB.fetch "-" "ds_value_distinct"; 720 721val _ = type_abbrev("heap", Type `:'a |-> 'b |-> 'a ds_value`) 722 723val IS_DSV_NIL_def = Define ` 724 (IS_DSV_NIL dsv_nil = T) /\ 725 (IS_DSV_NIL _ = F)`; 726 727val IS_DSV_NIL_THM = store_thm ("IS_DSV_NIL_THM", 728 ``!x. IS_DSV_NIL x = (x = dsv_nil)``, 729 730 Cases_on `x` THENL [ 731 SIMP_TAC std_ss [IS_DSV_NIL_def], 732 SIMP_TAC std_ss [IS_DSV_NIL_def, ds_value_distinct] 733 ]) 734 735 736val NOT_IS_DSV_NIL_THM = store_thm ("NOT_IS_DSV_NIL_THM", 737 ``!x. ~(IS_DSV_NIL x) = ?c. (x = dsv_const c)``, 738 739 Cases_on `x` THENL [ 740 SIMP_TAC std_ss [IS_DSV_NIL_def, ds_value_distinct], 741 SIMP_TAC std_ss [IS_DSV_NIL_def, ds_value_11] 742 ]) 743 744 745val GET_DSV_VALUE_def = Define ` 746 (GET_DSV_VALUE (dsv_const v) = v)`; 747 748val GET_DSV_VALUE_11 = store_thm ("GET_DSV_VALUE_11", 749 ``!v1 v2. (~(IS_DSV_NIL v1) /\ ~(IS_DSV_NIL v2)) ==> 750 ((GET_DSV_VALUE v1 = GET_DSV_VALUE v2) = (v1 = v2))``, 751 752 Cases_on `v1` THEN Cases_on `v2` THEN 753 REWRITE_TAC[GET_DSV_VALUE_def, IS_DSV_NIL_def, ds_value_11]) 754 755 756val dsv_const_GET_DSV_VALUE = store_thm ("dsv_const_GET_DSV_VALUE", 757 ``!v. ~(IS_DSV_NIL v) ==> (dsv_const (GET_DSV_VALUE v) = v)``, 758 759 Cases_on `v` THEN 760 SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def]); 761 762val _ = Hol_datatype `ds_expression = 763 dse_const of 'value ds_value 764 | dse_var of 'vars`; 765 766 767val dse_nil_def = Define `dse_nil = dse_const dsv_nil` 768 769val _ = Hol_datatype `ds_pure_formula = 770 pf_true 771 | pf_equal of ('vars, 'value) ds_expression => ('vars, 'value) ds_expression 772 | pf_unequal of ('vars, 'value) ds_expression => ('vars, 'value) ds_expression 773 | pf_and of ds_pure_formula => ds_pure_formula`; 774 775val _ = Hol_datatype `ds_spatial_formula = 776 sf_emp 777 | sf_points_to of ('vars, 'value) ds_expression => ('field # ('vars, 'value) ds_expression) list 778 | sf_tree of 'field list => ('vars, 'value) ds_expression => ('vars, 'value) ds_expression 779 | sf_star of ds_spatial_formula => ds_spatial_formula`; 780 781 782val ds_expression_11 = DB.fetch "-" "ds_expression_11"; 783val ds_expression_distinct = DB.fetch "-" "ds_expression_distinct"; 784val ds_spatial_formula_11 = DB.fetch "-" "ds_spatial_formula_11"; 785val ds_spatial_formula_distinct = DB.fetch "-" "ds_spatial_formula_distinct"; 786 787 788val nchotomy_thm = prove (``!x. 789 (x = sf_emp) \/ (?d l. x = sf_points_to d l) \/ 790 (?l d d0. x = sf_tree l d d0) \/ ?d d0. x = sf_star d d0``, 791 REWRITE_TAC [TypeBase.nchotomy_of ``:('a,'b,'c) ds_spatial_formula``]); 792 793val _ = TypeBase.write [TypeBasePure.put_nchotomy nchotomy_thm (valOf (TypeBase.fetch ``:('a,'b,'c) ds_spatial_formula``))]; 794 795 796 797val SF_IS_SIMPLE_def = Define ` 798 (SF_IS_SIMPLE sf_emp = F) /\ 799 (SF_IS_SIMPLE (sf_star sf1 sf2) = F) /\ 800 (SF_IS_SIMPLE X = T)` 801 802val DS_EXPRESSION_EVAL_def = Define 803 `(DS_EXPRESSION_EVAL s (dse_var v) = (s v)) /\ 804 (DS_EXPRESSION_EVAL s (dse_const c) = c)` 805 806 807val DS_EXPRESSION_EQUAL_def = Define 808`!s e1 e2. DS_EXPRESSION_EQUAL s e1 e2 = 809 (DS_EXPRESSION_EVAL s e1 = DS_EXPRESSION_EVAL s e2)`; 810 811val DS_EXPRESSION_EVAL_VALUE_def = Define 812 `DS_EXPRESSION_EVAL_VALUE s e = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)`; 813 814val PF_SEM_def = Define 815 `(PF_SEM s pf_true = T) /\ 816 (PF_SEM s (pf_equal e1 e2) = (DS_EXPRESSION_EQUAL s e1 e2)) /\ 817 (PF_SEM s (pf_unequal e1 e2) = ~(DS_EXPRESSION_EQUAL s e1 e2)) /\ 818 (PF_SEM s (pf_and pf1 pf2) = ((PF_SEM s pf1) /\ (PF_SEM s pf2)))`; 819 820 821val HEAP_READ_ENTRY_def = Define 822 `HEAP_READ_ENTRY s (h:('a, 'b) heap) e f = 823 if (IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) then NONE else 824 if (~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN (FDOM h))) then NONE else 825 if (~(f IN (FDOM (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)))))) then NONE else 826 SOME ((h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))) ' f)`; 827 828 829val HEAP_READ_ENTRY_THM = store_thm ("HEAP_READ_ENTRY_THM", 830`` (!x. 831 (HEAP_READ_ENTRY s h e f = (SOME x)) = 832 833 (~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 834 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN (FDOM h) /\ 835 f IN (FDOM (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)))) /\ 836 (x = ((h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))) ' f)))) /\ 837 838 ((HEAP_READ_ENTRY s h e f = NONE) = 839 840 (IS_DSV_NIL (DS_EXPRESSION_EVAL s e) \/ 841 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN (FDOM h)) \/ 842 ~(f IN (FDOM (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))))))) /\ 843 844 (IS_SOME (HEAP_READ_ENTRY s h e f) = 845 846 (~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 847 (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN (FDOM h)) /\ 848 (f IN (FDOM (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))))))) 849``, 850 851 SIMP_TAC std_ss [HEAP_READ_ENTRY_def] THEN 852 METIS_TAC[optionTheory.option_CLAUSES]); 853 854 855val DS_POINTS_TO_def = Define ` 856 DS_POINTS_TO s h e1 a = 857 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1)) /\ 858 (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM h) /\ 859 EVERY (\(f, e). 860 ((f IN FDOM (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)))) /\ 861 ((DS_EXPRESSION_EVAL s e) = (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))) ' f))) a`; 862 863 864val DS_POINTS_TO___DOMSUB = store_thm ("DS_POINTS_TO___DOMSUB", 865 ``!s h e1 a k. 866 DS_POINTS_TO s (h\\k) e1 a ==> 867 DS_POINTS_TO s h e1 a``, 868 869 SIMP_TAC std_ss [DS_POINTS_TO_def, FDOM_DOMSUB, IN_DELETE, 870 DOMSUB_FAPPLY_THM] THEN 871 REPEAT STRIP_TAC THEN 872 Q.PAT_X_ASSUM `EVERY P l` MP_TAC THEN 873 ASM_SIMP_TAC std_ss []) 874 875 876val DS_POINTS_TO___SUBMAP = store_thm ("DS_POINTS_TO___SUBMAP", 877 ``!s h h' e1 a. 878 (h' SUBMAP h /\ DS_POINTS_TO s h' e1 a) ==> 879 DS_POINTS_TO s h e1 a``, 880 881 SIMP_TAC std_ss [DS_POINTS_TO_def, SUBMAP_DEF] THEN 882 METIS_TAC[]) 883 884 885val DS_POINTS_TO___SUBLIST = store_thm ("DS_POINTS_TO___SUBLIST", 886 ``!s h e a a'. 887 ((!x. MEM x a' ==> MEM x a) /\ DS_POINTS_TO s h e a) ==> 888 DS_POINTS_TO s h e a'``, 889 890 SIMP_TAC std_ss [DS_POINTS_TO_def, EVERY_MEM] THEN 891 METIS_TAC[]); 892 893 894val DS_POINTS_TO___SPLIT = 895 store_thm ("DS_POINTS_TO___SPLIT", 896 897``!s h e f aL. 898 (~(aL = [])) ==> 899 (DS_POINTS_TO s h e aL = 900 EVERY I (MAP (\a. DS_POINTS_TO s h e [a]) aL))``, 901 902Induct_on `aL` THENL [ 903 SIMP_TAC std_ss [], 904 905 SIMP_TAC list_ss [] THEN 906 Cases_on `aL` THENL [ 907 SIMP_TAC list_ss [], 908 909 FULL_SIMP_TAC list_ss [] THEN 910 POP_ASSUM (fn thm => ASSUME_TAC (GSYM thm)) THEN 911 ASM_SIMP_TAC std_ss [] THEN 912 913 SIMP_TAC list_ss [DS_POINTS_TO_def] THEN 914 METIS_TAC[] 915 ] 916]); 917 918 919 920 921val DS_POINTS_TO___HEAP_READ_ENTRY_THM = 922 store_thm ("DS_POINTS_TO___HEAP_READ_ENTRY_THM", 923 924``!s h e f c. 925 (HEAP_READ_ENTRY s h e f = SOME c) = 926 DS_POINTS_TO s h e [f, dse_const c]``, 927 928SIMP_TAC list_ss [HEAP_READ_ENTRY_THM, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def]); 929 930 931 932 933 934val SF_SEM___sf_tree_len_def = Define ` 935 (SF_SEM___sf_tree_len s h fL 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e2 e1)))) /\ 936 (SF_SEM___sf_tree_len s h fL (SUC n) e1 e2 = ( 937 (SF_SEM___sf_tree_len s h fL 0 e1 e2) \/ 938 939 (PF_SEM s (pf_unequal e2 e1)) /\ 940 (?cL hL. 941 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 942 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h /\ 943 (MAP (HEAP_READ_ENTRY s h e2) fL = cL) /\ 944 (EVERY IS_SOME cL) /\ 945 (LENGTH hL = LENGTH cL) /\ 946 ALL_DISJOINT (MAP FDOM hL) /\ 947 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) /\ 948 EVERY (\(c , h'). SF_SEM___sf_tree_len s h' fL n e1 (dse_const (THE c))) (ZIP (cL, hL))) 949 ))`; 950 951 952 953val SF_SEM___sf_tree_def = Define ` 954 SF_SEM___sf_tree s h fL e1 e2 = 955 ?n. SF_SEM___sf_tree_len s h fL n e1 e2` 956 957 958val WEAK_SF_SEM___sf_tree_len_def = Define ` 959 (WEAK_SF_SEM___sf_tree_len s h fL fL' 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e2 e1)))) /\ 960 (WEAK_SF_SEM___sf_tree_len s h fL fL' (SUC n) e1 e2 = ( 961 (SF_SEM___sf_tree_len s h fL 0 e1 e2) \/ 962 963 (PF_SEM s (pf_unequal e2 e1)) /\ 964 (?cL hL. 965 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 966 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h /\ 967 (MAP (HEAP_READ_ENTRY s h e2) fL = cL) /\ 968 (EVERY IS_SOME cL) /\ 969 (LENGTH hL = LENGTH cL) /\ 970 ALL_DISJOINT (MAP FDOM hL) /\ 971 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) /\ 972 EVERY (\(c , h'). SF_SEM___sf_tree_len s h' fL' n e1 (dse_const (THE c))) (ZIP (cL, hL))) 973 ))`; 974 975 976val WEAK_SF_SEM___sf_tree_len_THM = store_thm ("WEAK_SF_SEM___sf_tree_len_THM", 977 ``WEAK_SF_SEM___sf_tree_len s h fL fL n e1 e2 = 978 SF_SEM___sf_tree_len s h fL n e1 e2``, 979 980 Cases_on `n` THEN ( 981 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, WEAK_SF_SEM___sf_tree_len_def] 982 )); 983 984 985 986 987val BALANCED_SF_SEM___sf_tree_len_def = Define ` 988 (BALANCED_SF_SEM___sf_tree_len s h fL 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e2 e1)))) /\ 989 (BALANCED_SF_SEM___sf_tree_len s h fL (SUC n) e1 e2 = ( 990 (PF_SEM s (pf_unequal e2 e1)) /\ 991 (?cL hL. 992 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 993 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h /\ 994 (MAP (HEAP_READ_ENTRY s h e2) fL = cL) /\ 995 (EVERY IS_SOME cL) /\ 996 (LENGTH hL = LENGTH cL) /\ 997 ALL_DISJOINT (MAP FDOM hL) /\ 998 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) /\ 999 EVERY (\(c , h'). BALANCED_SF_SEM___sf_tree_len s h' fL n e1 (dse_const (THE c))) (ZIP (cL, hL))) 1000 ))`; 1001 1002 1003val BALANCED_SF_SEM___sf_tree_len_THM = store_thm ("BALANCED_SF_SEM___sf_tree_len_THM", 1004 ``!s h fL n e1 e2. 1005 BALANCED_SF_SEM___sf_tree_len s h fL n e1 e2 ==> 1006 SF_SEM___sf_tree_len s h fL n e1 e2``, 1007 1008 Induct_on `n` THENL [ 1009 SIMP_TAC std_ss [BALANCED_SF_SEM___sf_tree_len_def, SF_SEM___sf_tree_len_def], 1010 1011 SIMP_TAC std_ss [BALANCED_SF_SEM___sf_tree_len_def, SF_SEM___sf_tree_len_def] THEN 1012 REPEAT STRIP_TAC THEN 1013 DISJ2_TAC THEN 1014 Q.EXISTS_TAC `hL` THEN 1015 ASM_REWRITE_TAC[] THEN 1016 FULL_SIMP_TAC std_ss [EVERY_MEM] THEN 1017 REPEAT STRIP_TAC THEN 1018 RES_TAC THEN 1019 Cases_on `e` THEN 1020 FULL_SIMP_TAC std_ss [] 1021 ]) 1022 1023 1024 1025val SF_SEM___sf_tree_len_THM = store_thm ("SF_SEM___sf_tree_len_THM", 1026 ``!s h fL e1 e2 n1 n2. 1027 (n1 <= n2 /\ 1028 SF_SEM___sf_tree_len s h fL n1 e1 e2) ==> 1029 SF_SEM___sf_tree_len s h fL n2 e1 e2``, 1030 1031 Induct_on `n2` THENL [ 1032 SIMP_TAC std_ss [], 1033 1034 Cases_on `n1` THENL [ 1035 SIMP_TAC list_ss [SF_SEM___sf_tree_len_def], 1036 1037 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def] THEN 1038 REPEAT STRIP_TAC THENL [ 1039 ASM_SIMP_TAC std_ss [], 1040 1041 FULL_SIMP_TAC std_ss [PF_SEM_def] THEN 1042 Q.EXISTS_TAC `hL` THEN 1043 ASM_SIMP_TAC std_ss [] THEN 1044 Q.ABBREV_TAC `L = (ZIP (MAP (HEAP_READ_ENTRY s h e2) fL,hL))` THEN 1045 POP_ASSUM (fn thm => ALL_TAC) THEN 1046 Induct_on `L` THENL [ 1047 SIMP_TAC list_ss [], 1048 1049 GEN_TAC THEN 1050 Cases_on `h'` THEN 1051 ASM_SIMP_TAC list_ss [] THEN 1052 METIS_TAC[] 1053 ] 1054 ] 1055 ] 1056 ]); 1057 1058 1059 1060(* 1061val SF_SEM___sf_tree_len_SUBTREE_SUBLIST_THM = prove ( 1062 ``!s h f fL fL' e1 e2 n. 1063 ((SF_SEM___sf_tree_len s h fL n e1 e2) /\ (!f. MEM f fL' ==> MEM f fL) /\ 1064 ALL_DISTINCT fL') ==> 1065 ?h'. h' SUBMAP h /\ SF_SEM___sf_tree_len s h' fL' n e1 e2``, 1066 1067 1068 Induct_on `n` THENL [ 1069 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, SUBMAP_REFL], 1070 1071 SIMP_TAC std_ss [Once SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 1072 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 1073 REPEAT STRIP_TAC THENL [ 1074 ASM_SIMP_TAC std_ss [SUBMAP_REFL], 1075 1076 FULL_SIMP_TAC list_ss [PF_SEM_def, GSYM RIGHT_EXISTS_AND_THM, 1077 EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 1078 `?hL'. MAP (\f. (@h'. ?n'. (n' < LENGTH fL) /\ (EL n' fL = f) /\ 1079 (h' SUBMAP (EL n' hL)) /\ ( 1080 SF_SEM___sf_tree_len s h' fL' n e1 (dse_const (THE (HEAP_READ_ENTRY s h e2 f)))))) fL = hL'` 1081 by METIS_TAC[] THEN 1082 Q.EXISTS_TAC `FUNION (DRESTRICT h {DS_EXPRESSION_EVAL_VALUE s e2}) 1083 (FOLDR FUNION FEMPTY hL')` THEN 1084 Q.EXISTS_TAC `hL'` THEN 1085 Cases_on `DS_EXPRESSION_EVAL s e2` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def] THEN 1086 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, GET_DSV_VALUE_def, HEAP_READ_ENTRY_def, FDOM_FUNION, IN_UNION, 1087 IS_DSV_NIL_def, DRESTRICT_DEF, IN_INTER, DS_EXPRESSION_EVAL_VALUE_def, IN_SING, 1088 FUNION_DEF, DOMSUB_FUNION] 1089 1090 REPEAT STRIP_TAC THENL [ 1091 SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, DRESTRICT_DEF, 1092 IN_INTER, IN_INSERT, IN_UNION, NOT_IN_EMPTY] THEN 1093 GEN_TAC THEN 1094 Cases_on `x = v` THEN1 ( 1095 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] 1096 ) THEN 1097 ASM_REWRITE_TAC[] THEN 1098 `!e. MEM e hL' ==> e SUBMAP h` by ( 1099 Q.PAT_X_ASSUM `X = hL'` (ASSUME_TAC o GSYM) THEN 1100 ASM_SIMP_TAC std_ss [MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 1101 REPEAT STRIP_TAC THEN 1102 SELECT_ELIM_TAC THEN 1103 REPEAT STRIP_TAC THENL [ 1104 `?n. (EL n fL = f) /\ n < LENGTH fL` by METIS_TAC[MEM_EL] THEN 1105 1106 1107 1108 ASM_SIMP_TAC std_ss [] THEN 1109 Induct_on `fL` 1110 `MEM h' 1111 1112 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 1113 1114 Q_TAC MP_FREE_VAR_TAC `fL` THEN 1115 Q_TAC MP_FREE_VAR_TAC `h` THEN 1116 Q.SPEC_TAC (`fL`, `fL`) THEN 1117 Q.SPEC_TAC (`h`, `h`) THEN 1118 REWRITE_TAC[GSYM CONJ_ASSOC, AND_IMP_INTRO] THEN 1119 1120 Induct_on `t` THENL [ 1121 SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 1122 REPEAT STRIP_TAC THEN 1123 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] THEN 1124 1125 Q.EXISTS_TAC `DRESTRICT h {GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)}` THEN 1126 Q.EXISTS_TAC `[]` THEN 1127 1128 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, SUBMAP_DEF, DRESTRICT_DEF, 1129 IN_INTER, IN_SING, GSYM fmap_EQ_THM, EXTENSION, FDOM_FEMPTY, NOT_IN_EMPTY, 1130 FDOM_DOMSUB, IN_DELETE], 1131 1132 1133 SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 1134 REPEAT STRIP_TAC THEN 1135 1136 FULL_SIMP_TAC std_ss [ALL_DISJOINT_def, FDOM_FUNION, IN_UNION] THEN 1137 `DISJOINT (FDOM h) (FDOM (FOLDR FUNION FEMPTY t)) /\ 1138 DISJOINT (FDOM h') (FDOM (FOLDR FUNION FEMPTY t))` by ( 1139 REPEAT (Q.PAT_X_ASSUM `EVERY X (MAP FDOM t)` MP_TAC) THEN 1140 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1141 Induct_on `t` THENL [ 1142 SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY], 1143 FULL_SIMP_TAC list_ss [FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] 1144 ] 1145 ) THEN 1146 1147 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] THEN 1148 1149 Q.PAT_X_ASSUM `!h fL. P h fL` MP_TAC THEN 1150 SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN 1151 Q.EXISTS_TAC `DRESTRICT h'' (FDOM h'' DIFF FDOM h)` THEN 1152 Q.EXISTS_TAC `t'` THEN 1153 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 1154 1155 `~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h) /\ 1156 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h') /\ 1157 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM (FOLDR FUNION FEMPTY t))` by ( 1158 Q.PAT_X_ASSUM `FUNION h' X = Y` MP_TAC THEN 1159 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1160 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, IN_UNION, 1161 FDOM_DOMSUB, IN_DELETE] THEN 1162 METIS_TAC[] 1163 ) THEN 1164 1165 `(HEAP_READ_ENTRY s (DRESTRICT h'' (FDOM h'' DIFF FDOM h)) e2) = 1166 (HEAP_READ_ENTRY s h'' e2)` by ( 1167 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, DRESTRICT_DEF, 1168 IN_INTER, IN_DIFF] 1169 ) THEN 1170 1171 CONJ_TAC THEN1 ( 1172 ASM_REWRITE_TAC[] THEN 1173 Q.PAT_X_ASSUM `FUNION h' X = Y` MP_TAC THEN 1174 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 1175 GSYM fmap_EQ_THM, FUNION_DEF, DRESTRICT_DEF, IN_UNION, 1176 DOMSUB_FAPPLY_THM, FDOM_DOMSUB, IN_DELETE, IN_DIFF] THEN 1177 METIS_TAC[] 1178 ) THEN 1179 1180 STRIP_TAC THEN 1181 `?i. i SUBMAP h /\ (SF_SEM___sf_tree_len s i fL' n e1 1182 (dse_const (THE (HEAP_READ_ENTRY s h'' e2 h'''))))` by METIS_TAC[WEAK_SF_SEM___sf_tree_len_THM] THEN 1183 1184 Q.EXISTS_TAC `FUNION h'''' i` THEN 1185 Q.EXISTS_TAC `i::hL'` THEN 1186 1187 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, FDOM_FUNION, IN_UNION] THEN 1188 `(HEAP_READ_ENTRY s (FUNION h'''' i) e2) = 1189 (HEAP_READ_ENTRY s h'''' e2)` by ( 1190 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, FUNION_DEF, 1191 IN_INTER, IN_UNION] 1192 ) THEN 1193 `(HEAP_READ_ENTRY s h'''' e2) = 1194 (HEAP_READ_ENTRY s h'' e2)` by ( 1195 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1196 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, FUNION_DEF, 1197 IN_INTER, IN_UNION, SUBMAP_DEF, DRESTRICT_DEF] 1198 ) THEN 1199 ASM_SIMP_TAC list_ss [] THEN 1200 1201 REPEAT STRIP_TAC THENL [ 1202 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1203 Q.PAT_X_ASSUM `i SUBMAP X` MP_TAC THEN 1204 Q.PAT_X_ASSUM `FUNION X Y = h'' \\ Z` MP_TAC THEN 1205 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, SUBMAP_DEF, 1206 EXTENSION, DRESTRICT_DEF, FDOM_DOMSUB, DOMSUB_FAPPLY_THM, 1207 IN_UNION, IN_DELETE, IN_DIFF, IN_INTER] THEN 1208 FULL_SIMP_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY] THEN 1209 METIS_TAC[], 1210 1211 1212 1213 `DISJOINT (FDOM h) (FDOM (FOLDR FUNION FEMPTY hL'))` by ( 1214 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1215 1216 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, EXTENSION, DISJOINT_DEF, 1217 NOT_IN_EMPTY, IN_INTER, IN_DIFF, FDOM_DOMSUB, IN_DELETE] THEN 1218 METIS_TAC[] 1219 ) THEN 1220 POP_ASSUM MP_TAC THEN 1221 1222 Q.PAT_X_ASSUM `i SUBMAP h` MP_TAC THEN 1223 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1224 1225 Induct_on `hL'` THENL [ 1226 SIMP_TAC list_ss [], 1227 1228 FULL_SIMP_TAC list_ss [DISJOINT_UNION_BOTH, FUNION_DEF, DISJOINT_SYM] THEN 1229 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 1230 METIS_TAC[] 1231 ], 1232 1233 1234 `(i \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) = i` by ( 1235 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, SUBMAP_DEF, FDOM_DOMSUB, 1236 IN_DELETE, DOMSUB_FAPPLY_THM] THEN 1237 METIS_TAC[] 1238 ) THEN 1239 ASM_SIMP_TAC std_ss [DOMSUB_FUNION] THEN 1240 MATCH_MP_TAC FUNION___COMM THEN 1241 1242 Q.PAT_X_ASSUM `i SUBMAP h` MP_TAC THEN 1243 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1244 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, EXTENSION, DISJOINT_DEF, 1245 NOT_IN_EMPTY, IN_INTER, IN_DIFF, FDOM_DOMSUB, IN_DELETE] THEN 1246 METIS_TAC[], 1247 1248 METIS_TAC[] 1249 ] 1250 ] 1251 ] 1252 ]); 1253 1254*) 1255 1256 1257val WEAK_SF_SEM___sf_tree_len_SUBTREE_THM = prove ( 1258 ``!s h f fL fL' e1 e2 n. 1259 (WEAK_SF_SEM___sf_tree_len s h (f::fL) (f::fL') n e1 e2) ==> 1260 ?h'. h' SUBMAP h /\ WEAK_SF_SEM___sf_tree_len s h' fL fL' n e1 e2``, 1261 1262 1263 Induct_on `n` THENL [ 1264 SIMP_TAC std_ss [WEAK_SF_SEM___sf_tree_len_def] THEN 1265 METIS_TAC[SUBMAP_REFL], 1266 1267 SIMP_TAC std_ss [WEAK_SF_SEM___sf_tree_len_def, SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 1268 REPEAT STRIP_TAC THENL [ 1269 ASM_SIMP_TAC std_ss [SUBMAP_REFL], 1270 1271 FULL_SIMP_TAC list_ss [PF_SEM_def, GSYM RIGHT_EXISTS_AND_THM] THEN 1272 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 1273 1274 Q_TAC MP_FREE_VAR_TAC `fL` THEN 1275 Q_TAC MP_FREE_VAR_TAC `h` THEN 1276 Q.SPEC_TAC (`fL`, `fL`) THEN 1277 Q.SPEC_TAC (`h`, `h`) THEN 1278 REWRITE_TAC[GSYM CONJ_ASSOC, AND_IMP_INTRO] THEN 1279 1280 Induct_on `t` THENL [ 1281 SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 1282 REPEAT STRIP_TAC THEN 1283 1284 Q.EXISTS_TAC `DRESTRICT h {GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)}` THEN 1285 1286 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, SUBMAP_DEF, DRESTRICT_DEF, 1287 IN_INTER, IN_SING, GSYM fmap_EQ_THM, EXTENSION, FDOM_FEMPTY, NOT_IN_EMPTY, 1288 FDOM_DOMSUB, IN_DELETE], 1289 1290 1291 SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 1292 REPEAT STRIP_TAC THEN 1293 1294 FULL_SIMP_TAC std_ss [ALL_DISJOINT_def, FDOM_FUNION, IN_UNION] THEN 1295 `DISJOINT (FDOM h) (FDOM (FOLDR FUNION FEMPTY t)) /\ 1296 DISJOINT (FDOM h') (FDOM (FOLDR FUNION FEMPTY t))` by ( 1297 REPEAT (Q.PAT_X_ASSUM `EVERY X (MAP FDOM t)` MP_TAC) THEN 1298 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1299 Induct_on `t` THENL [ 1300 SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY], 1301 FULL_SIMP_TAC list_ss [FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] 1302 ] 1303 ) THEN 1304 1305 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] THEN 1306 1307 Q.PAT_X_ASSUM `!h fL. P h fL` MP_TAC THEN 1308 SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN 1309 Q.EXISTS_TAC `DRESTRICT h'' (FDOM h'' DIFF FDOM h)` THEN 1310 Q.EXISTS_TAC `t'` THEN 1311 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 1312 1313 `~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h) /\ 1314 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h') /\ 1315 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM (FOLDR FUNION FEMPTY t))` by ( 1316 Q.PAT_X_ASSUM `FUNION h' X = Y` MP_TAC THEN 1317 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1318 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, IN_UNION, 1319 FDOM_DOMSUB, IN_DELETE] THEN 1320 METIS_TAC[] 1321 ) THEN 1322 1323 `(HEAP_READ_ENTRY s (DRESTRICT h'' (FDOM h'' DIFF FDOM h)) e2) = 1324 (HEAP_READ_ENTRY s h'' e2)` by ( 1325 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, DRESTRICT_DEF, 1326 IN_INTER, IN_DIFF] 1327 ) THEN 1328 1329 CONJ_TAC THEN1 ( 1330 ASM_REWRITE_TAC[] THEN 1331 Q.PAT_X_ASSUM `FUNION h' X = Y` MP_TAC THEN 1332 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 1333 GSYM fmap_EQ_THM, FUNION_DEF, DRESTRICT_DEF, IN_UNION, 1334 DOMSUB_FAPPLY_THM, FDOM_DOMSUB, IN_DELETE, IN_DIFF] THEN 1335 METIS_TAC[] 1336 ) THEN 1337 1338 STRIP_TAC THEN 1339 `?i. i SUBMAP h /\ (SF_SEM___sf_tree_len s i fL' n e1 1340 (dse_const (THE (HEAP_READ_ENTRY s h'' e2 h'''))))` by METIS_TAC[WEAK_SF_SEM___sf_tree_len_THM] THEN 1341 1342 Q.EXISTS_TAC `FUNION h'''' i` THEN 1343 Q.EXISTS_TAC `i::hL'` THEN 1344 1345 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, FDOM_FUNION, IN_UNION] THEN 1346 `(HEAP_READ_ENTRY s (FUNION h'''' i) e2) = 1347 (HEAP_READ_ENTRY s h'''' e2)` by ( 1348 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, FUNION_DEF, 1349 IN_INTER, IN_UNION] 1350 ) THEN 1351 `(HEAP_READ_ENTRY s h'''' e2) = 1352 (HEAP_READ_ENTRY s h'' e2)` by ( 1353 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1354 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FUN_EQ_THM, FUNION_DEF, 1355 IN_INTER, IN_UNION, SUBMAP_DEF, DRESTRICT_DEF] 1356 ) THEN 1357 ASM_SIMP_TAC list_ss [] THEN 1358 1359 REPEAT STRIP_TAC THENL [ 1360 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1361 Q.PAT_X_ASSUM `i SUBMAP X` MP_TAC THEN 1362 Q.PAT_X_ASSUM `FUNION X Y = h'' \\ Z` MP_TAC THEN 1363 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, SUBMAP_DEF, 1364 EXTENSION, DRESTRICT_DEF, FDOM_DOMSUB, DOMSUB_FAPPLY_THM, 1365 IN_UNION, IN_DELETE, IN_DIFF, IN_INTER] THEN 1366 FULL_SIMP_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY] THEN 1367 METIS_TAC[], 1368 1369 1370 1371 `DISJOINT (FDOM h) (FDOM (FOLDR FUNION FEMPTY hL'))` by ( 1372 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1373 1374 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, EXTENSION, DISJOINT_DEF, 1375 NOT_IN_EMPTY, IN_INTER, IN_DIFF, FDOM_DOMSUB, IN_DELETE] THEN 1376 METIS_TAC[] 1377 ) THEN 1378 POP_ASSUM MP_TAC THEN 1379 1380 Q.PAT_X_ASSUM `i SUBMAP h` MP_TAC THEN 1381 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1382 1383 Induct_on `hL'` THENL [ 1384 SIMP_TAC list_ss [], 1385 1386 FULL_SIMP_TAC list_ss [DISJOINT_UNION_BOTH, FUNION_DEF, DISJOINT_SYM] THEN 1387 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 1388 METIS_TAC[] 1389 ], 1390 1391 1392 `(i \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) = i` by ( 1393 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, SUBMAP_DEF, FDOM_DOMSUB, 1394 IN_DELETE, DOMSUB_FAPPLY_THM] THEN 1395 METIS_TAC[] 1396 ) THEN 1397 ASM_SIMP_TAC std_ss [DOMSUB_FUNION] THEN 1398 MATCH_MP_TAC FUNION___COMM THEN 1399 1400 Q.PAT_X_ASSUM `i SUBMAP h` MP_TAC THEN 1401 Q.PAT_X_ASSUM `h'''' SUBMAP X` MP_TAC THEN 1402 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, EXTENSION, DISJOINT_DEF, 1403 NOT_IN_EMPTY, IN_INTER, IN_DIFF, FDOM_DOMSUB, IN_DELETE] THEN 1404 METIS_TAC[], 1405 1406 METIS_TAC[] 1407 ] 1408 ] 1409 ] 1410 ]); 1411 1412 1413 1414 1415val SF_SEM___sf_tree_len___EXTENDED_DEF = store_thm ("SF_SEM___sf_tree_len___EXTENDED_DEF", 1416``(SF_SEM___sf_tree_len s h fL 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e2 e1)))) /\ 1417 (SF_SEM___sf_tree_len s h fL (SUC n) e1 e2 = ( 1418 (SF_SEM___sf_tree_len s h fL 0 e1 e2) \/ 1419 1420 (PF_SEM s (pf_unequal e2 e1)) /\ 1421 (?hL. 1422 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 1423 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h /\ 1424 (!f. MEM f fL ==> IS_SOME (HEAP_READ_ENTRY s h e2 f)) /\ 1425 (LENGTH hL = LENGTH fL) /\ 1426 ALL_DISJOINT (MAP FDOM hL) /\ 1427 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) /\ 1428 (!h'. MEM h' hL ==> h' SUBMAP h) /\ 1429 (!n'. n' < LENGTH hL ==> (SF_SEM___sf_tree_len s (EL n' hL) fL n e1 1430 (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) ' (EL n' fL))))) /\ 1431 (!x. x IN FDOM h /\ ~(dsv_const x = DS_EXPRESSION_EVAL s e2) ==> 1432 ?h'. MEM h' hL /\ x IN FDOM h') 1433 ) 1434 ))``, 1435 1436 1437 1438SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, 1439EVERY_MEM, GSYM LEFT_FORALL_IMP_THM, MEM_MAP] THEN 1440Cases_on `DS_EXPRESSION_EQUAL s e2 e1` THEN ASM_REWRITE_TAC[] THEN 1441STRIP_EQ_EXISTS_TAC THEN 1442STRIP_EQ_BOOL_TAC THEN 1443FULL_SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_FORALL_IMP_THM, EL_MAP, 1444 HEAP_READ_ENTRY_THM] THEN 1445MATCH_MP_TAC (prove (``(a /\ b /\ (c' = c)) ==> (c' = (a /\ c /\ b))``, METIS_TAC[])) THEN 1446REPEAT CONJ_TAC THENL [ 1447 REPEAT STRIP_TAC THEN 1448 `h' SUBMAP FOLDR FUNION FEMPTY hL` suffices_by (STRIP_TAC THEN 1449 POP_ASSUM MP_TAC THEN 1450 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DOMSUB_FAPPLY_THM, FDOM_DOMSUB, IN_DELETE] 1451 ) THEN 1452 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 1453 Q.PAT_X_ASSUM `ALL_DISJOINT X` MP_TAC THEN 1454 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1455 Induct_on `hL` THENL [ 1456 SIMP_TAC list_ss [], 1457 1458 SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 1459 METIS_TAC[SUBMAP___FUNION, DISJOINT_SYM, SUBMAP___FUNION___ID] 1460 ], 1461 1462 1463 REPEAT STRIP_TAC THENL [ 1464 `x IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 1465 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] THEN 1466 Cases_on `DS_EXPRESSION_EVAL s e2` THEN ( 1467 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, IS_DSV_NIL_def, ds_value_11] 1468 ) 1469 ) THEN 1470 POP_ASSUM MP_TAC THEN 1471 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1472 Induct_on `hL` THENL [ 1473 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 1474 1475 SIMP_TAC list_ss [FDOM_FUNION, IN_UNION] THEN 1476 METIS_TAC[] 1477 ] 1478 ], 1479 1480 1481 STRIP_EQ_FORALL_TAC THEN 1482 STRIP_EQ_BOOL_TAC THEN 1483 FULL_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, MEM_EL, GSYM LEFT_FORALL_IMP_THM] 1484]); 1485 1486 1487 1488 1489 1490val BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF = store_thm ("BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF", 1491``(BALANCED_SF_SEM___sf_tree_len s h fL 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e2 e1)))) /\ 1492 (BALANCED_SF_SEM___sf_tree_len s h fL (SUC n) e1 e2 = ( 1493 (PF_SEM s (pf_unequal e2 e1)) /\ 1494 (?hL. 1495 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 1496 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h /\ 1497 (!f. MEM f fL ==> IS_SOME (HEAP_READ_ENTRY s h e2 f)) /\ 1498 (LENGTH hL = LENGTH fL) /\ 1499 ALL_DISJOINT (MAP FDOM hL) /\ 1500 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) /\ 1501 (!h'. MEM h' hL ==> h' SUBMAP h) /\ 1502 (!n'. n' < LENGTH hL ==> (BALANCED_SF_SEM___sf_tree_len s (EL n' hL) fL n e1 1503 (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2)) ' (EL n' fL))))) /\ 1504 (!x. x IN FDOM h /\ ~(dsv_const x = DS_EXPRESSION_EVAL s e2) ==> 1505 ?h'. MEM h' hL /\ x IN FDOM h') 1506 ) 1507 ))``, 1508 1509 1510SIMP_TAC list_ss [BALANCED_SF_SEM___sf_tree_len_def, PF_SEM_def, 1511EVERY_MEM, GSYM LEFT_FORALL_IMP_THM, MEM_MAP] THEN 1512STRIP_EQ_BOOL_TAC THEN 1513STRIP_EQ_EXISTS_TAC THEN 1514STRIP_EQ_BOOL_TAC THEN 1515FULL_SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_FORALL_IMP_THM, EL_MAP, 1516 HEAP_READ_ENTRY_THM] THEN 1517MATCH_MP_TAC (prove (``(a /\ b /\ (c' = c)) ==> (c' = (a /\ c /\ b))``, METIS_TAC[])) THEN 1518REPEAT CONJ_TAC THENL [ 1519 REPEAT STRIP_TAC THEN 1520 `h' SUBMAP FOLDR FUNION FEMPTY hL` suffices_by (STRIP_TAC THEN 1521 POP_ASSUM MP_TAC THEN 1522 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DOMSUB_FAPPLY_THM, FDOM_DOMSUB, IN_DELETE] 1523 ) THEN 1524 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 1525 Q.PAT_X_ASSUM `ALL_DISJOINT X` MP_TAC THEN 1526 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1527 Induct_on `hL` THENL [ 1528 SIMP_TAC list_ss [], 1529 1530 SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 1531 METIS_TAC[SUBMAP___FUNION, DISJOINT_SYM, SUBMAP___FUNION___ID] 1532 ], 1533 1534 1535 REPEAT STRIP_TAC THENL [ 1536 `x IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 1537 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] THEN 1538 Cases_on `DS_EXPRESSION_EVAL s e2` THEN ( 1539 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, IS_DSV_NIL_def, ds_value_11] 1540 ) 1541 ) THEN 1542 POP_ASSUM MP_TAC THEN 1543 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 1544 Induct_on `hL` THENL [ 1545 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 1546 1547 SIMP_TAC list_ss [FDOM_FUNION, IN_UNION] THEN 1548 METIS_TAC[] 1549 ] 1550 ], 1551 1552 1553 STRIP_EQ_FORALL_TAC THEN 1554 STRIP_EQ_BOOL_TAC THEN 1555 FULL_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, MEM_EL, GSYM LEFT_FORALL_IMP_THM] 1556]); 1557 1558 1559 1560 1561val SF_SEM___sf_tree_len_SUBTREE_THM = store_thm ("SF_SEM___sf_tree_len_SUBTREE_THM", 1562 ``!s h f fL e1 e2 n. 1563 (SF_SEM___sf_tree_len s h (f::fL) n e1 e2) ==> 1564 ?h'. h' SUBMAP h /\ SF_SEM___sf_tree_len s h' fL n e1 e2``, 1565 1566 METIS_TAC[WEAK_SF_SEM___sf_tree_len_SUBTREE_THM, WEAK_SF_SEM___sf_tree_len_THM]) 1567 1568 1569 1570val SF_SEM___sf_tree_len_PERM_THM = store_thm ("SF_SEM___sf_tree_len_PERM_THM", 1571 ``!fL fL' n. 1572 PERM fL fL' ==> 1573 !s h es e. 1574 (SF_SEM___sf_tree_len s h fL n es e = 1575 SF_SEM___sf_tree_len s h fL' n es e)``, 1576 1577 SIMP_TAC std_ss [EQ_IMP_THM, FORALL_AND_THM, IMP_CONJ_THM] THEN 1578 MATCH_MP_TAC (prove (``(a ==> b) /\ a ==> a /\ b``, METIS_TAC[])) THEN 1579 CONJ_TAC THEN1 METIS_TAC[PERM_SYM] THEN 1580 1581 Induct_on `n` THEN1 ( 1582 REWRITE_TAC [SF_SEM___sf_tree_len_def] 1583 ) THEN 1584 REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN 1585 `!s h es e. 1586 SF_SEM___sf_tree_len s h fL' n es e = 1587 SF_SEM___sf_tree_len s h fL n es e` by METIS_TAC[PERM_SYM] THEN 1588 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 1589 `!x. MEM x fL' = MEM x fL` by METIS_TAC[PERM_MEM_EQ] THEN 1590 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN ASM_REWRITE_TAC[] THEN 1591 1592 STRIP_TAC THEN 1593 FULL_SIMP_TAC list_ss [] THEN 1594 `?hL'. PERM hL hL' /\ 1595 (!x. MEM x (ZIP (fL', hL')) = MEM x (ZIP (fL, hL)))` suffices_by (STRIP_TAC THEN 1596 Q.EXISTS_TAC `hL'` THEN 1597 FULL_SIMP_TAC list_ss [] THEN 1598 REPEAT STRIP_TAC THENL [ 1599 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP], 1600 METIS_TAC[PERM_LENGTH], 1601 METIS_TAC[PERM_MAP, ALL_DISJOINT___PERM], 1602 1603 `!hL hL':('c, 'a) heap list. PERM hL hL' ==> 1604 ((ALL_DISJOINT (MAP FDOM hL) /\ ALL_DISJOINT (MAP FDOM hL)) ==> 1605 (PERM hL hL' /\ (FOLDR FUNION FEMPTY hL = FOLDR FUNION FEMPTY hL')))` suffices_by (STRIP_TAC THEN 1606 METIS_TAC[PERM_MAP, ALL_DISJOINT___PERM] 1607 ) THEN 1608 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 1609 1610 HO_MATCH_MP_TAC PERM_IND THEN 1611 SIMP_TAC list_ss [PERM_REFL, PERM_CONS_IFF, PERM_SWAP_AT_FRONT, 1612 ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 1613 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 1614 REPEAT STRIP_TAC THENL [ 1615 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, IN_UNION, DISJ_IMP_THM] THEN 1616 METIS_TAC[], 1617 1618 `ALL_DISJOINT (MAP FDOM hL')` by METIS_TAC[PERM_MAP, ALL_DISJOINT___PERM] THEN 1619 FULL_SIMP_TAC std_ss [] THEN 1620 PROVE_TAC[PERM_TRANS], 1621 1622 `ALL_DISJOINT (MAP FDOM hL')` by METIS_TAC[PERM_MAP, ALL_DISJOINT___PERM] THEN 1623 FULL_SIMP_TAC std_ss [] 1624 ], 1625 1626 1627 FULL_SIMP_TAC std_ss [EVERY_MEM] THEN 1628 REPEAT STRIP_TAC THEN 1629 Q.PAT_X_ASSUM `!e. MEM e Z ==> P e` MATCH_MP_TAC THEN 1630 Q.PAT_X_ASSUM `MEM e' Z` MP_TAC THEN 1631 Q.PAT_X_ASSUM `!e'. P e'` MP_TAC THEN 1632 `(LENGTH fL' = LENGTH fL) /\ (LENGTH hL' = LENGTH hL)` by METIS_TAC[PERM_LENGTH] THEN 1633 ASM_SIMP_TAC list_ss [MEM_ZIP] THEN 1634 REPEAT STRIP_TAC THEN 1635 `?n. (n < LENGTH fL) /\ ((EL n' fL', EL n' hL') = (EL n fL, EL n hL))` by METIS_TAC[] THEN 1636 Q.EXISTS_TAC `n''` THEN 1637 FULL_SIMP_TAC std_ss [EL_MAP] 1638 ] 1639 ) THEN 1640 1641 1642 `!fL:('a list) fL'. 1643 PERM fL fL' ==> (PERM fL fL' /\ 1644 !hL:('c, 'a) heap list. 1645 (LENGTH hL = LENGTH fL) ==> 1646 ?hL'. PERM hL hL' /\ !x. MEM x (ZIP (fL',hL')) = MEM x (ZIP (fL,hL)))` suffices_by (STRIP_TAC THEN 1647 METIS_TAC[] 1648 ) THEN 1649 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 1650 1651 HO_MATCH_MP_TAC PERM_IND THEN 1652 SIMP_TAC list_ss [PERM_REFL, PERM_SWAP_AT_FRONT, PERM_CONS_IFF, 1653 LENGTH_NIL, PERM_NIL] THEN 1654 REPEAT STRIP_TAC THENL [ 1655 REPEAT STRIP_TAC THEN 1656 `?h hL''. hL = h::hL''` by ( 1657 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] 1658 ) THEN 1659 Q.PAT_X_ASSUM `!e. P e` (fn thm => MP_TAC (Q.SPEC `hL''` thm)) THEN 1660 FULL_SIMP_TAC list_ss [] THEN 1661 REPEAT STRIP_TAC THEN 1662 Q.EXISTS_TAC `h::hL'` THEN 1663 ASM_SIMP_TAC list_ss [PERM_CONS_IFF], 1664 1665 1666 REPEAT STRIP_TAC THEN 1667 `?h1 h2 hL''. hL = h1::h2::hL''` by ( 1668 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 1669 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] 1670 ) THEN 1671 Q.PAT_X_ASSUM `!e. P e` (fn thm => MP_TAC (Q.SPEC `hL''` thm)) THEN 1672 FULL_SIMP_TAC list_ss [] THEN 1673 REPEAT STRIP_TAC THEN 1674 Q.EXISTS_TAC `h2::h1::hL'` THEN 1675 ASM_SIMP_TAC list_ss [PERM_SWAP_AT_FRONT] THEN 1676 PROVE_TAC[], 1677 1678 1679 METIS_TAC[PERM_TRANS], 1680 METIS_TAC[PERM_LENGTH,PERM_REFL,PERM_TRANS] 1681 ] 1682); 1683 1684 1685 1686 1687 1688val SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM = store_thm ("SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM", 1689 ``!s h fL es es' e e' n. 1690 DS_EXPRESSION_EQUAL s es es' /\ 1691 DS_EXPRESSION_EQUAL s e e' ==> 1692 (SF_SEM___sf_tree_len s h fL n es e = 1693 SF_SEM___sf_tree_len s h fL n es' e')``, 1694 1695Induct_on `n` THENL [ 1696 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def], 1697 1698 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 1699 REPEAT STRIP_TAC THEN 1700 Cases_on `(DS_EXPRESSION_EVAL s e' = DS_EXPRESSION_EVAL s es')` THEN ASM_REWRITE_TAC[] THEN 1701 `HEAP_READ_ENTRY s h e = HEAP_READ_ENTRY s h e'` by ( 1702 ASM_SIMP_TAC std_ss [FUN_EQ_THM, HEAP_READ_ENTRY_def] 1703 ) THEN 1704 STRIP_EQ_EXISTS_TAC THEN 1705 ASM_SIMP_TAC std_ss [EVERY_MEM] THEN 1706 STRIP_EQ_BOOL_TAC THEN 1707 STRIP_EQ_FORALL_TAC THEN 1708 STRIP_EQ_BOOL_TAC THEN 1709 pairLib.GEN_BETA_TAC THEN 1710 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 1711 ASM_REWRITE_TAC[] 1712]); 1713 1714 1715val SF_SEM_def = Define 1716 `(SF_SEM s (h:('b, 'c) heap) sf_emp = (h = FEMPTY)) /\ 1717 (SF_SEM s h (sf_points_to e a) = 1718 ((FDOM h = {DS_EXPRESSION_EVAL_VALUE s e}) /\ 1719 DS_POINTS_TO s h e a)) /\ 1720 (SF_SEM s h (sf_star sf1 sf2) = 1721 ?h1 h2. (h = FUNION h1 h2) /\ (DISJOINT (FDOM h1) (FDOM h2)) /\ 1722 (SF_SEM s h1 sf1 /\ SF_SEM s h2 sf2)) /\ 1723 (SF_SEM s h (sf_tree fL es e) = SF_SEM___sf_tree s h fL es e)`; 1724 1725 1726 1727val DS_SEM_def = Define 1728 `DS_SEM s h (pf, sf) = 1729 PF_SEM s pf /\ SF_SEM s h sf` 1730 1731val PF_ENTAILS_def = Define 1732 `PF_ENTAILS pf1 pf2 = 1733 !s. PF_SEM s pf1 ==> PF_SEM s pf2` 1734 1735val PF_EQUIV_def = Define 1736 `PF_EQUIV pf1 pf2 = 1737 !s. PF_SEM s pf1 = PF_SEM s pf2` 1738 1739val SF_ENTAILS_def = Define 1740 `SF_ENTAILS sf1 sf2 = 1741 !s h. (SF_SEM s h sf1 ==> SF_SEM s h sf2)` 1742 1743val SF_EQUIV_def = Define 1744 `SF_EQUIV sf1 sf2 = 1745 !s h. (SF_SEM s h sf1 = SF_SEM s h sf2)` 1746 1747val DS_ENTAILS_def = Define 1748 `DS_ENTAILS f1 f2 = 1749 !s h. (DS_SEM s h f1 ==> DS_SEM s h f2)` 1750 1751val DS_EQUIV_def = Define 1752 `DS_EQUIV f1 f2 = 1753 !s h. (DS_SEM s h f1 = DS_SEM s h f2)` 1754 1755val DS_EQUIV___ENTAILS = store_thm ("DS_EQUIV___ENTAILS", 1756``!f1 f2. DS_EQUIV f1 f2 = (DS_ENTAILS f1 f2 /\ DS_ENTAILS f2 f1)``, 1757 1758SIMP_TAC std_ss [DS_ENTAILS_def, DS_EQUIV_def] THEN 1759PROVE_TAC[]); 1760 1761 1762 1763val SF_STAR_CONG = store_thm ("SF_STAR_CONG", 1764 ``(SF_EQUIV sf1 sf1' /\ 1765 SF_EQUIV sf2 sf2') ==> 1766 (SF_EQUIV (sf_star sf1 sf2) (sf_star sf1' sf2'))``, 1767 1768 SIMP_TAC std_ss [SF_EQUIV_def, SF_SEM_def]) 1769 1770 1771(*access just a part of SF_SEM_def, technical theorem used for rewriting*) 1772val SF_SEM___STAR_THM = save_thm ("SF_SEM___STAR_THM", 1773 SIMP_CONV std_ss [SF_SEM_def] ``SF_SEM s h (sf_star sf1 sf2)``); 1774 1775val SF_SEM___STAR_EMP = store_thm ("SF_SEM___STAR_EMP", 1776 ``(SF_EQUIV (sf_star sf sf_emp) sf) /\ 1777 (SF_EQUIV (sf_star sf_emp sf) sf)``, 1778 1779 SIMP_TAC std_ss [SF_SEM_def, SF_EQUIV_def, FDOM_FEMPTY, pred_setTheory.DISJOINT_EMPTY, 1780 FUNION_FEMPTY_2, FUNION_FEMPTY_1]) 1781 1782val SF_SEM_EMP_EXTEND = store_thm ("SF_SEM_EMP_EXTEND", 1783 ``!s h sf. SF_SEM s h sf = SF_SEM s h (sf_star sf sf_emp)``, 1784 1785 SIMP_TAC std_ss [SF_SEM_def, SF_EQUIV_def, FDOM_FEMPTY, pred_setTheory.DISJOINT_EMPTY, 1786 FUNION_FEMPTY_2, FUNION_FEMPTY_1]) 1787 1788val SF_SEM___STAR_ASSOC = store_thm ("SF_SEM___STAR_ASSOC", 1789 ``!s h. SF_SEM s h (sf_star (sf_star sf1 sf2) sf3) = 1790 SF_SEM s h (sf_star sf1 (sf_star sf2 sf3))``, 1791 1792 SIMP_TAC std_ss [SF_SEM_def, GSYM RIGHT_EXISTS_AND_THM, 1793 GSYM LEFT_EXISTS_AND_THM] THEN 1794 REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ 1795 Q.EXISTS_TAC `h1'` THEN 1796 Q.EXISTS_TAC `h2'` THEN 1797 Q.EXISTS_TAC `h2` THEN 1798 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, FDOM_FUNION, 1799 IN_UNION, NOT_IN_EMPTY] THEN 1800 REPEAT STRIP_TAC THENL [ 1801 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, IN_UNION, FUNION_DEF] THEN 1802 METIS_TAC[], 1803 1804 METIS_TAC[], 1805 METIS_TAC[] 1806 ], 1807 1808 Q.EXISTS_TAC `h2'` THEN 1809 Q.EXISTS_TAC `h1` THEN 1810 Q.EXISTS_TAC `h1'` THEN 1811 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, FDOM_FUNION, 1812 IN_UNION, NOT_IN_EMPTY] THEN 1813 REPEAT STRIP_TAC THENL [ 1814 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, IN_UNION, FUNION_DEF] THEN 1815 METIS_TAC[], 1816 1817 METIS_TAC[], 1818 METIS_TAC[] 1819 ] 1820 ]) 1821 1822 1823val SF_SEM___STAR_COMM = store_thm ("SF_SEM___STAR_COMM", 1824 ``!s h. SF_SEM s h (sf_star sf1 sf2) = 1825 SF_SEM s h (sf_star sf2 sf1)``, 1826 1827 SIMP_TAC std_ss [SF_SEM_def] THEN 1828 REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ 1829 Q.EXISTS_TAC `h2` THEN 1830 Q.EXISTS_TAC `h1` THEN 1831 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, FDOM_FUNION, 1832 IN_UNION, NOT_IN_EMPTY] THEN 1833 REPEAT STRIP_TAC THENL [ 1834 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, IN_UNION, FUNION_DEF] THEN 1835 METIS_TAC[], 1836 1837 METIS_TAC[] 1838 ], 1839 1840 Q.EXISTS_TAC `h2` THEN 1841 Q.EXISTS_TAC `h1` THEN 1842 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, FDOM_FUNION, 1843 IN_UNION, NOT_IN_EMPTY] THEN 1844 REPEAT STRIP_TAC THENL [ 1845 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, IN_UNION, FUNION_DEF] THEN 1846 METIS_TAC[], 1847 1848 METIS_TAC[] 1849 ] 1850 ]); 1851 1852 1853val SF_SEM___STAR_ASSOC_COMM1 = store_thm ("SF_SEM___STAR_ASSOC_COMM1", 1854``!s h sf1 sf2 sf3. 1855 SF_SEM s h (sf_star sf1 (sf_star sf2 sf3)) = 1856 SF_SEM s h (sf_star sf2 (sf_star sf1 sf3))``, 1857 1858 1859 1860REWRITE_TAC [Once SF_SEM___STAR_COMM] THEN 1861REWRITE_TAC [SF_SEM___STAR_ASSOC] THEN 1862REWRITE_TAC [Once SF_SEM___STAR_THM] THEN 1863REWRITE_TAC [Once SF_SEM___STAR_COMM] THEN 1864REWRITE_TAC [SF_SEM___STAR_THM]); 1865 1866 1867 1868val SF_SEM___sf_tree_THM1 = prove ( 1869 ``!s h fL es e. 1870 1871 SF_SEM s h (sf_tree fL es e) = ( 1872 if (DS_EXPRESSION_EQUAL s e es) then 1873 (h = FEMPTY) 1874 else 1875 (?cL hL n. 1876 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 1877 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h /\ 1878 (MAP (HEAP_READ_ENTRY s h e) fL = cL) /\ 1879 (EVERY IS_SOME cL) /\ 1880 (LENGTH hL = LENGTH cL) /\ 1881 ALL_DISJOINT (MAP FDOM hL) /\ 1882 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) /\ 1883 EVERY (\(c , h'). SF_SEM___sf_tree_len s h' fL n es (dse_const (THE c))) (ZIP (cL, hL))) 1884 )``, 1885 1886 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 1887 SIMP_TAC std_ss [Once EQ_IMP_THM, FORALL_AND_THM, 1888 GSYM LEFT_FORALL_IMP_THM] THEN 1889 CONJ_TAC THENL [ 1890 Cases_on `n` THENL [ 1891 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 1892 1893 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 1894 REPEAT STRIP_TAC THENL [ 1895 ASM_SIMP_TAC std_ss [], 1896 1897 ASM_SIMP_TAC std_ss [] THEN 1898 METIS_TAC[] 1899 ] 1900 ], 1901 1902 REPEAT GEN_TAC THEN STRIP_TAC THEN 1903 Cases_on `DS_EXPRESSION_EQUAL s e es` THENL [ 1904 Q.EXISTS_TAC `0` THEN 1905 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 1906 1907 FULL_SIMP_TAC std_ss [] THEN 1908 Q.EXISTS_TAC `SUC n` THEN 1909 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 1910 METIS_TAC[] 1911 ] 1912 ]); 1913 1914 1915 1916 1917 1918val SF_SEM___sf_tree_THM2 = prove ( 1919 ``!fL fL' cL s h. 1920 1921(?hL n. 1922 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 1923 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h /\ 1924 (MAP (HEAP_READ_ENTRY s h e) fL = cL) /\ 1925 (EVERY IS_SOME cL) /\ 1926 (LENGTH hL = LENGTH cL) /\ 1927 ALL_DISJOINT (MAP FDOM hL) /\ 1928 (FOLDR FUNION FEMPTY hL = h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) /\ 1929 EVERY (\(c , h'). SF_SEM___sf_tree_len s h' fL' n es (dse_const (THE c))) (ZIP (cL, hL))) = 1930 1931((LENGTH cL = LENGTH fL) /\ 1932 (EVERY IS_SOME cL) /\ 1933 (SF_SEM s h (sf_star 1934 (sf_points_to e (MAP (\(f, c). (f, dse_const (THE c))) (ZIP (fL, cL)))) 1935 (FOLDR (\c sf. sf_star (sf_tree fL' es (dse_const (THE c))) sf) sf_emp cL))))``, 1936 1937 1938Induct_on `fL` THENL [ 1939 REPEAT GEN_TAC THEN 1940 SIMP_TAC list_ss [LENGTH_NIL] THEN 1941 Cases_on `cL` THEN ASM_SIMP_TAC list_ss [] THEN 1942 SIMP_TAC list_ss [LENGTH_NIL, SF_SEM_def, FUNION_FEMPTY_2, 1943 ALL_DISJOINT_def, FDOM_FEMPTY, DISJOINT_EMPTY, DS_POINTS_TO_def] THEN 1944 Cases_on `~IS_DSV_NIL (DS_EXPRESSION_EVAL s e)` THEN ASM_SIMP_TAC std_ss [] THEN 1945 Cases_on `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h` THEN ASM_SIMP_TAC std_ss [] THEN 1946 1947 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, NOT_IN_EMPTY, FDOM_DOMSUB, 1948 EXTENSION, IN_DELETE, IN_SING, DS_EXPRESSION_EVAL_VALUE_def] THEN 1949 METIS_TAC[], 1950 1951 1952 Cases_on `cL` THEN1 ( 1953 ASM_SIMP_TAC list_ss [] 1954 ) THEN 1955 1956 REPEAT GEN_TAC THEN 1957 SIMP_TAC list_ss [SF_SEM___STAR_ASSOC_COMM1] THEN 1958 SIMP_TAC std_ss [Once SF_SEM___STAR_THM] THEN 1959 SIMP_TAC std_ss [GSYM RIGHT_EXISTS_AND_THM] THEN 1960 1961 POP_ASSUM (fn thm => MP_TAC (Q.ISPECL 1962 [`fL':'a list`, `t:'b ds_value option list`, `s:'c -> 'b ds_value`] thm)) THEN 1963 HO_MATCH_MP_TAC (prove (``(?X. (!h1 h2. b' h1 h2 = (b h2 /\ X h1 h2)) /\ (a' = ?h1 h2. (a h2 /\ X h1 h2))) ==> 1964 ((!h. (a h = b h)) ==> (a' = ?h1 h2. b' h1 h2))``, METIS_TAC[])) THEN 1965 Q.EXISTS_TAC `\h1 h2. IS_SOME h /\ SF_SEM s h1 (sf_tree fL' es (dse_const (THE h))) /\ 1966 (h'' = FUNION h1 h2) /\ DISJOINT (FDOM h1) (FDOM h2) /\ 1967 DS_POINTS_TO s h2 e [h', dse_const (THE h)]` THEN 1968 CONJ_TAC THEN1 ( 1969 SIMP_TAC std_ss [] THEN 1970 REPEAT GEN_TAC THEN 1971 EQ_TAC THEN STRIP_TAC THENL [ 1972 FULL_SIMP_TAC list_ss [SF_SEM_def, DS_POINTS_TO_def, 1973 FDOM_FUNION, IN_UNION, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, 1974 FUNION_DEF] THEN 1975 METIS_TAC[], 1976 1977 FULL_SIMP_TAC list_ss [SF_SEM_def, DS_POINTS_TO_def, 1978 FDOM_FUNION, IN_UNION, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, 1979 FUNION_DEF] THEN 1980 Q.EXISTS_TAC `h1'` THEN 1981 Q.EXISTS_TAC `h2` THEN 1982 ASM_SIMP_TAC std_ss [] THEN 1983 Q.PAT_X_ASSUM `h' IN FDOM X` MP_TAC THEN 1984 ASM_SIMP_TAC std_ss [FUNION_DEF] 1985 ] 1986 ) THEN 1987 1988 SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM] THEN 1989 Cases_on `IS_DSV_NIL (DS_EXPRESSION_EVAL s e)` THEN ASM_SIMP_TAC std_ss [] THEN 1990 Cases_on `IS_SOME h` THEN ASM_SIMP_TAC std_ss [] THEN 1991 Cases_on `EVERY IS_SOME t` THEN ASM_SIMP_TAC std_ss [] THEN 1992 1993 1994 EQ_TAC THEN 1995 STRIP_TAC THENL [ 1996 Cases_on `hL` THEN 1997 FULL_SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 1998 Q.EXISTS_TAC `h'''` THEN 1999 Q.EXISTS_TAC `DRESTRICT h'' (FDOM h'' DIFF FDOM h''')` THEN 2000 Q.EXISTS_TAC `t'` THEN 2001 Q.EXISTS_TAC `n` THEN 2002 2003 FULL_SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, 2004 DRESTRICT_DEF, IN_INTER, IN_DIFF] THEN 2005 SIMP_TAC std_ss [GSYM CONJ_ASSOC] THEN 2006 MATCH_MP_TAC (prove (``(a /\ (e1 = e2)) /\ 2007 ((a /\ (e2 = e1)) ==> (b /\ c /\ d /\ f)) ==> (a /\ b /\ c /\ d /\ (e1 = e2) /\ f)``, METIS_TAC[])) THEN 2008 REPEAT CONJ_TAC THENL [ 2009 STRIP_TAC THEN 2010 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM (FUNION h''' (FOLDR FUNION FEMPTY t'))` by ( 2011 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] 2012 ) THEN 2013 POP_ASSUM MP_TAC THEN 2014 ASM_SIMP_TAC std_ss [] THEN 2015 SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE], 2016 2017 2018 Q.PAT_X_ASSUM `FUNION h''' X = Y` MP_TAC THEN 2019 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION, EXTENSION, 2020 FDOM_DOMSUB, IN_DELETE, DRESTRICT_DEF, IN_INTER, IN_DIFF] THEN 2021 REPEAT STRIP_TAC THENL [ 2022 Cases_on `x IN FDOM h''` THEN ASM_SIMP_TAC std_ss [] THEN 2023 METIS_TAC[], 2024 2025 Cases_on `x IN FDOM h'''` THEN ASM_SIMP_TAC std_ss [] THEN 2026 Q.PAT_X_ASSUM `!x. P x` (fn thm => MP_TAC (Q.ISPEC `x:'b` thm)) THEN 2027 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, DOMSUB_FAPPLY_THM] THEN 2028 METIS_TAC[], 2029 2030 Cases_on `x IN FDOM h'''` THEN ASM_SIMP_TAC std_ss [] THEN 2031 Q.PAT_X_ASSUM `!x. P x` (fn thm => MP_TAC (Q.ISPEC `x:'b` thm)) THEN 2032 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, DOMSUB_FAPPLY_THM] THEN 2033 METIS_TAC[] 2034 ], 2035 2036 2037 REPEAT STRIP_TAC THENL [ 2038 Q.PAT_X_ASSUM `X = t` (fn thm => ASM_REWRITE_TAC [GSYM thm]) THEN 2039 Induct_on `fL` THENL [ 2040 SIMP_TAC list_ss [], 2041 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, DRESTRICT_DEF, IN_INTER, IN_DIFF] 2042 ], 2043 2044 2045 Q.PAT_X_ASSUM `FUNION h''' (FOLDR FUNION FEMPTY t') = Y` MP_TAC THEN 2046 Q.PAT_X_ASSUM `FUNION h''' X = Y` (fn thm => 2047 ASM_REWRITE_TAC [Once (GSYM thm)] THEN 2048 ASSUME_TAC thm 2049 ) THEN 2050 `h''' \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) = h'''` by ( 2051 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FDOM_DOMSUB, IN_DELETE, 2052 DOMSUB_FAPPLY_THM] THEN 2053 METIS_TAC[] 2054 ) THEN 2055 ASM_SIMP_TAC std_ss [DOMSUB_FUNION] THEN 2056 MATCH_MP_TAC (prove (``(a = b) ==> (a ==> b)``, METIS_TAC[])) THEN 2057 MATCH_MP_TAC FUNION_EQ THEN 2058 2059 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 2060 DRESTRICT_DEF, FDOM_DOMSUB, IN_UNION, IN_DELETE, IN_DIFF] THEN 2061 REPEAT STRIP_TAC THENL [ 2062 Q.PAT_X_ASSUM `EVERY X (FMAP FDOM t')` MP_TAC THEN 2063 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2064 Induct_on `t'` THENL [ 2065 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 2066 2067 FULL_SIMP_TAC list_ss [FUNION_DEF, IN_UNION, DISJOINT_DEF, 2068 EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 2069 METIS_TAC[] 2070 ], 2071 2072 METIS_TAC[] 2073 ], 2074 2075 2076 METIS_TAC[], 2077 2078 2079 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 2080 IN_DIFF] THEN 2081 METIS_TAC[], 2082 2083 2084 Cases_on `h` THEN ( 2085 FULL_SIMP_TAC list_ss [optionTheory.IS_SOME_DEF] 2086 ) THEN 2087 FULL_SIMP_TAC list_ss [HEAP_READ_ENTRY_THM, DS_POINTS_TO_def, 2088 DRESTRICT_DEF, IN_INTER, IN_DIFF, DS_EXPRESSION_EVAL_def] 2089 ] 2090 ], 2091 2092 2093 2094 FULL_SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 2095 Q.EXISTS_TAC `h1::hL` THEN 2096 Q.EXISTS_TAC `MAX n n'` THEN 2097 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, FUNION_DEF, IN_UNION] THEN 2098 `~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h1)` by ( 2099 FULL_SIMP_TAC std_ss [DISJOINT_DEF, NOT_IN_EMPTY, EXTENSION, IN_INTER] THEN 2100 METIS_TAC[] 2101 ) THEN 2102 REPEAT STRIP_TAC THENL [ 2103 Cases_on `h` THEN 2104 FULL_SIMP_TAC std_ss [optionTheory.IS_SOME_DEF] THEN 2105 FULL_SIMP_TAC list_ss [HEAP_READ_ENTRY_THM, FUNION_DEF, 2106 IN_UNION, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def], 2107 2108 2109 Q.PAT_X_ASSUM `X = t` (fn thm => ASM_REWRITE_TAC [GSYM thm]) THEN 2110 Induct_on `fL` THENL [ 2111 SIMP_TAC list_ss [], 2112 2113 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, DRESTRICT_DEF, IN_INTER, IN_DIFF, 2114 FUNION_DEF, IN_UNION] 2115 ], 2116 2117 2118 2119 `DISJOINT (FDOM h1) (FDOM (FOLDR FUNION FEMPTY hL))` by ( 2120 ASM_SIMP_TAC std_ss [] THEN 2121 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, 2122 IN_INTER, FDOM_DOMSUB, IN_DELETE] THEN 2123 METIS_TAC[] 2124 ) THEN 2125 Q.PAT_X_ASSUM `DISJOINT X Y` MP_TAC THEN 2126 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2127 Induct_on `hL` THENL [ 2128 SIMP_TAC list_ss [], 2129 2130 REPEAT STRIP_TAC THEN 2131 FULL_SIMP_TAC list_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, 2132 IN_INTER, FUNION_DEF, IN_UNION] THEN 2133 METIS_TAC[] 2134 ], 2135 2136 2137 2138 SIMP_TAC std_ss [DOMSUB_FUNION] THEN 2139 `h1 \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) = h1` suffices_by (STRIP_TAC THEN 2140 ASM_REWRITE_TAC[] 2141 ) THEN 2142 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, 2143 DOMSUB_FAPPLY_THM] THEN 2144 METIS_TAC[], 2145 2146 2147 `n' <= MAX n n'` by SIMP_TAC arith_ss [] THEN 2148 METIS_TAC[SF_SEM___sf_tree_len_THM], 2149 2150 2151 `n <= MAX n n'` by SIMP_TAC arith_ss [] THEN 2152 Q.ABBREV_TAC `L = (ZIP (t,hL))` THEN 2153 POP_ASSUM (fn thm => ALL_TAC) THEN 2154 Induct_on `L` THENL [ 2155 SIMP_TAC list_ss [], 2156 2157 SIMP_TAC list_ss [] THEN 2158 GEN_TAC THEN 2159 Cases_on `h''''` THEN 2160 ASM_SIMP_TAC std_ss [] THEN 2161 METIS_TAC[SF_SEM___sf_tree_len_THM] 2162 ] 2163 ] 2164 ] 2165]); 2166 2167 2168 2169 2170val SF_SEM___sf_tree_EXISTS_THM = store_thm ("SF_SEM___sf_tree_EXISTS_THM", 2171 ``!s h fL es e. 2172 SF_SEM s h (sf_tree fL es e) = ( 2173 if (DS_EXPRESSION_EQUAL s e es) then 2174 (h = FEMPTY) 2175 else 2176 (?cL. (LENGTH cL = LENGTH fL) /\ 2177 (SF_SEM s h (sf_star 2178 (sf_points_to e (MAP (\(f, c). (f, dse_const c)) (ZIP (fL, cL)))) 2179 (FOLDR (\c sf. sf_star (sf_tree fL es (dse_const c)) sf) sf_emp cL)))))``, 2180 2181 2182 REWRITE_TAC [SF_SEM___sf_tree_THM1, SF_SEM___sf_tree_THM2] THEN 2183 REPEAT GEN_TAC THEN 2184 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN ASM_REWRITE_TAC[] THEN 2185 2186 EQ_TAC THENL [ 2187 STRIP_TAC THEN 2188 Q.EXISTS_TAC `MAP THE cL` THEN 2189 FULL_SIMP_TAC list_ss [] THEN 2190 `((MAP (\(f,c). (f,(dse_const c):('b, 'a) ds_expression)) (ZIP (fL,MAP THE cL))) = 2191 (MAP (\(f,c). (f,dse_const (THE c))) (ZIP (fL,cL)))) /\ 2192 2193 (!fL:'c list. 2194 ((FOLDR (\c sf. sf_star (sf_tree fL es (dse_const c)) sf) sf_emp 2195 (MAP THE cL)) = 2196 (FOLDR (\c sf. sf_star (sf_tree fL es (dse_const (THE c))) sf) 2197 sf_emp cL)))` suffices_by METIS_TAC[] THEN 2198 2199 2200 Q.PAT_X_ASSUM `LENGTH cL = LENGTH fL` MP_TAC THEN 2201 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2202 Q.SPEC_TAC (`fL`, `fL`) THEN 2203 Induct_on `cL` THENL [ 2204 Cases_on `fL` THEN 2205 SIMP_TAC list_ss [], 2206 2207 Cases_on `fL` THEN 2208 ASM_SIMP_TAC list_ss [ds_spatial_formula_11] THEN 2209 METIS_TAC[] 2210 ], 2211 2212 2213 2214 STRIP_TAC THEN 2215 Q.EXISTS_TAC `MAP SOME cL` THEN 2216 FULL_SIMP_TAC list_ss [] THEN 2217 CONJ_TAC THEN1 ( 2218 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2219 Induct_on `cL` THENL [ 2220 SIMP_TAC list_ss [], 2221 ASM_SIMP_TAC list_ss [] 2222 ] 2223 ) THEN 2224 `((MAP (\(f,c). (f,(dse_const (THE c)):('b, 'a) ds_expression)) (ZIP (fL,MAP SOME cL))) = 2225 (MAP (\(f,c). (f,dse_const c)) (ZIP (fL,cL)))) /\ 2226 2227 (!fL:'c list. 2228 ((FOLDR (\c sf. sf_star (sf_tree fL es (dse_const (THE c))) sf) sf_emp 2229 (MAP SOME cL)) = 2230 (FOLDR (\c sf. sf_star (sf_tree fL es (dse_const c)) sf) 2231 sf_emp cL)))` suffices_by METIS_TAC[] THEN 2232 2233 2234 Q.PAT_X_ASSUM `LENGTH cL = LENGTH fL` MP_TAC THEN 2235 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2236 Q.SPEC_TAC (`fL`, `fL`) THEN 2237 Induct_on `cL` THENL [ 2238 Cases_on `fL` THEN 2239 SIMP_TAC list_ss [], 2240 2241 Cases_on `fL` THEN 2242 ASM_SIMP_TAC list_ss [ds_spatial_formula_11] THEN 2243 METIS_TAC[] 2244 ] 2245 ]); 2246 2247 2248 2249 2250 2251 2252val SF_SEM___sf_tree_THM = store_thm ("SF_SEM___sf_tree_THM", 2253 ``!s h fL es e. 2254 SF_SEM s h (sf_tree fL es e) = ( 2255 if (DS_EXPRESSION_EQUAL s e es) then 2256 (h = FEMPTY) 2257 else 2258 (let cL = MAP (\f. h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f) fL in 2259 (SF_SEM s h (sf_star 2260 (sf_points_to e (MAP (\(f, c). (f, dse_const c)) (ZIP (fL, cL)))) 2261 (FOLDR (\c sf. sf_star (sf_tree fL es (dse_const c)) sf) sf_emp cL)))))``, 2262 2263 2264 REWRITE_TAC [SF_SEM___sf_tree_EXISTS_THM] THEN 2265 REPEAT GEN_TAC THEN 2266 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN ASM_REWRITE_TAC[] THEN 2267 2268 Tactical.REVERSE EQ_TAC THEN1 ( 2269 METIS_TAC[LENGTH_MAP] 2270 ) THEN 2271 REPEAT STRIP_TAC THEN 2272 `?cL. cL = MAP (\f. h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f) fL` by METIS_TAC[] THEN 2273 FULL_SIMP_TAC std_ss [LET_THM, SF_SEM_def] THEN 2274 Q.EXISTS_TAC `h1` THEN 2275 Q.EXISTS_TAC `h2` THEN 2276 ASM_SIMP_TAC std_ss [] THEN 2277 `cL' = cL` suffices_by (STRIP_TAC THEN 2278 METIS_TAC[] 2279 ) THEN 2280 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_SING] THEN 2281 2282 Q.PAT_X_ASSUM `LENGTH X = LENGTH Y` MP_TAC THEN 2283 Q.PAT_X_ASSUM `FDOM h1 = X` MP_TAC THEN 2284 Q.PAT_X_ASSUM `DS_POINTS_TO s h1 X Y` MP_TAC THEN 2285 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 2286 Q.SPEC_TAC (`fL`, `fL`) THEN 2287 Q.SPEC_TAC (`cL`, `cL`) THEN 2288 REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN 2289 2290 Induct_on `cL` THENL [ 2291 Cases_on `fL` THEN SIMP_TAC list_ss [], 2292 2293 Cases_on `fL` THEN SIMP_TAC list_ss [] THEN 2294 REPEAT STRIP_TAC THENL [ 2295 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 2296 DS_EXPRESSION_EVAL_VALUE_def], 2297 2298 Q.PAT_X_ASSUM `!fL. P fL` MATCH_MP_TAC THEN 2299 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def] 2300 ] 2301 ]) 2302 2303 2304 2305 2306 2307 2308val sf_ls_def = Define ` 2309 sf_ls f e1 e2 = sf_tree [f] e2 e1`; 2310 2311val sf_list_def = Define ` 2312 sf_list f e = sf_ls f e dse_nil`; 2313 2314 2315 2316val SF_SEM___sf_ls_EXISTS_THM = store_thm ("SF_SEM___sf_ls_EXISTS_THM", 2317 ``!s h f e1 e2. 2318 SF_SEM s h (sf_ls f e1 e2) = ( 2319 if (DS_EXPRESSION_EQUAL s e1 e2) then 2320 (h = FEMPTY) 2321 else 2322 (?c. (SF_SEM s h (sf_star 2323 (sf_points_to e1 [f, dse_const c]) 2324 (sf_ls f (dse_const c) e2)))) 2325 )``, 2326 2327SIMP_TAC std_ss [sf_ls_def, SF_SEM___sf_tree_EXISTS_THM] THEN 2328REPEAT GEN_TAC THEN 2329Cases_on `DS_EXPRESSION_EQUAL s e1 e2` THEN ASM_REWRITE_TAC[] THEN 2330EQ_TAC THENL [ 2331 STRIP_TAC THEN 2332 Cases_on `cL` THEN FULL_SIMP_TAC list_ss [] THEN 2333 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2334 Q.EXISTS_TAC `h'` THEN 2335 FULL_SIMP_TAC std_ss [SF_SEM_def, FUNION_FEMPTY_2] THEN 2336 METIS_TAC[], 2337 2338 STRIP_TAC THEN 2339 Q.EXISTS_TAC `[c]` THEN 2340 FULL_SIMP_TAC list_ss [SF_SEM_def, FUNION_FEMPTY_2, 2341 FDOM_FEMPTY, DISJOINT_EMPTY] THEN 2342 METIS_TAC[] 2343]) 2344 2345 2346 2347 2348val SF_SEM___sf_ls_THM = store_thm ("SF_SEM___sf_ls_THM", 2349 ``!s h f e1 e2. 2350 SF_SEM s h (sf_ls f e1 e2) = ( 2351 if (DS_EXPRESSION_EQUAL s e1 e2) then 2352 (h = FEMPTY) 2353 else 2354 (let c = h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f in 2355 (SF_SEM s h (sf_star 2356 (sf_points_to e1 [f, dse_const c]) 2357 (sf_ls f (dse_const c) e2)))) 2358 )``, 2359 2360SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_THM, LET_THM] THEN 2361SIMP_TAC std_ss [SF_SEM_def, FDOM_FEMPTY, DISJOINT_EMPTY, FUNION_FEMPTY_2]) 2362 2363 2364val SF_SEM___sf_ls_len_def = Define ` 2365 (SF_SEM___sf_ls_len s h f 0 e1 e2 = ((h = FEMPTY) /\ (PF_SEM s (pf_equal e1 e2)))) /\ 2366 (SF_SEM___sf_ls_len s h f (SUC n) e1 e2 = ( 2367 (PF_SEM s (pf_unequal e1 e2)) /\ 2368 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e1) /\ 2369 (let e1_eval = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) in ( 2370 (e1_eval IN (FDOM h)) /\ 2371 (f IN FDOM (h ' e1_eval)) /\ 2372 (SF_SEM___sf_ls_len s (h \\ (e1_eval)) f n (dse_const (h ' e1_eval ' f)) e2)))))` 2373 2374 2375 2376val SF_SEM___sf_ls_def = Define ` 2377 (SF_SEM___sf_ls s h f e1 e2 = ?n. SF_SEM___sf_ls_len s h f n e1 e2)` 2378 2379 2380val SF_SEM___sf_ls_SEM = store_thm ("SF_SEM___sf_ls_SEM", 2381 ``!s h f e1 e2. SF_SEM s h (sf_ls f e1 e2) = 2382 SF_SEM___sf_ls s h f e1 e2``, 2383 2384SIMP_TAC std_ss [sf_ls_def, SF_SEM_def, SF_SEM___sf_tree_def, SF_SEM___sf_ls_def, 2385EQ_IMP_THM, FORALL_AND_THM, GSYM LEFT_FORALL_IMP_THM] THEN 2386CONJ_TAC THENL [ 2387 Induct_on `n` THENL [ 2388 REPEAT STRIP_TAC THEN 2389 Q.EXISTS_TAC `0` THEN 2390 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, SF_SEM___sf_ls_len_def], 2391 2392 SIMP_TAC list_ss [SF_SEM___sf_tree_len_def] THEN 2393 REPEAT STRIP_TAC THENL [ 2394 Q.EXISTS_TAC `0` THEN 2395 ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_len_def], 2396 2397 2398 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 2399 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2400 RES_TAC THEN 2401 2402 Q.EXISTS_TAC `SUC n'` THEN 2403 FULL_SIMP_TAC std_ss [SF_SEM___sf_ls_len_def, LET_THM, FUNION_FEMPTY_2] THEN 2404 Cases_on `HEAP_READ_ENTRY s h e1 f` THEN FULL_SIMP_TAC std_ss [] THEN 2405 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 2406 METIS_TAC[] 2407 ] 2408 ], 2409 2410 2411 2412 Induct_on `n` THENL [ 2413 REPEAT STRIP_TAC THEN 2414 Q.EXISTS_TAC `0` THEN 2415 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, SF_SEM___sf_ls_len_def], 2416 2417 SIMP_TAC list_ss [SF_SEM___sf_ls_len_def, LET_THM] THEN 2418 REPEAT STRIP_TAC THEN 2419 RES_TAC THEN 2420 Q.EXISTS_TAC `SUC n'` THEN 2421 2422 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, HEAP_READ_ENTRY_def] THEN 2423 Q.EXISTS_TAC `[h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)]` THEN 2424 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, FUNION_FEMPTY_2] 2425 ] 2426]); 2427 2428 2429val BALANCED_SF_SEM___sf_ls_len = store_thm ("BALANCED_SF_SEM___sf_ls_len", 2430 ``!s h f n e1 e2. 2431 BALANCED_SF_SEM___sf_tree_len s h [f] n e2 e1 = 2432 SF_SEM___sf_ls_len s h f n e1 e2 2433 ``, 2434 2435 Induct_on `n` THENL [ 2436 SIMP_TAC std_ss [SF_SEM___sf_ls_len_def, BALANCED_SF_SEM___sf_tree_len_def], 2437 2438 SIMP_TAC list_ss [SF_SEM___sf_ls_len_def, BALANCED_SF_SEM___sf_tree_len_def, LET_THM] THEN 2439 REPEAT STRIP_TAC THEN EQ_TAC THENL [ 2440 STRIP_TAC THEN 2441 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 2442 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2443 FULL_SIMP_TAC std_ss [FUNION_FEMPTY_2, HEAP_READ_ENTRY_THM] THEN 2444 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h' [f] n e2 X` MP_TAC THEN 2445 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def], 2446 2447 STRIP_TAC THEN 2448 ASM_SIMP_TAC std_ss [] THEN 2449 Q.EXISTS_TAC `[h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)]` THEN 2450 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, ALL_DISJOINT_def, 2451 FUNION_FEMPTY_2] THEN 2452 METIS_TAC[] 2453 ] 2454 ]); 2455 2456 2457 2458 2459 2460 2461val sf_bin_tree_def = Define ` 2462 sf_bin_tree (f1, f2) e = sf_tree [f1;f2] dse_nil e`; 2463 2464 2465 2466val SF_SEM___sf_bin_tree_EXISTS_THM = store_thm ("SF_SEM___sf_bin_tree_EXISTS_THM", 2467 ``!s h f1 f2 e. 2468 SF_SEM s h (sf_bin_tree (f1,f2) e) = ( 2469 if (DS_EXPRESSION_EQUAL s e dse_nil) then 2470 (h = FEMPTY) 2471 else 2472 (?c1 c2. 2473 (SF_SEM s h (sf_star 2474 (sf_points_to e [(f1, dse_const c1);(f2, dse_const c2)]) 2475 (sf_star (sf_bin_tree (f1,f2) (dse_const c1)) 2476 (sf_bin_tree (f1,f2) (dse_const c2))))) 2477 ) 2478 )``, 2479 2480 2481SIMP_TAC list_ss [sf_bin_tree_def, SF_SEM___sf_tree_EXISTS_THM] THEN 2482 2483REPEAT GEN_TAC THEN 2484Cases_on `DS_EXPRESSION_EQUAL s e dse_nil` THEN ASM_REWRITE_TAC[] THEN 2485EQ_TAC THENL [ 2486 STRIP_TAC THEN 2487 Cases_on `cL` THEN FULL_SIMP_TAC list_ss [] THEN 2488 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2489 Cases_on `t'` THEN FULL_SIMP_TAC list_ss [] THEN 2490 Q.EXISTS_TAC `h'` THEN 2491 Q.EXISTS_TAC `h''` THEN 2492 FULL_SIMP_TAC std_ss [SF_SEM_def, FUNION_FEMPTY_2] THEN 2493 Q.EXISTS_TAC `h1` THEN 2494 Q.EXISTS_TAC `h2` THEN 2495 ASM_SIMP_TAC std_ss [] THEN 2496 METIS_TAC[], 2497 2498 2499 STRIP_TAC THEN 2500 Q.EXISTS_TAC `[c1;c2]` THEN 2501 FULL_SIMP_TAC list_ss [SF_SEM_def, FUNION_FEMPTY_2, 2502 FDOM_FEMPTY, DISJOINT_EMPTY] THEN 2503 METIS_TAC[] 2504]); 2505 2506 2507val SF_SEM___sf_bin_tree_THM = store_thm ("SF_SEM___sf_bin_tree_THM", 2508 ``!s h f1 f2 e. 2509 SF_SEM s h (sf_bin_tree (f1,f2) e) = ( 2510 if (DS_EXPRESSION_EQUAL s e dse_nil) then 2511 (h = FEMPTY) 2512 else 2513 (let c1 = h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f1 in 2514 let c2 = h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f2 in 2515 (SF_SEM s h (sf_star 2516 (sf_points_to e [(f1, dse_const c1);(f2, dse_const c2)]) 2517 (sf_star (sf_bin_tree (f1,f2) (dse_const c1)) 2518 (sf_bin_tree (f1,f2) (dse_const c2))))) 2519 ) 2520 )``, 2521 2522 2523SIMP_TAC list_ss [sf_bin_tree_def, SF_SEM___sf_tree_THM, LET_THM] THEN 2524SIMP_TAC std_ss [SF_SEM_def, FDOM_FEMPTY, DISJOINT_EMPTY, FUNION_FEMPTY_2]) 2525 2526 2527 2528 2529 2530 2531 2532 2533val SF_SEM___sf_points_to_THM = store_thm ("SF_SEM___sf_points_to_THM", 2534`` 2535 (SF_SEM s h (sf_star (sf_points_to e a) sf)) = 2536 2537 DS_POINTS_TO s h e a /\ 2538 (SF_SEM s (h \\ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))) sf)``, 2539 2540 SIMP_TAC std_ss [SF_SEM_def, LET_THM, DS_POINTS_TO_def] THEN 2541 Q.ABBREV_TAC `e_eval = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)` THEN 2542 EQ_TAC THENL [ 2543 STRIP_TAC THEN 2544 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_UNION, IN_SING, DOMSUB_FUNION, DS_EXPRESSION_EVAL_VALUE_def] THEN 2545 `h1 \\ e_eval = FEMPTY` by ( 2546 ASM_SIMP_TAC std_ss [GSYM FDOM_EQ_EMPTY, FDOM_DOMSUB, EXTENSION, IN_DELETE, 2547 IN_SING, NOT_IN_EMPTY, DS_EXPRESSION_EVAL_VALUE_def] 2548 ) THEN 2549 `h2 \\ e_eval = h2` by ( 2550 FULL_SIMP_TAC std_ss [DISJOINT_DEF, GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, 2551 DOMSUB_FAPPLY_NEQ, NOT_IN_EMPTY, IN_INTER, IN_SING, 2552 DS_EXPRESSION_EVAL_VALUE_def] THEN 2553 METIS_TAC[] 2554 ) THEN 2555 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1], 2556 2557 2558 STRIP_TAC THEN 2559 Q.EXISTS_TAC `FEMPTY |+ (e_eval, h ' e_eval)` THEN 2560 Q.EXISTS_TAC `h \\ e_eval` THEN 2561 2562 ASM_SIMP_TAC std_ss [] THEN 2563 REPEAT STRIP_TAC THENL [ 2564 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, 2565 FDOM_FUPDATE, IN_SING, FDOM_FEMPTY, FAPPLY_FUPDATE, 2566 COND_RATOR, COND_RAND, FDOM_DOMSUB] THEN 2567 REPEAT STRIP_TAC THENL [ 2568 SIMP_TAC std_ss [EXTENSION, IN_SING, IN_UNION, IN_DELETE] THEN 2569 METIS_TAC[], 2570 2571 METIS_TAC[DOMSUB_FAPPLY_NEQ], 2572 METIS_TAC[DOMSUB_FAPPLY_NEQ] 2573 ], 2574 2575 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_SING, IN_INTER, IN_DELETE, 2576 FDOM_FUPDATE, FDOM_FEMPTY, FDOM_DOMSUB], 2577 2578 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_FUPDATE, FDOM_FEMPTY, DS_EXPRESSION_EVAL_VALUE_def], 2579 2580 SIMP_TAC std_ss [FDOM_FUPDATE, IN_INSERT], 2581 2582 ASM_SIMP_TAC std_ss [FAPPLY_FUPDATE] 2583 ] 2584 ]); 2585 2586 2587(* 2588val SF_SEM_LIST_LEN___LIST_SEM = store_thm ("SF_SEM_LIST_LEN___LIST_SEM", 2589``!s h n e1 e2. 2590SF_SEM_LIST_LEN s h n e1 e2 = ?l. ( 2591 (LENGTH l = (SUC n)) /\ 2592 (HD l = (DS_EXPRESSION_EVAL s e1)) /\ (LAST l = (DS_EXPRESSION_EVAL s e2)) /\ 2593 (!m. (m < n) ==> (DS_POINTS_TO s h (dse_const (EL m l)) (dse_const (EL (SUC m) l)))) /\ 2594 EVERY (\x. ~IS_DSV_NIL x) (BUTLAST l) /\ ALL_DISTINCT l /\ 2595 (FDOM (h:'b stack) = (LIST_TO_SET (MAP GET_DSV_VALUE (BUTLAST l)))) 2596)``, 2597 2598 2599Induct_on `n` THENL [ 2600 SIMP_TAC std_ss [SF_SEM_LIST_LEN_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 2601 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 2602 Q.EXISTS_TAC `[DS_EXPRESSION_EVAL s e1]` THEN 2603 ASM_SIMP_TAC list_ss [FDOM_FEMPTY, listTheory.IN_LIST_TO_SET, EXTENSION, NOT_IN_EMPTY], 2604 2605 Cases_on `l` THEN FULL_SIMP_TAC list_ss [LENGTH_NIL] THEN 2606 Q.PAT_X_ASSUM `t = []` ASSUME_TAC THEN 2607 FULL_SIMP_TAC list_ss [] THEN 2608 `FDOM h = EMPTY` by ( 2609 ASM_SIMP_TAC list_ss [EXTENSION, IN_LIST_TO_SET, NOT_IN_EMPTY] 2610 ) THEN 2611 ASM_SIMP_TAC list_ss [GSYM fmap_EQ_THM, NOT_IN_EMPTY, FDOM_FEMPTY] 2612 ], 2613 2614 2615 FULL_SIMP_TAC std_ss [SF_SEM_LIST_LEN_def, LET_THM] THEN 2616 REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 2617 Q.EXISTS_TAC `(DS_EXPRESSION_EVAL s e1)::l` THEN 2618 ASM_SIMP_TAC list_ss [] THEN 2619 Cases_on `l` THEN FULL_SIMP_TAC list_ss [] THEN 2620 Q.PAT_X_ASSUM `h' = X` (fn thm => ASSUME_TAC (GSYM thm)) THEN 2621 FULL_SIMP_TAC list_ss [EXTENSION, FDOM_DOMSUB, IN_DELETE, IN_LIST_TO_SET, 2622 MEM] THEN 2623 REPEAT CONJ_TAC THENL [ 2624 REPEAT STRIP_TAC THEN 2625 Cases_on `m` THENL [ 2626 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def], 2627 2628 FULL_SIMP_TAC list_ss [] THEN 2629 `DS_POINTS_TO s (h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) 2630 (dse_const (EL n' (h'::t))) (dse_const (EL n' t))` by METIS_TAC[] THEN 2631 METIS_TAC [DS_POINTS_TO___DOMSUB] 2632 ], 2633 2634 2635 Cases_on `t` THENL [ 2636 FULL_SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def], 2637 2638 FULL_SIMP_TAC list_ss [] THEN 2639 Cases_on `h'` THEN1 FULL_SIMP_TAC std_ss [IS_DSV_NIL_def] THEN 2640 METIS_TAC [GET_DSV_VALUE_def] 2641 ], 2642 2643 CCONTR_TAC THEN 2644 `MEM (DS_EXPRESSION_EVAL s e1) (FRONT (h'::t))` by ( 2645 MATCH_MP_TAC MEM_LAST_FRONT THEN 2646 FULL_SIMP_TAC std_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] 2647 ) THEN 2648 FULL_SIMP_TAC list_ss [MEM_MAP] THEN 2649 METIS_TAC[], 2650 2651 METIS_TAC[] 2652 ], 2653 2654 2655 `~(HD l = LAST l)` by ( 2656 `0 < LENGTH l` by ASM_SIMP_TAC arith_ss[] THEN 2657 POP_ASSUM MP_TAC THEN 2658 SIMP_TAC std_ss [EL_HD_LAST] THEN 2659 ASM_SIMP_TAC arith_ss [EL_ALL_DISTINCT] 2660 ) THEN 2661 REPEAT STRIP_TAC THENL [ 2662 POP_ASSUM MP_TAC THEN 2663 ASM_SIMP_TAC std_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def], 2664 2665 Cases_on `l` THEN FULL_SIMP_TAC list_ss [] THEN 2666 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2667 METIS_TAC[], 2668 2669 Cases_on `l` THEN FULL_SIMP_TAC list_ss [] THEN 2670 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2671 FULL_SIMP_TAC list_ss [EXTENSION] THEN 2672 METIS_TAC[], 2673 2674 Q.EXISTS_TAC `TL l` THEN 2675 Cases_on `l` THEN FULL_SIMP_TAC list_ss [] THEN 2676 Cases_on `t` THEN FULL_SIMP_TAC list_ss [] THEN 2677 REPEAT STRIP_TAC THENL [ 2678 `0 < SUC n` by DECIDE_TAC THEN 2679 `DS_POINTS_TO s h (dse_const (EL 0 (h'::h''::t'))) 2680 (dse_const (EL 0 (h''::t')))` by METIS_TAC[] THEN 2681 POP_ASSUM MP_TAC THEN 2682 SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def] THEN 2683 ASM_SIMP_TAC std_ss [], 2684 2685 2686 `SUC m < SUC n` by DECIDE_TAC THEN 2687 `DS_POINTS_TO s h (dse_const (EL (SUC m) (h'::h''::t'))) 2688 (dse_const (EL (SUC m) (h''::t')))` by METIS_TAC[] THEN 2689 POP_ASSUM MP_TAC THEN 2690 SIMP_TAC list_ss [DS_POINTS_TO_def, FDOM_DOMSUB, IN_DELETE, 2691 DS_EXPRESSION_EVAL_def, DOMSUB_FAPPLY_THM, COND_RATOR, COND_RAND] THEN 2692 STRIP_TAC THEN 2693 MATCH_MP_TAC (prove (``(~(a1 = a2)) ==> (~(a2 = a1) /\ ((a1 = a2) ==> b))``, METIS_TAC[])) THEN 2694 Q.PAT_X_ASSUM `h' = X` ASSUME_TAC THEN 2695 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_11] THEN 2696 Cases_on `m` THENL [ 2697 SIMP_TAC list_ss [] THEN METIS_TAC[], 2698 2699 SIMP_TAC list_ss [] THEN 2700 `n' < LENGTH t'` by DECIDE_TAC THEN 2701 METIS_TAC[MEM_EL] 2702 ], 2703 2704 ASM_SIMP_TAC list_ss [EXTENSION, IN_LIST_TO_SET, FDOM_DOMSUB, IN_DELETE] THEN 2705 REPEAT STRIP_TAC THEN 2706 sg `~(MEM (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) (MAP GET_DSV_VALUE (FRONT (h''::t'))))` THENL [ 2707 ALL_TAC, 2708 METIS_TAC[] 2709 ] THEN 2710 SIMP_TAC std_ss [MEM_MAP] THEN 2711 GEN_TAC THEN 2712 Cases_on `MEM y (FRONT (h''::t'))` THEN ASM_REWRITE_TAC[] THEN 2713 Q.PAT_X_ASSUM `h' = X` ASSUME_TAC THEN 2714 FULL_SIMP_TAC std_ss [EVERY_MEM] THEN 2715 `~IS_DSV_NIL y` by METIS_TAC[] THEN 2716 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_11] THEN 2717 2718 `MEM y (h''::t')` by METIS_TAC[MEM_FRONT] THEN 2719 FULL_SIMP_TAC list_ss [] THEN 2720 METIS_TAC[] 2721 ] 2722 ] 2723 ] 2724]); 2725 2726 2727 2728 2729 2730 2731val DS_POINTER_LIST_def = Define ` 2732 (DS_POINTER_LIST s h 0 e = [(DS_EXPRESSION_EVAL s e)]) /\ 2733 (DS_POINTER_LIST s h (SUC n) e = 2734 (DS_EXPRESSION_EVAL s e)::(DS_POINTER_LIST s h n (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))))))`; 2735 2736 2737val DS_POINTER_LIST___LENGTH = store_thm ("DS_POINTER_LIST___LENGTH", 2738 ``!s h n e. LENGTH (DS_POINTER_LIST s h n e) = (SUC n)``, 2739 Induct_on `n` THENL [ 2740 SIMP_TAC list_ss [DS_POINTER_LIST_def], 2741 ASM_SIMP_TAC list_ss [DS_POINTER_LIST_def] 2742 ]); 2743 2744val DS_POINTER_LIST___HD = store_thm ("DS_POINTER_LIST___HD", 2745 ``!s h n e. HD (DS_POINTER_LIST s h n e) = DS_EXPRESSION_EVAL s e``, 2746 Cases_on `n` THEN 2747 SIMP_TAC list_ss [DS_POINTER_LIST_def]) 2748 2749 2750val DS_POINTER_LIST___FRONT = store_thm ("DS_POINTER_LIST___FRONT", 2751 ``(!s h e. FRONT (DS_POINTER_LIST s h 0 e) = []) /\ 2752 (!s h n e. FRONT (DS_POINTER_LIST s h (SUC n) e) = (DS_POINTER_LIST s h n e))``, 2753 CONJ_TAC THENL [ 2754 SIMP_TAC list_ss [DS_POINTER_LIST_def], 2755 2756 Induct_on `n` THENL [ 2757 SIMP_TAC list_ss [DS_POINTER_LIST_def], 2758 2759 ASM_SIMP_TAC list_ss [Once DS_POINTER_LIST_def, 2760 DS_EXPRESSION_EVAL_def, FRONT_DEF] THEN 2761 SIMP_TAC list_ss [DS_POINTER_LIST_def] 2762 ] 2763 ]); 2764 2765val DS_POINTER_LIST___NOT_EQ_NIL = store_thm ("DS_POINTER_LIST___NOT_EQ_NIL", 2766 ``!s h n e. ~(DS_POINTER_LIST s h n e = [])``, 2767 2768Cases_on `n` THEN ( 2769 SIMP_TAC list_ss [DS_POINTER_LIST_def] 2770)); 2771 2772 2773 2774val DS_POINTER_LIST___STACK_DOMSUB = store_thm ("DS_POINTER_LIST___STACK_DOMSUB", 2775``!s h n e v. let l = DS_POINTER_LIST s (h \\ GET_DSV_VALUE v) n e in 2776(EVERY (\x. ~IS_DSV_NIL x) (FRONT l) /\ 2777 ~IS_DSV_NIL v /\ 2778 ~(MEM v (FRONT l))) ==> 2779(l = DS_POINTER_LIST s h n e)``, 2780 2781 2782SIMP_TAC list_ss [LET_THM] THEN 2783Induct_on `n` THENL [ 2784 SIMP_TAC list_ss [DS_POINTER_LIST_def], 2785 2786 ASM_SIMP_TAC list_ss [DS_POINTER_LIST_def, FRONT_DEF, 2787 DS_POINTER_LIST___NOT_EQ_NIL, 2788 DOMSUB_FAPPLY_THM] THEN 2789 REPEAT STRIP_TAC THEN 2790 REPEAT (Q.PAT_X_ASSUM `~(IS_DSV_NIL X)` MP_TAC) THEN 2791 Q.PAT_X_ASSUM `~(v = X)` ASSUME_TAC THEN 2792 REPEAT STRIP_TAC THEN 2793 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_11] 2794]); 2795 2796 2797 2798 2799 2800val SF_SEM_LIST_LEN___LIST_SEM2 = store_thm ("SF_SEM_LIST_LEN___LIST_SEM2", 2801``!s h n e1 e2. 2802SF_SEM_LIST_LEN s h n e1 e2 = ( 2803 let l = DS_POINTER_LIST s h n e1 in 2804 ((LAST l = (DS_EXPRESSION_EVAL s e2)) /\ 2805 EVERY (\x. ~IS_DSV_NIL x) (BUTLAST l) /\ ALL_DISTINCT l /\ 2806 (((FDOM (h:'b stack))) = (LIST_TO_SET (MAP GET_DSV_VALUE (BUTLAST l))))) 2807)``, 2808 2809 2810SIMP_TAC list_ss [SF_SEM_LIST_LEN___LIST_SEM, LET_THM] THEN 2811REPEAT STRIP_TAC THEN 2812EQ_TAC THEN STRIP_TAC THENL [ 2813 sg `DS_POINTER_LIST s h n e1 = l` THENL [ 2814 ALL_TAC, 2815 ASM_SIMP_TAC std_ss [] 2816 ] THEN 2817 REPEAT (POP_ASSUM MP_TAC) THEN 2818 Q.SPEC_TAC (`n`, `n`) THEN 2819 Q.SPEC_TAC (`e1`, `e1`) THEN 2820 Q.SPEC_TAC (`h`, `h`) THEN 2821 Q.SPEC_TAC (`l`, `l`) THEN 2822 Induct_on `n` THENL [ 2823 SIMP_TAC list_ss [] THEN 2824 Cases_on `l` THENL [ 2825 FULL_SIMP_TAC list_ss [], 2826 FULL_SIMP_TAC list_ss [DS_POINTER_LIST_def, LENGTH_NIL] 2827 ], 2828 2829 Cases_on `l` THEN SIMP_TAC list_ss [] THEN 2830 Cases_on `t` THEN SIMP_TAC list_ss [] THEN 2831 REPEAT GEN_TAC THEN 2832 POP_ASSUM (fn thm => ASSUME_TAC (Q.SPECL [`h'::t'`, 2833 `h''\\ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))`, 2834 `dse_const h'`] thm)) THEN 2835 FULL_SIMP_TAC list_ss [AND_IMP_INTRO] THEN 2836 POP_ASSUM MP_TAC THEN 2837 MATCH_MP_TAC (prove (``((a' ==> a) /\ ((a' /\ b) ==> b')) ==> ((a ==> b) ==> (a' ==> b'))``, PROVE_TAC[])) THEN 2838 REPEAT CONJ_TAC THENL [ 2839 STRIP_TAC THEN 2840 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] THEN 2841 REPEAT STRIP_TAC THENL [ 2842 `SUC m < SUC n` by DECIDE_TAC THEN 2843 `DS_POINTS_TO s h'' 2844 (dse_const (EL (SUC m) (DS_EXPRESSION_EVAL s e1::h'::t'))) 2845 (dse_const (EL (SUC m) (h'::t')))` by METIS_TAC[] THEN 2846 POP_ASSUM MP_TAC THEN 2847 SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 2848 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM] THEN 2849 STRIP_TAC THEN 2850 SIMP_TAC std_ss [COND_RATOR, COND_RAND] THEN 2851 MATCH_MP_TAC (prove (``~(a1 = a2) ==> (~(a1 = a2) /\ ((a2 = a1) ==> b))``, METIS_TAC[])) THEN 2852 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_11] THEN 2853 Cases_on `m` THENL [ 2854 SIMP_TAC list_ss [] THEN METIS_TAC[], 2855 2856 `n' < n` by DECIDE_TAC THEN 2857 SIMP_TAC list_ss [] THEN METIS_TAC[MEM_EL] 2858 ], 2859 2860 ASM_SIMP_TAC list_ss [FDOM_DOMSUB, EXTENSION, IN_LIST_TO_SET, IN_DELETE] THEN 2861 sg `~MEM (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) (MAP GET_DSV_VALUE (FRONT (h'::t')))` THENL [ 2862 ALL_TAC, 2863 METIS_TAC[] 2864 ] THEN 2865 FULL_SIMP_TAC list_ss [MEM_MAP, EVERY_MEM] THEN 2866 GEN_TAC THEN 2867 Cases_on `MEM y (FRONT (h'::t'))` THEN ASM_REWRITE_TAC[] THEN 2868 `MEM y (h'::t') /\ (~IS_DSV_NIL y)` by METIS_TAC[MEM_FRONT] THEN 2869 FULL_SIMP_TAC list_ss [GET_DSV_VALUE_11] THEN 2870 METIS_TAC[] 2871 ], 2872 2873 2874 STRIP_TAC THEN 2875 SIMP_TAC list_ss [DS_POINTER_LIST_def] THEN 2876 POP_ASSUM (fn thm => ASSUME_TAC (GSYM thm)) THEN 2877 `((h'' ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)))) = h'` by ( 2878 `0 < SUC n` by DECIDE_TAC THEN 2879 `DS_POINTS_TO s h'' 2880 (dse_const (EL 0 (DS_EXPRESSION_EVAL s e1::h'::t'))) 2881 (dse_const (EL 0 (h'::t')))` by METIS_TAC[] THEN 2882 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def] 2883 ) THEN 2884 ASM_SIMP_TAC list_ss [] THEN 2885 MATCH_MP_TAC (GSYM (SIMP_RULE std_ss [LET_THM] DS_POINTER_LIST___STACK_DOMSUB)) THEN 2886 2887 Q.PAT_X_ASSUM `h'::t' = X` (fn thm => ASSUME_TAC (GSYM thm)) THEN 2888 ASM_SIMP_TAC std_ss [] THEN 2889 METIS_TAC[MEM_FRONT, MEM] 2890 ] 2891 ], 2892 2893 2894 Q.EXISTS_TAC `DS_POINTER_LIST s h n e1` THEN 2895 ASM_SIMP_TAC std_ss [DS_POINTER_LIST___LENGTH, DS_POINTER_LIST___HD] THEN 2896 Q.PAT_X_ASSUM `LAST X = Y` (fn thm => ALL_TAC) THEN 2897 FULL_SIMP_TAC std_ss [SET_EQ_SUBSET] THEN 2898 Q.PAT_X_ASSUM `FDOM h SUBSET X` (fn thm => (ALL_TAC)) THEN 2899 REPEAT (POP_ASSUM MP_TAC) THEN 2900 Q.SPEC_TAC (`e1`, `e1`) THEN 2901 Induct_on `n` THENL [ 2902 SIMP_TAC std_ss [], 2903 2904 SIMP_TAC list_ss [DS_POINTER_LIST_def, FRONT_DEF, DS_POINTER_LIST___NOT_EQ_NIL] THEN 2905 REPEAT STRIP_TAC THEN 2906 Cases_on `m` THENL [ 2907 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, DS_POINTER_LIST___HD] THEN 2908 FULL_SIMP_TAC list_ss [SUBSET_DEF, IN_LIST_TO_SET], 2909 2910 Q.ABBREV_TAC `e1':('b, 'a) ds_expression = (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))))` THEN 2911 Q.PAT_X_ASSUM `!e1. P e1` (fn thm => MP_TAC (Q.SPEC `e1'` thm)) THEN 2912 ASM_SIMP_TAC list_ss [] THEN 2913 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, PROVE_TAC[])) THEN 2914 REPEAT STRIP_TAC THENL [ 2915 FULL_SIMP_TAC list_ss [SUBSET_DEF], 2916 FULL_SIMP_TAC std_ss [] 2917 ] 2918 ] 2919 ] 2920]); 2921 2922 2923 2924 2925 2926val SF_SEM_EVAL___SF_LIST_0 = store_thm ("SF_SEM_EVAL___SF_LIST_0", `` 2927 (SF_SEM s h (sf_star (sf_ls_len 0 e1 e2) sf)) = 2928 (PF_SEM s (pf_equal e1 e2) /\ (SF_SEM s h sf))``, 2929 2930 SIMP_TAC std_ss [SF_SEM_def, SF_SEM_LIST_LEN_def, FDOM_FEMPTY, 2931 pred_setTheory.DISJOINT_EMPTY, FUNION_FEMPTY_1]); 2932 2933 2934 2935val SF_SEM_EVAL___SF_LIST_SUC = store_thm ("SF_SEM_EVAL___SF_LIST_SUC", `` 2936 (SF_SEM s h (sf_star (sf_ls_len (SUC n) e1 e2) sf)) = 2937 (~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1)) /\ 2938 let e1_eval = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) in 2939 (e1_eval IN FDOM h) /\ 2940 (PF_SEM s (pf_unequal e1 e2)) /\ 2941 (SF_SEM s (h \\ e1_eval) (sf_star (sf_ls_len n (dse_const (h ' 2942 e1_eval)) e2) sf)))``, 2943 2944SIMP_TAC std_ss [SF_SEM_def, SF_SEM_LIST_LEN_def, LET_THM, 2945 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, DS_EXPRESSION_EVAL_def] THEN 2946Q.ABBREV_TAC `e1_eval = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)` THEN 2947Cases_on `~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1))` THEN ASM_REWRITE_TAC[] THEN 2948Cases_on `PF_SEM s (pf_unequal e1 e2)` THEN ASM_REWRITE_TAC[] THEN 2949EQ_TAC THEN REPEAT STRIP_TAC THENL [ 2950 Q.EXISTS_TAC `h1 \\ e1_eval` THEN 2951 Q.EXISTS_TAC `h2` THEN 2952 REPEAT STRIP_TAC THENL [ 2953 FULL_SIMP_TAC std_ss [FUNION_DEF, GSYM fmap_EQ_THM, 2954 FDOM_DOMSUB, IN_UNION, IN_DELETE, EXTENSION, DISJOINT_DEF, 2955 IN_INTER, NOT_IN_EMPTY, DOMSUB_FAPPLY_NEQ] THEN 2956 PROVE_TAC[], 2957 2958 FULL_SIMP_TAC std_ss [FUNION_DEF, GSYM fmap_EQ_THM, 2959 FDOM_DOMSUB, IN_UNION, IN_DELETE, EXTENSION, DISJOINT_DEF, 2960 IN_INTER, NOT_IN_EMPTY, DOMSUB_FAPPLY_NEQ] THEN 2961 PROVE_TAC[], 2962 2963 FULL_SIMP_TAC std_ss [DISJOINT_DEF, 2964 IN_INTER, NOT_IN_EMPTY, FDOM_DOMSUB, IN_DELETE, EXTENSION] THEN 2965 METIS_TAC[], 2966 2967 ASM_SIMP_TAC std_ss [FUNION_DEF], 2968 ASM_REWRITE_TAC[] 2969 ], 2970 2971 2972 Q.EXISTS_TAC `h1 |+ (e1_eval, h ' e1_eval)` THEN 2973 Q.EXISTS_TAC `h2` THEN 2974 REPEAT STRIP_TAC THENL [ 2975 FULL_SIMP_TAC std_ss [FUNION_DEF, GSYM fmap_EQ_THM, 2976 FDOM_DOMSUB, IN_UNION, IN_DELETE, EXTENSION, DISJOINT_DEF, 2977 IN_INTER, NOT_IN_EMPTY, DOMSUB_FAPPLY_NEQ, FDOM_FUPDATE, 2978 IN_INSERT] THEN 2979 REPEAT STRIP_TAC THENL [ 2980 METIS_TAC[], 2981 2982 Cases_on `x = e1_eval` THEN ( 2983 ASM_SIMP_TAC std_ss [FAPPLY_FUPDATE_THM] 2984 ) THEN 2985 METIS_TAC[] 2986 ], 2987 2988 FULL_SIMP_TAC std_ss [DISJOINT_DEF, 2989 IN_INTER, NOT_IN_EMPTY, FDOM_DOMSUB, IN_DELETE, EXTENSION, FDOM_FUPDATE, IN_INSERT, 2990 GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION] THEN 2991 METIS_TAC[], 2992 2993 SIMP_TAC std_ss [FDOM_FUPDATE, IN_INSERT], 2994 2995 SIMP_TAC std_ss [DOMSUB_FUPDATE] THEN 2996 `h1 \\ e1_eval = h1` by ( 2997 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, 2998 DOMSUB_FAPPLY_NEQ, FUNION_DEF, IN_UNION] THEN 2999 METIS_TAC[] 3000 ) THEN 3001 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FAPPLY_FUPDATE] THEN 3002 METIS_TAC[], 3003 3004 ASM_REWRITE_TAC[] 3005 ] 3006]); 3007 3008 3009 3010val SF_SEM_EVAL___SF_LIST_SUC2 = store_thm ("SF_SEM_EVAL___SF_LIST_SUC2", `` 3011 !s h. 3012 SF_SEM s h (sf_star (sf_ls_len (SUC n) e1 e2) sf) = 3013 (let e = (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)))) in 3014 (PF_SEM s (pf_unequal e1 e2) /\ 3015 SF_SEM s h (sf_star (sf_points_to e1 e) (sf_star (sf_ls_len n e e2) sf))))``, 3016 3017SIMP_TAC std_ss [SF_EQUIV_def, SF_SEM_EVAL___SF_LIST_SUC, SF_SEM_EVAL___SF_POINTS_TO, LET_THM, 3018 DS_EXPRESSION_EVAL_def, DS_POINTS_TO_def] THEN 3019REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ( 3020 ASM_SIMP_TAC std_ss [] 3021)); 3022 3023 3024 3025val SF_SEM_EVAL___SF_LIST1 = prove (`` 3026 (SF_SEM s h (sf_star (sf_ls e1 e2) sf)) = 3027 ?n. (SF_SEM s h (sf_star (sf_ls_len n e1 e2) sf))``, 3028 3029 SIMP_TAC std_ss [SF_SEM_def] THEN METIS_TAC[]) 3030 3031 3032val SF_SEM_EVAL___SF_LIST = store_thm ("SF_SEM_EVAL___SF_LIST", `` 3033 (SF_SEM s h (sf_star (sf_ls e1 e2) sf)) = 3034 (if (PF_SEM s (pf_equal e1 e2)) then 3035 (SF_SEM s h sf) 3036 else ( 3037 (~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1))) /\ 3038 (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM h) /\ 3039 (SF_SEM s (h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) (sf_star (sf_ls (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)))) e2) sf))))``, 3040 3041 3042 SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST1] THEN 3043 Cases_on `PF_SEM s (pf_equal e1 e2)` THENL [ 3044 ASM_SIMP_TAC std_ss [] THEN 3045 EQ_TAC THEN REPEAT STRIP_TAC THENL [ 3046 Cases_on `n` THENL [ 3047 FULL_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_0], 3048 FULL_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_SUC, PF_SEM_def, LET_THM] 3049 ], 3050 3051 Q.EXISTS_TAC `0` THEN 3052 ASM_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_0] 3053 ], 3054 3055 ASM_SIMP_TAC std_ss [] THEN 3056 EQ_TAC THEN STRIP_TAC THENL [ 3057 Cases_on `n` THENL [ 3058 FULL_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_0], 3059 FULL_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_SUC, LET_THM] THEN 3060 METIS_TAC[] 3061 ], 3062 3063 Q.EXISTS_TAC `SUC n` THEN 3064 FULL_SIMP_TAC std_ss [SF_SEM_EVAL___SF_LIST_SUC, PF_SEM_def, LET_THM] 3065 ] 3066 ]) 3067 3068 3069val SF_SEM_EVAL1 = prove ( 3070 ``(SF_SEM s h sf_emp = (h = FEMPTY)) /\ 3071 (SF_SEM s h sf_true = T) /\ 3072 (SF_SEM s h (sf_ls e1 e2) = SF_SEM s h (sf_star (sf_ls e1 e2) sf_emp)) /\ 3073 (SF_SEM s h (sf_ls_len n e1 e2) = SF_SEM s h (sf_star (sf_ls_len n e1 e2) sf_emp)) /\ 3074 (SF_SEM s h (sf_points_to e1 e2) = SF_SEM s h (sf_star (sf_points_to e1 e2) sf_emp)) /\ 3075 3076 (SF_SEM s h (sf_star sf_emp sf) = SF_SEM s h sf) /\ 3077 (SF_SEM s h (sf_star (sf_star sf1 sf2) sf3) = SF_SEM s h (sf_star sf1 (sf_star sf2 sf3)))``, 3078 3079SIMP_TAC std_ss [REWRITE_RULE [SF_EQUIV_def] SF_SEM___STAR_EMP, REWRITE_RULE [SF_EQUIV_def] SF_SEM___STAR_ASSOC] THEN 3080SIMP_TAC std_ss [SF_SEM_def]); 3081 3082 3083 3084val SF_SEM_EVAL = save_thm ("SF_SEM_EVAL", 3085 SIMP_RULE std_ss [FORALL_AND_THM, LET_THM] (GEN_ALL 3086 (LIST_CONJ [SF_SEM_EVAL1, 3087 SF_SEM_EVAL___SF_POINTS_TO, 3088 SF_SEM_EVAL___SF_LIST_0, 3089 SF_SEM_EVAL___SF_LIST_SUC, 3090 SF_SEM_EVAL___SF_LIST]))); 3091 3092 3093*) 3094 3095 3096 3097 3098 3099val LIST_PF_SEM_def = Define ` 3100 LIST_PF_SEM s pfL = PF_SEM s (FOLDR pf_and pf_true pfL)` 3101 3102val LIST_SF_SEM_def = Define ` 3103 LIST_SF_SEM s h sfL = 3104 SF_SEM s h (FOLDR sf_star sf_emp sfL)`; 3105 3106val LIST_DS_SEM_def = Define ` 3107 LIST_DS_SEM s h (pfL, sfL) = LIST_PF_SEM s pfL /\ LIST_SF_SEM s h sfL`; 3108 3109 3110val LIST_SEM_INTRO_THM = store_thm ("LIST_SEM_INTRO_THM", 3111 ``(PF_SEM s pf = LIST_PF_SEM s [pf]) /\ 3112 (SF_SEM s h sf = LIST_SF_SEM s h [sf]) /\ 3113 (DS_SEM s h (pf,sf) = LIST_DS_SEM s h ([pf], [sf]))``, 3114 3115 SIMP_TAC list_ss [PF_SEM_def, LIST_PF_SEM_def, 3116 LIST_SF_SEM_def, SIMP_RULE std_ss [SF_EQUIV_def] SF_SEM___STAR_EMP, 3117 DS_SEM_def, LIST_DS_SEM_def]); 3118 3119 3120 3121 3122 3123val LIST_PF_SEM_THM = store_thm ("LIST_PF_SEM_THM", 3124 ``(LIST_PF_SEM s [] = T) /\ 3125 (LIST_PF_SEM s (pf::l) = (PF_SEM s pf /\ LIST_PF_SEM s l)) /\ 3126 (LIST_PF_SEM s (APPEND l1 l2) = (LIST_PF_SEM s l1 /\ LIST_PF_SEM s l2))``, 3127 3128 REPEAT STRIP_TAC THENL [ 3129 SIMP_TAC list_ss [LIST_PF_SEM_def, PF_SEM_def], 3130 SIMP_TAC list_ss [LIST_PF_SEM_def, PF_SEM_def], 3131 3132 Induct_on `l1` THENL [ 3133 SIMP_TAC list_ss [LIST_PF_SEM_def, PF_SEM_def], 3134 FULL_SIMP_TAC list_ss [LIST_PF_SEM_def, PF_SEM_def] THEN METIS_TAC[] 3135 ] 3136 ]); 3137 3138 3139val MEM_LIST_PF_SEM = store_thm ("MEM_LIST_PF_SEM", 3140 ``!s pfL. LIST_PF_SEM s pfL = (!pf. MEM pf pfL ==> PF_SEM s pf)``, 3141 3142 Induct_on `pfL` THENL [ 3143 SIMP_TAC list_ss [LIST_PF_SEM_THM], 3144 ASM_SIMP_TAC list_ss [LIST_PF_SEM_THM, DISJ_IMP_THM, FORALL_AND_THM] 3145 ]) 3146 3147 3148val MEM_UNEQ_PF_LIST_def = Define ` 3149 MEM_UNEQ_PF_LIST e1 e2 pfL = 3150 MEM (pf_unequal e1 e2) pfL \/ MEM (pf_unequal e2 e1) pfL` 3151 3152val MEM_UNEQ_PF_LIST_SEM = store_thm ("MEM_UNEQ_PF_LIST_SEM", 3153`` !e1 e2 pfL s. 3154 (MEM_UNEQ_PF_LIST e1 e2 pfL /\ 3155 LIST_PF_SEM s pfL) ==> 3156 ~(DS_EXPRESSION_EQUAL s e1 e2)``, 3157 3158 SIMP_TAC std_ss [MEM_LIST_PF_SEM, MEM_UNEQ_PF_LIST_def] THEN 3159 REPEAT STRIP_TAC THEN ( 3160 RES_TAC THEN 3161 FULL_SIMP_TAC std_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] 3162 )); 3163 3164 3165val LIST_PF_SEM_PERM = store_thm ("LIST_PF_SEM_PERM", 3166``!l1 l2. PERM l1 l2 ==> 3167 !s. (LIST_PF_SEM s l1 = LIST_PF_SEM s l2)``, 3168 3169HO_MATCH_MP_TAC PERM_IND THEN 3170SIMP_TAC list_ss [LIST_PF_SEM_THM] THEN 3171PROVE_TAC[]); 3172 3173 3174 3175 3176 3177val DS_FLAT_PF_def = Define 3178 `(DS_FLAT_PF pf_true = []) /\ 3179 (DS_FLAT_PF (pf_and pf1 pf2) = APPEND (DS_FLAT_PF pf1) (DS_FLAT_PF pf2)) /\ 3180 (DS_FLAT_PF x = [x])` 3181 3182 3183val LIST_PF_SEM_FLAT_INTRO = store_thm ("LIST_PF_SEM_FLAT_INTRO", 3184 ``!s. PF_SEM s pf = LIST_PF_SEM s (DS_FLAT_PF pf)``, 3185 3186 Induct_on `pf` THENL [ 3187 SIMP_TAC std_ss [DS_FLAT_PF_def, LIST_PF_SEM_THM, PF_SEM_def], 3188 SIMP_TAC std_ss [DS_FLAT_PF_def, LIST_PF_SEM_THM], 3189 SIMP_TAC std_ss [DS_FLAT_PF_def, LIST_PF_SEM_THM], 3190 ASM_SIMP_TAC std_ss [DS_FLAT_PF_def, LIST_PF_SEM_THM, PF_SEM_def] 3191 ]); 3192 3193val DS_FALT_PF_THM = store_thm ("DS_FLAT_PF_THM", 3194 ``!s pfL. LIST_PF_SEM s pfL = LIST_PF_SEM s (FLAT (MAP DS_FLAT_PF pfL))``, 3195 3196Induct_on `pfL` THEN1 SIMP_TAC list_ss [] THEN 3197ASM_SIMP_TAC list_ss [LIST_PF_SEM_THM, LIST_PF_SEM_FLAT_INTRO]); 3198 3199 3200val LIST_SF_SEM_THM = store_thm ("LIST_SF_SEM_THM", 3201 ``(!s h. (LIST_SF_SEM s h [] = (h = FEMPTY))) /\ 3202 (!s h sf. (LIST_SF_SEM s h [sf] = (SF_SEM s h sf))) /\ 3203 (!s h sf l. (LIST_SF_SEM s h (sf::l) = (?h1 h2. 3204 (h = FUNION h1 h2) /\ DISJOINT (FDOM h1) (FDOM h2) /\ 3205 (SF_SEM s h1 sf /\ LIST_SF_SEM s h2 l)))) /\ 3206 3207 (!s h l1 l2. (LIST_SF_SEM s h (APPEND l1 l2) = (?h1 h2. 3208 (h = FUNION h1 h2) /\ DISJOINT (FDOM h1) (FDOM h2) /\ 3209 (LIST_SF_SEM s h1 l1 /\ LIST_SF_SEM s h2 l2))))``, 3210 3211 REPEAT CONJ_TAC THENL [ 3212 SIMP_TAC list_ss [LIST_SF_SEM_def, SF_SEM_def], 3213 3214 SIMP_TAC list_ss [LIST_SF_SEM_def, SF_SEM_def, FUNION_FEMPTY_2, 3215 FDOM_FEMPTY, DISJOINT_EMPTY], 3216 3217 SIMP_TAC list_ss [LIST_SF_SEM_def, SF_SEM_def], 3218 3219 Induct_on `l1` THENL [ 3220 SIMP_TAC list_ss [LIST_SF_SEM_def, SF_SEM_def, FUNION_FEMPTY_1, 3221 FDOM_FEMPTY, DISJOINT_EMPTY], 3222 3223 FULL_SIMP_TAC list_ss [LIST_SF_SEM_def, SF_SEM_def, 3224 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 3225 REPEAT GEN_TAC THEN 3226 HO_MATCH_MP_TAC (prove (``(!h1 h1' h2'. 3227 (P h1 h1' h2' = Q h2' h1 h1')) 3228 ==> 3229 ((?h1 h1' h2'. P h1 h1' h2') = 3230 (?h2 h1' h2'. Q h2 h1' h2'))``, METIS_TAC[])) THEN 3231 3232 REPEAT STRIP_TAC THEN 3233 Cases_on `SF_SEM s h2' (FOLDR sf_star sf_emp l1)` THEN ASM_REWRITE_TAC[] THEN 3234 Cases_on `SF_SEM s h2 (FOLDR sf_star sf_emp l2)` THEN ASM_REWRITE_TAC[] THEN 3235 Cases_on `SF_SEM s h1' h` THEN ASM_REWRITE_TAC[] THEN 3236 SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_UNION_BOTH] THEN 3237 Cases_on `DISJOINT (FDOM h2') (FDOM h2)` THEN ASM_REWRITE_TAC[] THEN 3238 Cases_on `DISJOINT (FDOM h1') (FDOM h2')` THEN ( 3239 ASM_SIMP_TAC std_ss [DISJOINT_SYM] 3240 ) THEN 3241 Cases_on `DISJOINT (FDOM h1') (FDOM h2)` THEN ASM_REWRITE_TAC[] THEN 3242 3243 MATCH_MP_TAC (prove (``(b1 = b2) ==> ((a = b1) = (a = b2))``, METIS_TAC[])) THEN 3244 3245 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 3246 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, EXTENSION, IN_UNION, 3247 DISJ_IMP_THM] THEN 3248 METIS_TAC[] 3249 ] 3250 ]); 3251 3252 3253val LIST_SF_SEM_PERM = store_thm ("LIST_SF_SEM_PERM", 3254``!l1 l2. PERM l1 l2 ==> 3255 !s h. (LIST_SF_SEM s h l1 = LIST_SF_SEM s h l2)``, 3256 3257HO_MATCH_MP_TAC PERM_IND THEN 3258SIMP_TAC list_ss [LIST_SF_SEM_THM, 3259 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 3260REPEAT STRIP_TAC THEN 3261HO_MATCH_MP_TAC (prove (``(!h1 h1' h2'. 3262 (P h1 h1' h2' = Q h1' h1 h2')) 3263 ==> 3264 ((?h1 h1' h2'. P h1 h1' h2') = 3265 (?h2 h1' h2'. Q h2 h1' h2'))``, METIS_TAC[])) THEN 3266REPEAT GEN_TAC THEN 3267Cases_on `SF_SEM s h1 y` THEN ASM_REWRITE_TAC[] THEN 3268Cases_on `SF_SEM s h1' x` THEN ASM_REWRITE_TAC[] THEN 3269Cases_on `LIST_SF_SEM s h2' l2` THEN ASM_REWRITE_TAC[] THEN 3270SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] THEN 3271Cases_on `DISJOINT (FDOM h1') (FDOM h2')` THEN ASM_REWRITE_TAC[] THEN 3272Cases_on `DISJOINT (FDOM h1) (FDOM h2')` THEN ASM_REWRITE_TAC[] THEN 3273Cases_on `DISJOINT (FDOM h1) (FDOM h1')` THEN ASM_REWRITE_TAC[] THEN 3274MATCH_MP_TAC (prove (``(b1 = b2) ==> ((a = b1) = (a = b2))``, METIS_TAC[])) THEN 3275 3276FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 3277ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, EXTENSION, IN_UNION, 3278 DISJ_IMP_THM] THEN 3279METIS_TAC[]) 3280 3281 3282 3283 3284val DS_FLAT_SF_def = Define 3285 `(DS_FLAT_SF sf_emp = []) /\ 3286 (DS_FLAT_SF (sf_star sf1 sf2) = APPEND (DS_FLAT_SF sf1) (DS_FLAT_SF sf2)) /\ 3287 (DS_FLAT_SF x = [x])` 3288 3289 3290val LIST_SF_SEM_FLAT_INTRO = store_thm ("LIST_SF_SEM_FLAT_INTRO", 3291 ``!s h sf. SF_SEM s h sf = LIST_SF_SEM s h (DS_FLAT_SF sf)``, 3292 3293 Induct_on `sf` THENL [ 3294 SIMP_TAC std_ss [DS_FLAT_SF_def, LIST_SF_SEM_THM, SF_SEM_def], 3295 SIMP_TAC std_ss [DS_FLAT_SF_def, LIST_SF_SEM_THM], 3296 SIMP_TAC std_ss [DS_FLAT_SF_def, LIST_SF_SEM_THM], 3297 ASM_SIMP_TAC std_ss [DS_FLAT_SF_def, LIST_SF_SEM_THM, SF_SEM_def] 3298 ]); 3299 3300 3301 3302val DS_FALT_SF_THM = store_thm ("DS_FLAT_SF_THM", 3303 ``!s h sfL. LIST_SF_SEM s h sfL = LIST_SF_SEM s h (FLAT (MAP DS_FLAT_SF sfL))``, 3304 3305Induct_on `sfL` THEN1 SIMP_TAC list_ss [] THEN 3306ASM_SIMP_TAC list_ss [LIST_SF_SEM_THM, LIST_SF_SEM_FLAT_INTRO]); 3307 3308 3309 3310val LIST_DS_SEM_FLAT_INTRO = store_thm ("LIST_DS_SEM_FLAT_INTRO", 3311 ``(!s h sf pf. DS_SEM s h (pf, sf) = LIST_DS_SEM s h ((DS_FLAT_PF pf), DS_FLAT_SF sf)) /\ 3312 (!s sf. PF_SEM s pf = LIST_DS_SEM s FEMPTY (DS_FLAT_PF pf, [])) /\ 3313 (!s h sf. SF_SEM s h sf = LIST_DS_SEM s h ([], DS_FLAT_SF sf))``, 3314 3315 SIMP_TAC std_ss [DS_SEM_def, LIST_PF_SEM_FLAT_INTRO, LIST_SF_SEM_FLAT_INTRO, 3316 LIST_DS_SEM_def, LIST_PF_SEM_THM, LIST_SF_SEM_THM]); 3317 3318 3319val LIST_DS_SEM_THM = store_thm ("LIST_DS_SEM_THM", `` 3320(!s h pfL. (LIST_DS_SEM s h (pfL, []) = LIST_PF_SEM s pfL /\ (h = FEMPTY))) /\ 3321(!s h sfL. (LIST_DS_SEM s h ([], sfL) = LIST_SF_SEM s h sfL)) /\ 3322(!s h pfL sfL e. (LIST_DS_SEM s h (pfL, e::sfL) = 3323 ?h1 h2. (h = FUNION h1 h2) /\ (DISJOINT (FDOM h1) (FDOM h2)) /\ 3324 LIST_DS_SEM s h2 (pfL, sfL) /\ SF_SEM s h1 e)) /\ 3325(!s h pfL sfL e. (LIST_DS_SEM s h (e::pfL, sfL) = 3326 LIST_DS_SEM s h (pfL,sfL) /\ PF_SEM s e)) /\ 3327 3328(!s h pfL sfL1 sfL2 e. (LIST_DS_SEM s h (pfL, sfL1++sfL2) = 3329 ?h1 h2. (h = FUNION h1 h2) /\ (DISJOINT (FDOM h1) (FDOM h2)) /\ 3330 LIST_DS_SEM s h1 (pfL, sfL1) /\ LIST_DS_SEM s h2 (pfL, sfL2)))``, 3331 3332SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_SF_SEM_THM, LIST_PF_SEM_THM] THEN 3333METIS_TAC[]); 3334 3335 3336 3337 3338 3339 3340val LIST_DS_SEM_EVAL1 = prove (`` 3341(!s h. LIST_DS_SEM s h ([], []) = (h = FEMPTY)) /\ 3342(!s h. LIST_DS_SEM s h (pfL, []) = (LIST_PF_SEM s pfL /\ (h = FEMPTY))) /\ 3343(!s h sfL pfL pf1 pf2. LIST_DS_SEM s h ((pf_and pf1 pf2)::sfL, pfL) = LIST_DS_SEM s h (pf1 :: pf2 :: sfL, pfL)) /\ 3344 3345(!s h sfL pfL e1 e2. LIST_DS_SEM s h ((pf_equal e1 e2)::sfL, pfL) = 3346(DS_EXPRESSION_EQUAL s e1 e2 /\ LIST_DS_SEM s h (sfL, pfL))) /\ 3347 3348(!s h sfL pfL e1 e2. LIST_DS_SEM s h ((pf_unequal e1 e2)::sfL, pfL) = 3349(~DS_EXPRESSION_EQUAL s e1 e2 /\ LIST_DS_SEM s h (sfL, pfL)))``, 3350 3351SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_PF_SEM_THM, LIST_SF_SEM_THM, PF_SEM_def, 3352 SF_SEM_def] THEN 3353METIS_TAC[]); 3354 3355 3356 3357val LIST_DS_SEM_EVAL2 = prove (`` 3358(!s h sfL pfL. LIST_DS_SEM s h (sfL, sf_emp::pfL) = LIST_DS_SEM s h (sfL, pfL)) /\ 3359 3360(!s h sfL pfL sf1 sf2. LIST_DS_SEM s h (sfL, (sf_star sf1 sf2)::pfL) = LIST_DS_SEM s h (sfL, sf1 :: sf2 :: pfL))``, 3361 3362SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_PF_SEM_THM, LIST_SF_SEM_THM, PF_SEM_def, SF_SEM_def, 3363 FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 3364REPEAT STRIP_TAC THENL [ 3365 SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 3366 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ 3367 Q.EXISTS_TAC `h1'` THEN 3368 Q.EXISTS_TAC `h2'` THEN 3369 Q.EXISTS_TAC `h2` THEN 3370 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FUNION_DEF, 3371 IN_UNION, GSYM fmap_EQ_THM] THEN 3372 METIS_TAC[], 3373 3374 Q.EXISTS_TAC `h2'` THEN 3375 Q.EXISTS_TAC `h1` THEN 3376 Q.EXISTS_TAC `h1'` THEN 3377 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FUNION_DEF, 3378 IN_UNION, GSYM fmap_EQ_THM] THEN 3379 METIS_TAC[] 3380 ] 3381]) 3382 3383 3384val LIST_DS_SEM_EVAL3 = prove (`` 3385!s h fL sfL pfL es e. LIST_DS_SEM s h (pfL, (sf_tree fL es e)::sfL) = 3386 if (DS_EXPRESSION_EQUAL s e es) then 3387 LIST_DS_SEM s h (pfL, sfL) 3388 else 3389 let cL = MAP (\f. h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f) fL in 3390 LIST_DS_SEM s h (pfL, 3391 (sf_points_to e (MAP (\(f,c). (f,dse_const c)) (ZIP (fL,cL)))):: 3392 (APPEND (MAP (\c. sf_tree fL es (dse_const c)) cL) sfL))``, 3393 3394SIMP_TAC std_ss [Once LIST_DS_SEM_THM] THEN 3395SIMP_TAC std_ss [SF_SEM___sf_tree_THM] THEN 3396REPEAT GEN_TAC THEN 3397Cases_on `(DS_EXPRESSION_EQUAL s e es)` THEN ASM_REWRITE_TAC[] THEN1 ( 3398 SIMP_TAC std_ss [FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] 3399) THEN 3400SIMP_TAC std_ss [GSYM APPEND] THEN 3401ONCE_REWRITE_TAC [LIST_DS_SEM_THM] THEN 3402SIMP_TAC std_ss [LET_THM] THEN 3403HO_MATCH_MP_TAC (prove (``(!h1 h2. P h1 h2 = Q h1 h2) ==> ((?h1 h2. P h1 h2) = (?h1 h2. Q h1 h2))``, 3404 METIS_TAC[])) THEN 3405REPEAT GEN_TAC THEN 3406Cases_on `(h = FUNION h1 h2) /\ DISJOINT (FDOM h1) (FDOM h2) /\ 3407 LIST_DS_SEM s h2 (pfL,sfL)` THEN FULL_SIMP_TAC std_ss [] THEN 3408FULL_SIMP_TAC list_ss [LIST_DS_SEM_def, LIST_SF_SEM_def] THEN 3409 3410 3411SIMP_TAC list_ss [SF_SEM___sf_points_to_THM, DS_POINTS_TO_def] THEN 3412Cases_on `~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 3413 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h1` THEN ( 3414 FULL_SIMP_TAC std_ss [] 3415) THEN 3416ASM_SIMP_TAC std_ss [FUNION_DEF, DS_EXPRESSION_EVAL_VALUE_def, FOLDR_MAP]); 3417 3418 3419 3420val LIST_DS_SEM_EVAL3a = prove (`` 3421(!s h fL sfL pfL es e. 3422 DS_EXPRESSION_EQUAL s e es ==> 3423 (LIST_DS_SEM s h (pfL, (sf_tree fL es e)::sfL) = 3424 LIST_DS_SEM s h (pfL, sfL))) /\ 3425 3426(!s h fL sfL pfL es e. 3427 ~DS_EXPRESSION_EQUAL s e es ==> 3428 (LIST_DS_SEM s h (pfL, (sf_tree fL es e)::sfL) = 3429 3430 let cL = MAP (\f. h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f) fL in 3431 LIST_DS_SEM s h (pfL, 3432 (sf_points_to e (MAP (\(f,c). (f,dse_const c)) (ZIP (fL,cL)))):: 3433 (APPEND (MAP (\c. sf_tree fL es (dse_const c)) cL) sfL))))``, 3434 3435SIMP_TAC std_ss [LIST_DS_SEM_EVAL3]); 3436 3437 3438 3439 3440 3441 3442val LIST_DS_SEM_EVAL3b = prove (`` 3443(!s h f sfL pfL e1 e2. 3444 DS_EXPRESSION_EQUAL s e1 e2 ==> 3445 (LIST_DS_SEM s h (pfL, (sf_ls f e1 e2)::sfL) = 3446 LIST_DS_SEM s h (pfL, sfL))) /\ 3447 3448(!s h f sfL pfL e. 3449 (LIST_DS_SEM s h (pfL, (sf_ls f e e)::sfL) = 3450 LIST_DS_SEM s h (pfL, sfL))) /\ 3451 3452(!s h f1 f2 sfL pfL e. 3453 DS_EXPRESSION_EQUAL s e dse_nil ==> 3454 (LIST_DS_SEM s h (pfL, (sf_bin_tree (f1,f2) e)::sfL) = 3455 LIST_DS_SEM s h (pfL, sfL))) /\ 3456 3457(!s h f1 f2 sfL pfL. 3458 (LIST_DS_SEM s h (pfL, (sf_bin_tree (f1,f2) dse_nil)::sfL) = 3459 LIST_DS_SEM s h (pfL, sfL))) /\ 3460 3461 3462(!s h f sfL pfL e1 e2. 3463 ~DS_EXPRESSION_EQUAL s e1 e2 ==> 3464 (LIST_DS_SEM s h (pfL, (sf_ls f e1 e2)::sfL) = 3465 3466 let c = h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f in 3467 LIST_DS_SEM s h (pfL, 3468 (sf_points_to e1 [f, dse_const c]):: 3469 (sf_ls f (dse_const c) e2)::sfL))) /\ 3470 3471(!s h f1 f2 sfL pfL e1 e2. 3472 ~DS_EXPRESSION_EQUAL s e dse_nil ==> 3473 (LIST_DS_SEM s h (pfL, (sf_bin_tree (f1,f2) e)::sfL) = 3474 3475 let c1 = h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f1 in 3476 let c2 = h ' (DS_EXPRESSION_EVAL_VALUE s e) ' f2 in 3477 LIST_DS_SEM s h (pfL, 3478 (sf_points_to e [(f1, dse_const c1);(f2, dse_const c2)]):: 3479 (sf_bin_tree (f1,f2) (dse_const c1)):: 3480 (sf_bin_tree (f1,f2) (dse_const c2))::sfL) 3481 ) 3482) 3483``, 3484 3485SIMP_TAC list_ss [sf_ls_def, sf_bin_tree_def, LIST_DS_SEM_EVAL3a, 3486 DS_EXPRESSION_EQUAL_def, LET_THM]); 3487 3488 3489 3490val LIST_DS_SEM_EVAL4 = prove (`` 3491!s h sfL pfL e a. LIST_DS_SEM s h (sfL, (sf_points_to e a)::pfL) = 3492 DS_POINTS_TO s h e a /\ 3493 LIST_DS_SEM s (h \\ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))) (sfL, pfL)``, 3494 3495 3496SIMP_TAC list_ss [LIST_DS_SEM_def, LIST_SF_SEM_def, 3497 SF_SEM___sf_points_to_THM] THEN 3498METIS_TAC[]); 3499 3500 3501 3502 3503val LIST_DS_SEM_EVAL = save_thm ("LIST_DS_SEM_EVAL", 3504 LIST_CONJ [LIST_DS_SEM_EVAL1, 3505 LIST_DS_SEM_EVAL2, 3506 LIST_DS_SEM_EVAL3a, 3507 LIST_DS_SEM_EVAL3b, 3508 LIST_DS_SEM_EVAL4]); 3509 3510 3511 3512 3513 3514val LIST_DS_SEM_PERM = store_thm ("LIST_DS_SEM_PERM", 3515``!pfL1 pfL2 sfL1 sfL2. (PERM pfL1 pfL2 /\ PERM sfL1 sfL2) ==> 3516 !s h. (LIST_DS_SEM s h (pfL1, sfL1) = LIST_DS_SEM s h (pfL2, sfL2))``, 3517 3518 SIMP_TAC std_ss [LIST_DS_SEM_def] THEN 3519 PROVE_TAC[LIST_PF_SEM_PERM, LIST_SF_SEM_PERM]) 3520 3521 3522 3523val DS_POINTER_DANGLES_def = Define ` 3524 DS_POINTER_DANGLES s h e = 3525 !a. ~(DS_POINTS_TO s h e a)` 3526 3527val SF_SEM___EXTEND_def = Define ` 3528 SF_SEM___EXTEND s h sf1 sf2 = 3529 (!h'. (DISJOINT (FDOM h) (FDOM h') /\ 3530 SF_SEM s h' sf1) ==> 3531 SF_SEM s (FUNION h h') sf2)` 3532 3533 3534val NOT_DS_POINTER_DANGLES = store_thm ("NOT_DS_POINTER_DANGLES", 3535 ``!s h e. ~(DS_POINTER_DANGLES s h e) = 3536 (~IS_DSV_NIL (DS_EXPRESSION_EVAL s e) /\ 3537 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h)``, 3538 3539 SIMP_TAC std_ss [DS_POINTER_DANGLES_def, DS_POINTS_TO_def] THEN 3540 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN 3541 Q.EXISTS_TAC `[]` THEN 3542 SIMP_TAC list_ss []); 3543 3544 3545val DS_POINTER_DANGLES = store_thm ("DS_POINTER_DANGLES", 3546 ``!s h e. (DS_POINTER_DANGLES s h e) = 3547 (IS_DSV_NIL (DS_EXPRESSION_EVAL s e) \/ 3548 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h))``, 3549 3550 METIS_TAC[NOT_DS_POINTER_DANGLES]); 3551 3552 3553 3554val DS_VAR_SUBST_def = Define ` 3555 (DS_VAR_SUBST v e (dse_const c) = dse_const c) /\ 3556 (DS_VAR_SUBST v e (dse_var v') = if (v = v') then e else (dse_var v'))` 3557 3558val DS_VAR_SUBST_NIL = store_thm ("DS_VAR_SUBST_NIL", 3559 ``!v e. DS_VAR_SUBST v e dse_nil = dse_nil``, 3560 SIMP_TAC std_ss [dse_nil_def, DS_VAR_SUBST_def]) 3561 3562 3563val DS_VAR_SUBST_SEM = store_thm ("DS_VAR_SUBST_SEM", 3564``!s d. DS_EXPRESSION_EVAL s (DS_VAR_SUBST v e d) = 3565 (DS_EXPRESSION_EVAL 3566 (\x. (if x = v then DS_EXPRESSION_EVAL s e else s x)) d)``, 3567 3568 Cases_on `d` THENL [ 3569 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def], 3570 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def, COND_RATOR, COND_RAND] 3571 ]) 3572 3573 3574val PF_SUBST_def = Define ` 3575 (PF_SUBST v e pf_true = pf_true) /\ 3576 (PF_SUBST v e (pf_equal e1 e2) = pf_equal (DS_VAR_SUBST v e e1) (DS_VAR_SUBST v e e2)) /\ 3577 (PF_SUBST v e (pf_unequal e1 e2) = pf_unequal (DS_VAR_SUBST v e e1) (DS_VAR_SUBST v e e2)) /\ 3578 (PF_SUBST v e (pf_and pf1 pf2) = 3579 pf_and (PF_SUBST v e pf1) (PF_SUBST v e pf2))` 3580 3581 3582val PF_SUBST_SEM = store_thm ("PF_SUBST_SEM", 3583 ``!s pf v e. 3584 PF_SEM s (PF_SUBST v e pf) = 3585 PF_SEM (\x. if x = v then DS_EXPRESSION_EVAL s e else s x) pf``, 3586 3587 Induct_on `pf` THENL [ 3588 SIMP_TAC std_ss [PF_SEM_def, PF_SUBST_def], 3589 3590 SIMP_TAC std_ss [PF_SEM_def, PF_SUBST_def, DS_EXPRESSION_EQUAL_def, 3591 DS_VAR_SUBST_SEM], 3592 3593 SIMP_TAC std_ss [PF_SEM_def, PF_SUBST_def, DS_EXPRESSION_EQUAL_def, 3594 DS_VAR_SUBST_SEM], 3595 3596 ASM_SIMP_TAC std_ss [PF_SUBST_def, PF_SEM_def] 3597 ]); 3598 3599val LIST_PF_SUBST_SEM = store_thm ("LIST_PF_SUBST_SEM", 3600 ``!s pfL v e. 3601 LIST_PF_SEM s (MAP (PF_SUBST v e) pfL) = 3602 LIST_PF_SEM (\x. if x = v then DS_EXPRESSION_EVAL s e else s x) pfL``, 3603 3604 SIMP_TAC std_ss [LIST_PF_SEM_def, FOLDR_MAP] THEN 3605 Induct_on `pfL` THENL [ 3606 SIMP_TAC list_ss [PF_SEM_def], 3607 ASM_SIMP_TAC list_ss [PF_SEM_def, PF_SUBST_SEM] 3608 ]); 3609 3610 3611val SF_SUBST_def = Define ` 3612 (SF_SUBST v e sf_emp = sf_emp) /\ 3613 (SF_SUBST v e (sf_points_to e1 a) = sf_points_to (DS_VAR_SUBST v e e1) (MAP (\x. (FST x, DS_VAR_SUBST v e (SND x))) a)) /\ 3614 (SF_SUBST v e (sf_tree fL e1 e2) = sf_tree fL (DS_VAR_SUBST v e e1) (DS_VAR_SUBST v e e2)) /\ 3615 (SF_SUBST v e (sf_star sf1 sf2) = sf_star (SF_SUBST v e sf1) (SF_SUBST v e sf2))` 3616 3617 3618val SF_SUBST_THM = store_thm ("SF_SUBST_THM", 3619 ``(SF_SUBST v e sf_emp = sf_emp) /\ 3620 (SF_SUBST v e (sf_points_to e1 a) = sf_points_to (DS_VAR_SUBST v e e1) (MAP (\x. (FST x, DS_VAR_SUBST v e (SND x))) a)) /\ 3621 (SF_SUBST v e (sf_tree fL e1 e2) = sf_tree fL (DS_VAR_SUBST v e e1) (DS_VAR_SUBST v e e2)) /\ 3622 (SF_SUBST v e (sf_bin_tree (f1,f2) e1) = sf_bin_tree (f1,f2) (DS_VAR_SUBST v e e1)) /\ 3623 (SF_SUBST v e (sf_ls f e1 e2) = sf_ls f (DS_VAR_SUBST v e e1) (DS_VAR_SUBST v e e2))``, 3624 3625SIMP_TAC std_ss [SF_SUBST_def, sf_bin_tree_def, dse_nil_def, DS_VAR_SUBST_def, 3626 sf_ls_def]) 3627 3628 3629 3630val SF_SUBST_SEM = store_thm ("SF_SUBST_SEM", 3631 ``!s h sf v e. 3632 SF_SEM s h (SF_SUBST v e sf) = 3633 SF_SEM (\x. if x = v then DS_EXPRESSION_EVAL s e else s x) h sf``, 3634 3635 Induct_on `sf` THENL [ 3636 SIMP_TAC std_ss [SF_SUBST_def, SF_SEM_def], 3637 3638 SIMP_TAC std_ss [SF_SUBST_def, SF_SEM_def] THEN 3639 REPEAT GEN_TAC THEN 3640 BINOP_TAC THENL [ 3641 Cases_on `d` THENL [ 3642 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, 3643 DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def], 3644 3645 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, 3646 DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def] THEN 3647 Cases_on `v' = v` THEN ( 3648 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3649 ) 3650 ], 3651 3652 3653 SIMP_TAC std_ss [DS_POINTS_TO_def] THEN 3654 BINOP_TAC THENL [ 3655 Cases_on `d` THENL [ 3656 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def], 3657 3658 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3659 Cases_on `v' = v` THEN ( 3660 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3661 ) 3662 ], 3663 3664 BINOP_TAC THENL [ 3665 Cases_on `d` THENL [ 3666 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def], 3667 3668 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3669 Cases_on `v' = v` THEN ( 3670 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3671 ) 3672 ], 3673 3674 Induct_on `l` THENL [ 3675 SIMP_TAC list_ss [], 3676 3677 ASM_SIMP_TAC list_ss [] THEN 3678 GEN_TAC THEN 3679 Tactical.REVERSE BINOP_TAC THEN1 ( 3680 METIS_TAC[] 3681 ) THEN 3682 3683 Cases_on `h'` THEN 3684 SIMP_TAC std_ss [] THEN 3685 BINOP_TAC THENL [ 3686 Cases_on `d` THENL [ 3687 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def], 3688 3689 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3690 Cases_on `v' = v` THEN ( 3691 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3692 ) 3693 ], 3694 3695 Cases_on `d` THENL [ 3696 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3697 Cases_on `r` THENL [ 3698 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def], 3699 3700 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3701 Cases_on `v' = v` THEN ( 3702 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3703 ) 3704 ], 3705 3706 3707 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3708 Cases_on `r` THENL [ 3709 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3710 Cases_on `v' = v` THEN ( 3711 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3712 ), 3713 3714 SIMP_TAC std_ss [DS_VAR_SUBST_def, DS_EXPRESSION_EVAL_def] THEN 3715 Cases_on `v' = v` THEN Cases_on `v'' = v` THEN ( 3716 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] 3717 ) 3718 ] 3719 ] 3720 ] 3721 ] 3722 ] 3723 ] 3724 ], 3725 3726 3727 3728 3729 SIMP_TAC std_ss [SF_SUBST_def, SF_SEM_def, DS_VAR_SUBST_SEM, 3730 SF_SEM___sf_tree_def] THEN 3731 REPEAT GEN_TAC THEN 3732 HO_MATCH_MP_TAC (prove (``(!x. (P x = Q x)) ==> ((?x. P x) = (?y. Q y))``, METIS_TAC[])) THEN 3733 GEN_TAC THEN 3734 Q.SPEC_TAC (`h`, `h`) THEN 3735 Q.SPEC_TAC (`l`, `l`) THEN 3736 Q.SPEC_TAC (`d0`, `d0`) THEN 3737 Induct_on `n` THENL [ 3738 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, 3739 GSYM PF_SUBST_def, PF_SUBST_SEM], 3740 3741 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, GSYM PF_SUBST_def, PF_SUBST_SEM] THEN 3742 REPEAT STRIP_TAC THEN 3743 HO_MATCH_MP_TAC (prove(``(!hL. c1 hL = c2 hL) ==> 3744 ((a \/ b /\ (?hL. c1 hL)) = (a \/ b /\ (?hL. c2 hL)))``, METIS_TAC[])) THEN 3745 GEN_TAC THEN 3746 3747 `!l h d0. MAP (HEAP_READ_ENTRY s h (DS_VAR_SUBST v e d0)) l = 3748 (MAP (HEAP_READ_ENTRY 3749 (\x. (if x = v then DS_EXPRESSION_EVAL s e else s x)) h d0) l)` by ( 3750 Induct_on `l` THENL [ 3751 SIMP_TAC list_ss [], 3752 3753 ASM_SIMP_TAC list_ss [] THEN 3754 GEN_TAC THEN 3755 SIMP_TAC std_ss [HEAP_READ_ENTRY_def] THEN 3756 Cases_on `d0` THENL [ 3757 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def], 3758 3759 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def] THEN 3760 Cases_on `v = v'` THEN ( 3761 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def] 3762 ) 3763 ] 3764 ] 3765 ) THEN 3766 3767 MATCH_MP_TAC (prove(``((a1 /\ b1 /\ f1 = a2 /\ b2 /\ f2) /\ (c1 = c2) /\ 3768 (d1 = d2) /\ (e1 = e2) /\ (g1 = g2)) ==> 3769 ((a1 /\ b1 /\ c1 /\ d1 /\ e1 /\ f1 /\ g1) = 3770 (a2 /\ b2 /\ c2 /\ d2 /\ e2 /\ f2 /\ g2))``, SIMP_TAC std_ss [] THEN METIS_TAC[])) THEN 3771 REPEAT CONJ_TAC THENL [ 3772 Cases_on `d0` THENL [ 3773 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def], 3774 3775 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def] THEN 3776 Cases_on `v = v'` THEN ( 3777 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_VAR_SUBST_def] 3778 ) 3779 ], 3780 3781 3782 ASM_SIMP_TAC std_ss [], 3783 SIMP_TAC list_ss [], 3784 REWRITE_TAC[], 3785 3786 3787 ASM_SIMP_TAC list_ss [] THEN 3788 Q.ABBREV_TAC `L = (ZIP 3789 (MAP 3790 (HEAP_READ_ENTRY 3791 (\x. (if x = v then DS_EXPRESSION_EVAL s e else s x)) h d0) 3792 l,hL))` THEN 3793 POP_ASSUM (fn thm => ALL_TAC) THEN 3794 Induct_on `L` THENL [ 3795 SIMP_TAC list_ss [], 3796 3797 GEN_TAC THEN 3798 ASM_SIMP_TAC list_ss [] THEN 3799 Tactical.REVERSE BINOP_TAC THEN1 ( 3800 REWRITE_TAC[] 3801 ) THEN 3802 Cases_on `h` THEN 3803 SIMP_TAC std_ss [] THEN 3804 METIS_TAC[DS_VAR_SUBST_def] 3805 ] 3806 ] 3807 ], 3808 3809 3810 ASM_SIMP_TAC std_ss [SF_SEM_def, SF_SUBST_def] 3811 ]); 3812 3813 3814 3815 3816val LIST_SF_SUBST_SEM = store_thm ("LIST_SF_SUBST_SEM", 3817 ``!s h sfL v e. 3818 LIST_SF_SEM s h (MAP (SF_SUBST v e) sfL) = 3819 LIST_SF_SEM (\x. if x = v then DS_EXPRESSION_EVAL s e else s x) h sfL``, 3820 3821 SIMP_TAC std_ss [LIST_SF_SEM_def, FOLDR_MAP] THEN 3822 Induct_on `sfL` THENL [ 3823 SIMP_TAC list_ss [SF_SEM_def], 3824 ASM_SIMP_TAC list_ss [SF_SEM_def, SF_SUBST_SEM] 3825 ]) 3826 3827 3828 3829 3830val SF_IS_PRECISE_def = Define ` 3831 SF_IS_PRECISE sf = 3832 (!s h h1 h2. (h1 SUBMAP h /\ h2 SUBMAP h /\ 3833 SF_SEM s h1 sf /\ SF_SEM s h2 sf) ==> (h1 = h2))` 3834 3835val SF_IS_PRECISE___sf_emp = store_thm ("SF_IS_PRECISE___sf_emp", 3836 ``SF_IS_PRECISE sf_emp``, 3837 SIMP_TAC std_ss [SF_IS_PRECISE_def, SF_SEM_def]) 3838 3839val SF_IS_PRECISE___sf_points_to = store_thm ("SF_IS_PRECISE___sf_points_to", 3840 ``!e a. SF_IS_PRECISE (sf_points_to e a)``, 3841 SIMP_TAC std_ss [SF_IS_PRECISE_def, SF_SEM_def, DS_POINTS_TO_def, 3842 GSYM fmap_EQ_THM, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, SUBMAP_DEF]) 3843 3844 3845 3846val SF_IS_PRECISE___sf_star = store_thm ("SF_IS_PRECISE___sf_star", 3847 ``!sf1 sf2. (SF_IS_PRECISE sf1 /\ SF_IS_PRECISE sf2) ==> 3848 SF_IS_PRECISE (sf_star sf1 sf2)``, 3849 SIMP_TAC std_ss [SF_IS_PRECISE_def, SF_SEM_def] THEN 3850 REPEAT STRIP_TAC THEN 3851 ASM_SIMP_TAC std_ss [] THEN 3852 `h1' SUBMAP h` by METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS, DISJOINT_SYM] THEN 3853 `h2' SUBMAP h` by METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS, DISJOINT_SYM] THEN 3854 `h1'' SUBMAP h` by METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS, DISJOINT_SYM] THEN 3855 `h2'' SUBMAP h` by METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS, DISJOINT_SYM] THEN 3856 METIS_TAC[] 3857); 3858 3859 3860 3861 3862val SF_IS_PRECISE___sf_tree = store_thm ("SF_IS_PRECISE___sf_tree", 3863 ``!fL e1 e2. SF_IS_PRECISE (sf_tree fL e1 e2)``, 3864 3865 SIMP_TAC std_ss [SF_IS_PRECISE_def, SF_SEM_def, 3866 SF_SEM___sf_tree_def] THEN 3867 REPEAT STRIP_TAC THEN 3868 `?m. SF_SEM___sf_tree_len s h1 fL m e1 e2 /\ 3869 SF_SEM___sf_tree_len s h2 fL m e1 e2` by ( 3870 Q.EXISTS_TAC `MAX n n'` THEN 3871 `(n <= MAX n n') /\ (n' <= MAX n n')` by SIMP_TAC arith_ss [] THEN 3872 METIS_TAC[SF_SEM___sf_tree_len_THM] 3873 ) THEN 3874 NTAC 2 (POP_ASSUM MP_TAC) THEN 3875 REPEAT (Q.PAT_X_ASSUM `hx SUBMAP h` MP_TAC) THEN 3876 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 3877 Q.SPEC_TAC (`e2`, `e2`) THEN 3878 Q.SPEC_TAC (`h`, `h`) THEN 3879 Q.SPEC_TAC (`h1`, `h1`) THEN 3880 Q.SPEC_TAC (`h2`, `h2`) THEN 3881 Q.SPEC_TAC (`fL`, `fL`) THEN 3882 Induct_on `m` THENL [ 3883 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def], 3884 3885 REPEAT GEN_TAC THEN 3886 NTAC 2 STRIP_TAC THEN 3887 `!fL'. 3888 WEAK_SF_SEM___sf_tree_len s h1 fL fL' (SUC m) e1 e2 ==> 3889 WEAK_SF_SEM___sf_tree_len s h2 fL fL' (SUC m) e1 e2 ==> 3890 (h1 = h2)` suffices_by (STRIP_TAC THEN 3891 METIS_TAC[WEAK_SF_SEM___sf_tree_len_THM] 3892 ) THEN 3893 3894 SIMP_TAC std_ss [WEAK_SF_SEM___sf_tree_len_def, PF_SEM_def, 3895 SF_SEM___sf_tree_len_def] THEN 3896 REPEAT STRIP_TAC THEN1 ( 3897 ASM_REWRITE_TAC[] 3898 ) THEN 3899 3900 `hL = hL'` suffices_by (STRIP_TAC THEN 3901 Q.PAT_X_ASSUM `FOLDR FUNION FEMPTY X = Y` MP_TAC THEN 3902 FULL_SIMP_TAC std_ss [SUBMAP_DEF] THEN 3903 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, 3904 DOMSUB_FAPPLY_THM] THEN 3905 METIS_TAC[] 3906 ) THEN 3907 3908 FULL_SIMP_TAC list_ss [] THEN 3909 `?L. MAP (HEAP_READ_ENTRY s h1 e2) fL = L` by METIS_TAC[] THEN 3910 `MAP (HEAP_READ_ENTRY s h2 e2) fL = MAP (HEAP_READ_ENTRY s h1 e2) fL` by ( 3911 Q.PAT_X_ASSUM `h1 SUBMAP h` MP_TAC THEN 3912 Q.PAT_X_ASSUM `h2 SUBMAP h` MP_TAC THEN 3913 Q.PAT_X_ASSUM `X IN FDOM h1` MP_TAC THEN 3914 Q.PAT_X_ASSUM `X IN FDOM h2` MP_TAC THEN 3915 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 3916 3917 REPEAT STRIP_TAC THEN 3918 Induct_on `fL` THENL [ 3919 SIMP_TAC list_ss [], 3920 3921 ASM_SIMP_TAC list_ss [] THEN 3922 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, SUBMAP_DEF] 3923 ] 3924 ) THEN 3925 FULL_SIMP_TAC std_ss [] THEN 3926 `LENGTH L = LENGTH fL` by METIS_TAC[LENGTH_MAP] THEN 3927 REPEAT (Q.PAT_X_ASSUM `MAP (HEAP_READ_ENTRY s H e2) fL = X` (fn thm => ALL_TAC)) THEN 3928 3929 REPEAT (POP_ASSUM MP_TAC) THEN 3930 REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN 3931 3932 Q.SPEC_TAC (`fL`, `fL`) THEN 3933 Q.SPEC_TAC (`hL'`, `hL'`) THEN 3934 Q.SPEC_TAC (`L`, `L`) THEN 3935 Q.SPEC_TAC (`h1`, `h1`) THEN 3936 Q.SPEC_TAC (`h2`, `h2`) THEN 3937 3938 Induct_on `hL` THENL [ 3939 SIMP_TAC list_ss [ALL_DISJOINT_def] THEN 3940 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] THEN 3941 Cases_on `hL'` THEN FULL_SIMP_TAC list_ss [], 3942 3943 3944 REPEAT STRIP_TAC THEN 3945 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] THEN 3946 Cases_on `hL'` THEN FULL_SIMP_TAC list_ss [] THEN 3947 Cases_on `L` THEN FULL_SIMP_TAC list_ss [] THEN 3948 STRIP_TAC THENL [ 3949 Q.PAT_X_ASSUM `!fL h2 h1 h e2. X fL h2 h1 h e2 ==> (h1 = h2)` MATCH_MP_TAC THEN 3950 Q.EXISTS_TAC `fL'` THEN 3951 Q.EXISTS_TAC `h` THEN 3952 Q.EXISTS_TAC `dse_const (THE h''')` THEN 3953 ASM_SIMP_TAC std_ss [] THEN 3954 `(h' SUBMAP h1) /\ h'' SUBMAP h2` suffices_by (STRIP_TAC THEN 3955 METIS_TAC[SUBMAP_TRANS] 3956 ) THEN 3957 REPEAT (Q.PAT_X_ASSUM `FUNION X Y = Z` MP_TAC) THEN 3958 3959 SIMP_TAC std_ss [GSYM fmap_EQ_THM, SUBMAP_DEF, 3960 FDOM_DOMSUB, FUNION_DEF, EXTENSION, IN_UNION, IN_DELETE, 3961 DOMSUB_FAPPLY_THM] THEN 3962 METIS_TAC[], 3963 3964 3965 Q.PAT_X_ASSUM `!h2' h1' L hL'' fL. X h2' h1' L hL'' fL ==> (hL = hL'')` MATCH_MP_TAC THEN 3966 Q.EXISTS_TAC `DRESTRICT h2 (FDOM h2 DIFF FDOM h'')` THEN 3967 Q.EXISTS_TAC `DRESTRICT h1 (FDOM h1 DIFF FDOM h')` THEN 3968 Q.EXISTS_TAC `t''` THEN 3969 Q.EXISTS_TAC `t` THEN 3970 FULL_SIMP_TAC std_ss [ALL_DISJOINT_def] THEN 3971 ASM_REWRITE_TAC[] THEN 3972 REPEAT STRIP_TAC THENL [ 3973 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, IN_INTER, IN_DIFF], 3974 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, IN_INTER, IN_DIFF], 3975 3976 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_DIFF] THEN 3977 CCONTR_TAC THEN 3978 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM (FUNION h' (FOLDR FUNION FEMPTY hL))` by 3979 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 3980 POP_ASSUM MP_TAC THEN 3981 ASM_SIMP_TAC std_ss [] THEN 3982 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE], 3983 3984 3985 `DISJOINT (FDOM (FOLDR FUNION FEMPTY hL)) (FDOM h')` by ( 3986 Q.PAT_X_ASSUM `EVERY X (MAP FDOM hL)` MP_TAC THEN 3987 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 3988 Induct_on `hL` THENL [ 3989 SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY], 3990 ASM_SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY, 3991 FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] 3992 ] 3993 ) THEN 3994 POP_ASSUM MP_TAC THEN 3995 Q.PAT_X_ASSUM `FUNION h' X = Y` MP_TAC THEN 3996 SIMP_TAC std_ss [GSYM fmap_EQ_THM, DRESTRICT_DEF, FDOM_DOMSUB, 3997 FAPPLY_FUPDATE_THM, DOMSUB_FAPPLY_THM, EXTENSION, IN_DELETE, 3998 FUNION_DEF, IN_UNION, IN_INTER, IN_DIFF, DISJOINT_DEF, 3999 NOT_IN_EMPTY] THEN 4000 METIS_TAC[], 4001 4002 4003 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_DIFF] THEN 4004 CCONTR_TAC THEN 4005 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM (FUNION h'' (FOLDR FUNION FEMPTY t'))` by 4006 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 4007 POP_ASSUM MP_TAC THEN 4008 ASM_SIMP_TAC std_ss [] THEN 4009 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE], 4010 4011 4012 `DISJOINT (FDOM (FOLDR FUNION FEMPTY t')) (FDOM h'')` by ( 4013 Q.PAT_X_ASSUM `EVERY X (MAP FDOM t')` MP_TAC THEN 4014 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4015 Induct_on `t'` THENL [ 4016 SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY], 4017 ASM_SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY, 4018 FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] 4019 ] 4020 ) THEN 4021 POP_ASSUM MP_TAC THEN 4022 Q.PAT_X_ASSUM `FUNION h'' X = Y` MP_TAC THEN 4023 SIMP_TAC std_ss [GSYM fmap_EQ_THM, DRESTRICT_DEF, FDOM_DOMSUB, 4024 FAPPLY_FUPDATE_THM, DOMSUB_FAPPLY_THM, EXTENSION, IN_DELETE, 4025 FUNION_DEF, IN_UNION, IN_INTER, IN_DIFF, DISJOINT_DEF, 4026 NOT_IN_EMPTY] THEN 4027 METIS_TAC[] 4028 ] 4029 ] 4030 ] 4031 ]); 4032 4033 4034 4035 4036val SF_IS_PRECISE_THM = store_thm ("SF_IS_PRECISE_THM", 4037 ``!sf. SF_IS_PRECISE sf``, 4038 4039 Induct_on `sf` THENL [ 4040 REWRITE_TAC [SF_IS_PRECISE___sf_emp], 4041 REWRITE_TAC [SF_IS_PRECISE___sf_points_to], 4042 REWRITE_TAC [SF_IS_PRECISE___sf_tree], 4043 ASM_SIMP_TAC std_ss [SF_IS_PRECISE___sf_star] 4044 ]); 4045 4046 4047 4048val SF_IS_SIMPLE___MEM_DS_FLAT_SF = store_thm ("SF_IS_SIMPLE___MEM_DS_FLAT_SF", 4049 ``(!sf e. MEM e (DS_FLAT_SF sf) ==> SF_IS_SIMPLE e) /\ 4050 (!sf. SF_IS_SIMPLE sf ==> (DS_FLAT_SF sf = [sf]))``, 4051 4052 CONJ_TAC THEN ( 4053 Induct_on `sf` THEN 4054 SIMP_TAC list_ss [DS_FLAT_SF_def, SF_IS_SIMPLE_def] THEN 4055 METIS_TAC[] 4056 )); 4057 4058 4059 4060val PF_EXPRESSION_SET_def = Define ` 4061 (PF_EXPRESSION_SET pf_true = {}) /\ 4062 (PF_EXPRESSION_SET (pf_equal e1 e2) = {e1; e2}) /\ 4063 (PF_EXPRESSION_SET (pf_unequal e1 e2) = {e1; e2}) /\ 4064 (PF_EXPRESSION_SET (pf_and pf1 pf2) = 4065 PF_EXPRESSION_SET pf1 UNION PF_EXPRESSION_SET pf2)` 4066 4067val PF_EXPRESSION_SET___FINITE = store_thm ("PF_EXPRESSION_SET___FINITE", 4068 ``!pf. FINITE (PF_EXPRESSION_SET pf)``, 4069 4070 Induct_on `pf` THEN ( 4071 ASM_SIMP_TAC std_ss [PF_EXPRESSION_SET_def, FINITE_EMPTY, FINITE_INSERT, 4072 FINITE_UNION] 4073 )) 4074 4075val SF_EXPRESSION_SET_def = Define ` 4076 (SF_EXPRESSION_SET sf_emp = {}) /\ 4077 (SF_EXPRESSION_SET (sf_points_to e a) = e INSERT LIST_TO_SET (MAP SND a)) /\ 4078 (SF_EXPRESSION_SET (sf_tree fL e1 e2) = {e1; e2}) /\ 4079 (SF_EXPRESSION_SET (sf_star sf1 sf2) = 4080 SF_EXPRESSION_SET sf1 UNION SF_EXPRESSION_SET sf2)` 4081 4082val SF_EXPRESSION_SET___FINITE = store_thm ("SF_EXPRESSION_SET___FINITE", 4083 ``!sf. FINITE (SF_EXPRESSION_SET sf)``, 4084 4085 Induct_on `sf` THEN ( 4086 ASM_SIMP_TAC std_ss [SF_EXPRESSION_SET_def, FINITE_EMPTY, FINITE_INSERT, 4087 FINITE_UNION, FINITE_LIST_TO_SET] 4088 )); 4089 4090 4091 4092 4093val SF_EXPRESSION_SET___MEM_DS_FLAT_SF = store_thm ("SF_EXPRESSION_SET___MEM_DS_FLAT_SF", 4094 ``(!sf e. MEM e (DS_FLAT_SF sf) ==> 4095 SF_EXPRESSION_SET e SUBSET SF_EXPRESSION_SET sf)``, 4096 4097 Induct_on `sf` THEN 4098 SIMP_TAC list_ss [DS_FLAT_SF_def, SF_EXPRESSION_SET_def, SUBSET_EMPTY, SUBSET_REFL] THEN 4099 METIS_TAC[SUBSET_UNION, SUBSET_TRANS] 4100); 4101 4102 4103 4104 4105 4106 4107val SIMPLE_SUB_FORMULA_TO_FRONT = store_thm ("SIMPLE_SUB_FORMULA_TO_FRONT", 4108``!sf sf'. MEM sf' (DS_FLAT_SF sf) ==> 4109 ?sf''. (SF_EQUIV (sf_star sf' sf'') sf /\ 4110 (SF_EXPRESSION_SET sf = SF_EXPRESSION_SET sf' UNION SF_EXPRESSION_SET sf''))``, 4111 4112Induct_on `sf` THENL [ 4113 SIMP_TAC list_ss [DS_FLAT_SF_def], 4114 4115 SIMP_TAC list_ss [DS_FLAT_SF_def] THEN 4116 REPEAT GEN_TAC THEN 4117 Q.EXISTS_TAC `sf_emp` THEN 4118 SIMP_TAC std_ss [SF_SEM___STAR_EMP, SF_EXPRESSION_SET_def, UNION_EMPTY], 4119 4120 SIMP_TAC list_ss [DS_FLAT_SF_def] THEN 4121 REPEAT GEN_TAC THEN 4122 Q.EXISTS_TAC `sf_emp` THEN 4123 SIMP_TAC std_ss [SF_SEM___STAR_EMP, SF_EXPRESSION_SET_def, UNION_EMPTY], 4124 4125 4126 FULL_SIMP_TAC list_ss [SF_EQUIV_def, DS_FLAT_SF_def] THEN 4127 REPEAT STRIP_TAC THENL [ 4128 RES_TAC THEN 4129 Q.EXISTS_TAC `sf_star sf''' sf'` THEN 4130 CONJ_TAC THENL [ 4131 METIS_TAC [SF_STAR_CONG, SF_SEM___STAR_ASSOC, SF_EQUIV_def], 4132 4133 ASM_SIMP_TAC std_ss [SF_EXPRESSION_SET_def, EXTENSION, IN_UNION] THEN 4134 METIS_TAC[] 4135 ], 4136 4137 RES_TAC THEN 4138 Q.EXISTS_TAC `sf_star sf''' sf` THEN 4139 CONJ_TAC THENL [ 4140 METIS_TAC [SF_STAR_CONG, SF_SEM___STAR_ASSOC, SF_EQUIV_def, SF_SEM___STAR_COMM], 4141 4142 ASM_SIMP_TAC std_ss [SF_EXPRESSION_SET_def, EXTENSION, IN_UNION] THEN 4143 METIS_TAC[] 4144 ] 4145 ] 4146]); 4147 4148 4149 4150 4151 4152val DS_POINTS_TO___IN_DISTANCE_def = Define ` 4153 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 0 = (DS_EXPRESSION_EQUAL s e1 e2)) /\ 4154 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 (SUC n) = 4155 ?y f. (DS_POINTS_TO___IN_DISTANCE s h fL e1 y n) /\ 4156 (MEM f fL) /\ 4157 (DS_POINTS_TO s h y [(f, e2)]))` 4158 4159 4160val DS_POINTS_TO___IN_DISTANCE___RIGHT = save_thm ( 4161 "DS_POINTS_TO___IN_DISTANCE___RIGHT", 4162 DS_POINTS_TO___IN_DISTANCE_def); 4163 4164val DS_POINTS_TO___IN_DISTANCE___LEFT = store_thm ( 4165 "DS_POINTS_TO___IN_DISTANCE___LEFT", 4166`` (!s h fL e1 e2. 4167 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 0 = (DS_EXPRESSION_EQUAL s e1 e2))) /\ 4168 4169 (!s h fL e1 e2 n. 4170 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 (SUC n) = 4171 ?y f. (DS_POINTS_TO___IN_DISTANCE s h fL y e2 n) /\ 4172 (MEM f fL) /\ 4173 (DS_POINTS_TO s h e1 [(f, y)])))``, 4174 4175 CONJ_TAC THEN1 ( 4176 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] 4177 ) THEN 4178 Induct_on `n` THENL [ 4179 REWRITE_TAC [DS_POINTS_TO___IN_DISTANCE_def, DS_POINTS_TO_def] THEN 4180 SIMP_TAC list_ss [] THEN 4181 REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ 4182 Q.EXISTS_TAC `e2` THEN 4183 Q.EXISTS_TAC `f` THEN 4184 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def], 4185 4186 Q.EXISTS_TAC `e1` THEN 4187 Q.EXISTS_TAC `f` THEN 4188 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def] 4189 ], 4190 4191 4192 ONCE_REWRITE_TAC [DS_POINTS_TO___IN_DISTANCE_def] THEN 4193 METIS_TAC[] 4194 ]) 4195 4196 4197 4198 4199 4200val DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL = store_thm ("DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL", 4201 ``!s h fL e e1 e2. DS_EXPRESSION_EQUAL s e e1 ==> ( 4202 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 = DS_POINTS_TO___IN_DISTANCE s h fL e e2) /\ 4203 (DS_POINTS_TO___IN_DISTANCE s h fL e2 e1 = DS_POINTS_TO___IN_DISTANCE s h fL e2 e))``, 4204 4205 SIMP_TAC std_ss [FUN_EQ_THM, GSYM FORALL_AND_THM, GSYM RIGHT_FORALL_IMP_THM] THEN 4206 Induct_on `x` THENL [ 4207 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def], 4208 4209 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 4210 REPEAT STRIP_TAC THENL [ 4211 METIS_TAC[], 4212 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EQUAL_def] 4213 ] 4214 ]) 4215 4216val DS_POINTS_TO___IN_DISTANCE___SUBSET = store_thm ("DS_POINTS_TO___IN_DISTANCE___SUBSET", 4217 ``!s h fL1 fL2 e e' n. 4218 (DS_POINTS_TO___IN_DISTANCE s h fL1 e e' n /\ 4219 (!f. MEM f fL1 ==> MEM f fL2)) ==> 4220 (DS_POINTS_TO___IN_DISTANCE s h fL2 e e' n)``, 4221 4222 Induct_on `n` THENL [ 4223 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def], 4224 4225 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 4226 METIS_TAC[] 4227 ]) 4228 4229 4230val DS_POINTS_TO___IN_DISTANCE___SUM_IMPL1 = store_thm ("DS_POINTS_TO___IN_DISTANCE___SUM_IMPL1", 4231 4232 ``!s h fL e e1 e2 n1 n2. 4233 (DS_POINTS_TO___IN_DISTANCE s h fL e e1 n1 /\ 4234 DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 n2) ==> 4235 (DS_POINTS_TO___IN_DISTANCE s h fL e e2 (n1 + n2))``, 4236 4237 Induct_on `n1` THENL [ 4238 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 4239 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL], 4240 4241 REPEAT STRIP_TAC THEN 4242 ONCE_REWRITE_TAC [prove (``(SUC n1) + n2 = n1 + (SUC n2)``, DECIDE_TAC)] THEN 4243 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 4244 REWRITE_TAC[DS_POINTS_TO___IN_DISTANCE___LEFT] THEN 4245 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE___RIGHT] THEN 4246 METIS_TAC[] 4247 ]); 4248 4249 4250val DS_POINTS_TO___IN_DISTANCE___SUM_IMPL2 = store_thm ("DS_POINTS_TO___IN_DISTANCE___SUM_IMPL2", 4251 4252 ``!s h fL e e1 e2 n1 n2. 4253 (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 (n1 + n2)) ==> 4254 ?e. (DS_POINTS_TO___IN_DISTANCE s h fL e1 e n1 /\ 4255 DS_POINTS_TO___IN_DISTANCE s h fL e e2 n2)``, 4256 4257 Induct_on `n1` THENL [ 4258 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 4259 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL, DS_EXPRESSION_EQUAL_def], 4260 4261 REWRITE_TAC [prove (``(SUC n1) + n2 = n1 + (SUC n2)``, DECIDE_TAC)] THEN 4262 REPEAT STRIP_TAC THEN 4263 RES_TAC THEN 4264 REWRITE_TAC[DS_POINTS_TO___IN_DISTANCE___RIGHT] THEN 4265 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE___LEFT] THEN 4266 METIS_TAC[] 4267 ]); 4268 4269 4270val DS_POINTS_TO___IN_DISTANCE___SUBMAP = store_thm ("DS_POINTS_TO___IN_DISTANCE___SUBMAP", 4271 ``!s fL h h' n e1 e2. (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 n /\ 4272 h SUBMAP h') ==> 4273 (DS_POINTS_TO___IN_DISTANCE s h' fL e1 e2 n)``, 4274 4275 Induct_on `n` THENL [ 4276 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def], 4277 4278 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 4279 METIS_TAC[DS_POINTS_TO___SUBMAP] 4280 ]) 4281 4282 4283val DS_POINTS_TO___RTC_def = Define ` 4284 DS_POINTS_TO___RTC s h fL e1 e2 = 4285 (?n. (DS_POINTS_TO___IN_DISTANCE s h fL e1 e2 n))` 4286 4287 4288val DS_POINTS_TO___RTC___SUBMAP = store_thm ("DS_POINTS_TO___RTC___SUBMAP", 4289 ``!h h' s fL e1 e2. (DS_POINTS_TO___RTC s h fL e1 e2 /\ 4290 h SUBMAP h') ==> DS_POINTS_TO___RTC s h' fL e1 e2``, 4291 4292 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 4293 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___SUBMAP]) 4294 4295 4296val DS_POINTS_TO___RTC___SUBSET = store_thm ("DS_POINTS_TO___RTC___SUBSET", 4297 ``!s h fL1 fL2 e e'. 4298 (DS_POINTS_TO___RTC s h fL1 e e' /\ 4299 (!f. MEM f fL1 ==> MEM f fL2)) ==> 4300 (DS_POINTS_TO___RTC s h fL2 e e')``, 4301 4302 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 4303 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___SUBSET]); 4304 4305 4306val DS_POINTS_TO___RTC___is_reflexive = store_thm ("DS_POINTS_TO___RTC___is_reflexive", 4307 ``!s h fL. reflexive (DS_POINTS_TO___RTC s h fL)``, 4308 4309 SIMP_TAC std_ss [reflexive_def, DS_POINTS_TO___RTC_def] THEN 4310 REPEAT GEN_TAC THEN 4311 EXISTS_TAC ``0:num`` THEN 4312 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def] 4313); 4314 4315 4316val DS_POINTS_TO___RTC___is_transitive = store_thm ("DS_POINTS_TO___RTC___is_transitive", 4317 ``!s h fL. transitive (DS_POINTS_TO___RTC s h fL)``, 4318 4319 SIMP_TAC std_ss [transitive_def, DS_POINTS_TO___RTC_def] THEN 4320 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___SUM_IMPL1]); 4321 4322 4323 4324 4325 4326 4327 4328 4329val SF_SEM___sf_tree___ROOT_DANGLES = store_thm ("SF_SEM___sf_tree___ROOT_DANGLES", 4330``!s h fL es e. 4331SF_SEM s h (sf_tree fL es e) /\ DS_POINTER_DANGLES s h e ==> 4332((h = FEMPTY) /\ (DS_EXPRESSION_EQUAL s e es))``, 4333 4334SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 4335REPEAT GEN_TAC THEN STRIP_TAC THEN 4336Cases_on `n` THENL [ 4337 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 4338 4339 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_POINTER_DANGLES] THEN 4340 FULL_SIMP_TAC std_ss [] 4341]) 4342 4343 4344val SF_SEM___sf_ls___ROOT_DANGLES = store_thm ("SF_SEM___sf_ls___ROOT_DANGLES", 4345``!s h f e1 e2. 4346SF_SEM s h (sf_ls f e1 e2) /\ DS_POINTER_DANGLES s h e1 ==> 4347((h = FEMPTY) /\ (DS_EXPRESSION_EQUAL s e1 e2))``, 4348 4349METIS_TAC[sf_ls_def, SF_SEM___sf_tree___ROOT_DANGLES]); 4350 4351 4352 4353 4354val LEMMA_3_1_1 = store_thm ("LEMMA_3_1_1", 4355``!s h fL es e. 4356SF_SEM s h (sf_tree fL es e) ==> DS_POINTER_DANGLES s h es``, 4357 4358SIMP_TAC list_ss [SF_SEM_def, SF_SEM___sf_tree_def, 4359 GSYM LEFT_FORALL_IMP_THM] THEN 4360Induct_on `n` THENL [ 4361 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, DS_POINTER_DANGLES, FDOM_FEMPTY, 4362 NOT_IN_EMPTY], 4363 4364 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def] THEN 4365 REPEAT STRIP_TAC THENL [ 4366 ASM_SIMP_TAC std_ss [DS_POINTER_DANGLES, FDOM_FEMPTY, NOT_IN_EMPTY], 4367 4368 SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 4369 Cases_on `IS_DSV_NIL (DS_EXPRESSION_EVAL s es)` THEN ASM_REWRITE_TAC[] THEN 4370 `!h'. MEM h' hL ==> ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s es) IN FDOM h')` suffices_by (STRIP_TAC THEN 4371 CCONTR_TAC THEN 4372 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s es) IN FDOM (h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))` by ( 4373 FULL_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE, GET_DSV_VALUE_11, DS_EXPRESSION_EQUAL_def, 4374 PF_SEM_def] 4375 ) THEN 4376 POP_ASSUM MP_TAC THEN 4377 Q.PAT_X_ASSUM `FOLDR FUNION FEMPTY hL = X` (fn thm => REWRITE_TAC [GSYM thm]) THEN 4378 Q.PAT_X_ASSUM `!h'. MEM h' hL ==> P h'` MP_TAC THEN 4379 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4380 4381 Induct_on `hL` THENL [ 4382 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 4383 4384 ASM_SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY, DISJ_IMP_THM, FORALL_AND_THM, 4385 FUNION_DEF, IN_UNION] 4386 ] 4387 ) THEN 4388 REPEAT STRIP_TAC THEN 4389 FULL_SIMP_TAC std_ss [EVERY_MEM] THEN 4390 Q.PAT_X_ASSUM `!e'. MEM e' (ZIP L) ==> P e'` MP_TAC THEN 4391 ASM_SIMP_TAC list_ss [MEM_ZIP, GSYM RIGHT_EXISTS_AND_THM, GSYM LEFT_EXISTS_AND_THM] THEN 4392 4393 `?n'. (n' < LENGTH fL) /\ (EL n' hL = h')` by METIS_TAC[LENGTH_MAP, MEM_EL] THEN 4394 Q.EXISTS_TAC `n'` THEN 4395 ASM_SIMP_TAC std_ss [] THEN 4396 REPEAT STRIP_TAC THEN 4397 RES_TAC THEN 4398 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 4399 FULL_SIMP_TAC std_ss [] 4400 ] 4401]); 4402 4403 4404val LEMMA_3_1_1___sf_ls = store_thm ("LEMMA_3_1_1___sf_ls", 4405``!s h f e1 e2. 4406SF_SEM s h (sf_ls f e1 e2) ==> DS_POINTER_DANGLES s h e2``, 4407 4408SIMP_TAC std_ss [sf_ls_def] THEN 4409METIS_TAC[LEMMA_3_1_1]); 4410 4411 4412 4413 4414val LEMMA_3_1_2 = store_thm ("LEMMA_3_1_2", 4415``!s h f fL e1 e2 es e. 4416(SF_SEM s h (sf_tree fL es e) /\ ~(DS_EXPRESSION_EQUAL s es e2) /\ 4417 MEM f fL /\ DS_POINTS_TO s h e1 [(f,e2)]) ==> 4418(~(DS_POINTER_DANGLES s h e2))``, 4419 4420 4421SIMP_TAC std_ss [DS_POINTER_DANGLES, SF_SEM_def, SF_SEM___sf_tree_def, 4422 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 4423 GSYM LEFT_FORALL_IMP_THM] THEN 4424 4425Induct_on `n` THENL [ 4426 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, DS_POINTS_TO_def, FDOM_FEMPTY, 4427 NOT_IN_EMPTY], 4428 4429 4430 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def] THEN 4431 REPEAT GEN_TAC THEN STRIP_TAC THEN1 ( 4432 Q.PAT_X_ASSUM `DS_POINTS_TO s h e1 X` MP_TAC THEN 4433 ASM_REWRITE_TAC [DS_POINTS_TO_def, FDOM_FEMPTY, NOT_IN_EMPTY] 4434 ) THEN 4435 4436 Cases_on `DS_EXPRESSION_EVAL s e2 = DS_EXPRESSION_EVAL s e` THEN1 ( 4437 ASM_SIMP_TAC std_ss [] 4438 ) THEN 4439 4440 Cases_on `DS_EXPRESSION_EVAL s e1 = DS_EXPRESSION_EVAL s e` THEN1 ( 4441 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, EVERY_MEM, MEM_MAP, 4442 GSYM LEFT_FORALL_IMP_THM] THEN 4443 `IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 4444 Cases_on `HEAP_READ_ENTRY s h e f` THEN FULL_SIMP_TAC std_ss [] THEN 4445 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 4446 Q.PAT_X_ASSUM `x = X` (fn thm => ASSUME_TAC (GSYM thm)) THEN 4447 Q.PAT_X_ASSUM `!e'. P e'` MP_TAC THEN 4448 ASM_SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_FORALL_IMP_THM] THEN 4449 SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN 4450 `?n'. (n' < LENGTH fL) /\ (EL n' fL = f)` by METIS_TAC[MEM_EL] THEN 4451 Q.EXISTS_TAC `n'` THEN 4452 ASM_SIMP_TAC std_ss [EL_MAP, HEAP_READ_ENTRY_def] THEN 4453 Cases_on `n` THENL [ 4454 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 4455 DS_EXPRESSION_EVAL_def], 4456 4457 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, 4458 DS_EXPRESSION_EVAL_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 4459 STRIP_TAC THEN 4460 4461 ASM_SIMP_TAC std_ss [] THEN 4462 `(GET_DSV_VALUE x) IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 4463 Q.PAT_X_ASSUM `GET_DSV_VALUE x IN FDOM (EL n' hL)` MP_TAC THEN 4464 `n' < LENGTH hL` by METIS_TAC[] THEN 4465 POP_ASSUM MP_TAC THEN 4466 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4467 Q.SPEC_TAC (`n'`, `n`) THEN 4468 Induct_on `hL` THENL [ 4469 SIMP_TAC list_ss [], 4470 4471 SIMP_TAC list_ss [] THEN 4472 Cases_on `n` THENL [ 4473 SIMP_TAC list_ss [FUNION_DEF, IN_UNION], 4474 ASM_SIMP_TAC list_ss [FUNION_DEF, IN_UNION] THEN 4475 METIS_TAC[] 4476 ] 4477 ] 4478 ) THEN 4479 POP_ASSUM MP_TAC THEN 4480 ASM_REWRITE_TAC[] THEN 4481 SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 4482 ] 4483 ) THEN 4484 4485 `?h'. MEM h' hL /\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM h'` by ( 4486 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM (h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))` by ( 4487 FULL_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE, GET_DSV_VALUE_11, DS_POINTS_TO_def] 4488 ) THEN 4489 POP_ASSUM MP_TAC THEN 4490 Q.PAT_X_ASSUM `FOLDR FUNION FEMPTY hL = X` (fn thm => ASSUME_TAC (GSYM thm)) THEN 4491 ASM_REWRITE_TAC[] THEN 4492 Q.ABBREV_TAC `x = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)` THEN 4493 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4494 4495 Induct_on `hL` THENL [ 4496 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 4497 4498 SIMP_TAC list_ss [FUNION_DEF, IN_UNION] THEN 4499 METIS_TAC[] 4500 ] 4501 ) THEN 4502 4503 `~IS_DSV_NIL (DS_EXPRESSION_EVAL s e2) /\ 4504 GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM h'` suffices_by (STRIP_TAC THEN 4505 ASM_SIMP_TAC std_ss [] THEN 4506 4507 `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2) IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 4508 POP_ASSUM MP_TAC THEN 4509 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 4510 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4511 4512 Induct_on `hL` THENL [ 4513 SIMP_TAC list_ss [], 4514 4515 SIMP_TAC list_ss [FUNION_DEF, IN_UNION] THEN 4516 METIS_TAC[] 4517 ] 4518 ) THEN 4519 POP_ASSUM MP_TAC THEN 4520 ASM_REWRITE_TAC[] THEN 4521 SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 4522 ) THEN 4523 4524 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 4525 Q.EXISTS_TAC `f` THEN 4526 Q.EXISTS_TAC `fL` THEN 4527 Q.EXISTS_TAC `e1` THEN 4528 Q.EXISTS_TAC `es` THEN 4529 ASM_SIMP_TAC std_ss [LEFT_EXISTS_AND_THM] THEN 4530 STRIP_TAC THENL [ 4531 Q.PAT_X_ASSUM `EVERY X Y` MP_TAC THEN 4532 ASM_SIMP_TAC list_ss [EVERY_MEM, MEM_ZIP, GSYM LEFT_FORALL_IMP_THM] THEN 4533 SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN 4534 `?n'. (n' < LENGTH fL) /\ (EL n' hL = h')` by METIS_TAC[MEM_EL, LENGTH_MAP] THEN 4535 Q.EXISTS_TAC `n'` THEN 4536 ASM_SIMP_TAC std_ss [] THEN 4537 METIS_TAC[], 4538 4539 4540 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def] THEN 4541 `h' ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) = 4542 h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))` suffices_by (STRIP_TAC THEN 4543 ASM_REWRITE_TAC[] 4544 ) THEN 4545 Q.PAT_X_ASSUM `FOLDR FUNION FEMPTY hL = X` (fn thm => ASSUME_TAC (GSYM thm)) THEN 4546 4547 `h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) = 4548 (h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))` by ( 4549 ASM_SIMP_TAC std_ss [DOMSUB_FAPPLY_THM, GET_DSV_VALUE_11] 4550 ) THEN 4551 ASM_REWRITE_TAC[] THEN 4552 Q.ABBREV_TAC `x = (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1))` THEN 4553 Q.PAT_X_ASSUM `ALL_DISJOINT (MAP FDOM hL)` MP_TAC THEN 4554 Q.PAT_X_ASSUM `x IN FDOM h'` MP_TAC THEN 4555 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 4556 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4557 4558 Induct_on `hL` THENL [ 4559 SIMP_TAC list_ss [], 4560 4561 SIMP_TAC list_ss [ALL_DISJOINT_def, FUNION_DEF] THEN 4562 REPEAT STRIP_TAC THENL [ 4563 FULL_SIMP_TAC std_ss [] THEN 4564 METIS_TAC[], 4565 4566 FULL_SIMP_TAC std_ss [COND_RATOR, COND_RAND] THEN 4567 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 4568 `DISJOINT (FDOM h) (FDOM h')` by METIS_TAC[] THEN 4569 FULL_SIMP_TAC std_ss [DISJOINT_DEF, NOT_IN_EMPTY, IN_INTER, EXTENSION] THEN 4570 METIS_TAC[] 4571 ] 4572 ] 4573 ] 4574]); 4575 4576 4577val LEMMA_3_1_2___list = store_thm ("LEMMA_3_1_2___list", 4578``!s h f e1 e2 e3 e4. 4579(SF_SEM s h (sf_ls f e1 e2) /\ ~(DS_EXPRESSION_EQUAL s e2 e4) /\ 4580 DS_POINTS_TO s h e3 [f, e4]) ==> 4581(~(DS_POINTER_DANGLES s h e4))``, 4582 4583SIMP_TAC std_ss [sf_ls_def] THEN 4584METIS_TAC[LEMMA_3_1_2, DS_EXPRESSION_EQUAL_def, MEM]) 4585 4586 4587 4588val LEMMA_3_1_2_a = store_thm ("LEMMA_3_1_2_a", 4589``!s h f fL v es e f. 4590(SF_SEM s h (sf_tree fL es e) /\ 4591(v IN FDOM h) /\ MEM f fL) ==> 4592f IN FDOM (h ' v)``, 4593 4594SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, 4595 GSYM LEFT_EXISTS_AND_THM, GSYM LEFT_FORALL_IMP_THM] THEN 4596Induct_on `n` THENL [ 4597 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, FDOM_FEMPTY, NOT_IN_EMPTY], 4598 4599 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 4600 REPEAT STRIP_TAC THEN1 ( 4601 METIS_TAC[FDOM_FEMPTY, NOT_IN_EMPTY] 4602 ) THEN 4603 Cases_on `DS_EXPRESSION_EVAL s e = (dsv_const v)` THENL [ 4604 RES_TAC THEN 4605 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 4606 Q.PAT_X_ASSUM `f IN FDOM X` MP_TAC THEN 4607 ASM_REWRITE_TAC[] THEN 4608 REWRITE_TAC[GET_DSV_VALUE_def], 4609 4610 `?h'. MEM h' hL /\ v IN FDOM h'` by METIS_TAC[] THEN 4611 `f IN FDOM (h' ' v)` by METIS_TAC[MEM_EL] THEN 4612 METIS_TAC[SUBMAP_DEF] 4613 ] 4614]); 4615 4616 4617val LEMMA_25 = store_thm ("LEMMA_25", 4618 ``!s h1 h2 f e1 e2 e3. 4619 (DISJOINT (FDOM h1) (FDOM h2) /\ 4620 SF_SEM s h1 (sf_ls f e1 e2) /\ 4621 (DS_POINTER_DANGLES s h1 e3) /\ 4622 SF_SEM s h2 (sf_ls f e2 e3)) ==> 4623 SF_SEM s (FUNION h1 h2) (sf_ls f e1 e3)``, 4624 4625SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_len_def, sf_ls_def, 4626 SF_SEM___sf_tree_def, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 4627 GSYM LEFT_FORALL_IMP_THM] THEN 4628Induct_on `n` THENL [ 4629 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, 4630 FUNION_FEMPTY_1] THEN 4631 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def], 4632 4633 4634 REPEAT STRIP_TAC THEN 4635 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def] THEN1 ( 4636 FULL_SIMP_TAC std_ss [PF_SEM_def, FUNION_FEMPTY_1] THEN 4637 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def] 4638 ) THEN 4639 4640 4641 `?h1'. hL = [h1']` by ( 4642 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [LENGTH_NIL] 4643 ) THEN 4644 FULL_SIMP_TAC list_ss [FUNION_FEMPTY_2, ALL_DISJOINT_def] THEN 4645 Q.PAT_X_ASSUM `IS_SOME (HEAP_READ_ENTRY s h1 e1 f)` ASSUME_TAC THEN 4646 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, HEAP_READ_ENTRY_def, PF_SEM_def] THEN 4647 4648 `?c. DS_EXPRESSION_EVAL s e1 = dsv_const c` by ( 4649 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 4650 ) THEN 4651 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, ds_value_11] THEN 4652 4653 `?n. SF_SEM___sf_tree_len s (FUNION h1' h2) [f] n e3 (dse_const (h1 ' c ' f))` by ( 4654 Q.PAT_X_ASSUM `! s h1 h2. P s h1 h2` MATCH_MP_TAC THEN 4655 Q.EXISTS_TAC `e2` THEN 4656 Q.EXISTS_TAC `n'` THEN 4657 4658 ASM_SIMP_TAC std_ss [] THEN 4659 CONJ_TAC THENL [ 4660 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 4661 FDOM_DOMSUB, IN_DELETE] THEN 4662 METIS_TAC[], 4663 4664 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, FDOM_DOMSUB, IN_DELETE] 4665 ] 4666 ) THEN 4667 4668 Q.EXISTS_TAC `SUC n''` THEN 4669 ASM_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, GET_DSV_VALUE_def, FDOM_FUNION, 4670 IN_UNION] THEN 4671 `~(DS_EXPRESSION_EQUAL s e1 e3)` by ( 4672 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_POINTER_DANGLES, IS_DSV_NIL_THM] THEN 4673 METIS_TAC[GET_DSV_VALUE_def] 4674 ) THEN 4675 ASM_SIMP_TAC std_ss [] THEN 4676 Q.EXISTS_TAC `[FUNION h1' h2]` THEN 4677 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, HEAP_READ_ENTRY_THM, 4678 GET_DSV_VALUE_def, FUNION_DEF, IN_UNION, FUNION_FEMPTY_2, HEAP_READ_ENTRY_def, 4679 DOMSUB_FUNION] THEN 4680 4681 `h2 \\ c = h2` by ( 4682 `~(c IN FDOM h2)` by ( 4683 FULL_SIMP_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY] THEN 4684 METIS_TAC[] 4685 ) THEN 4686 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FDOM_DOMSUB, 4687 IN_DELETE, DOMSUB_FAPPLY_NEQ] THEN 4688 METIS_TAC[] 4689 ) THEN 4690 METIS_TAC[] 4691]); 4692 4693 4694 4695val LEMMA_26 = store_thm ("LEMMA_26", 4696 ``!s h fL es e. (~(DS_EXPRESSION_EQUAL s e es) /\ 4697 (SF_SEM s h (sf_tree fL es e))) ==> 4698 (!f. MEM f fL ==> ?e'. DS_POINTS_TO s h e' [(f, es)])``, 4699 4700 4701 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM RIGHT_EXISTS_AND_THM, 4702 GSYM LEFT_FORALL_IMP_THM] THEN 4703 Induct_on `n` THEN1 ( 4704 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 4705 METIS_TAC[] 4706 ) THEN 4707 4708 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 4709 REPEAT STRIP_TAC THEN 4710 `?h'. MEM (HEAP_READ_ENTRY s h e f, h') (ZIP (MAP (HEAP_READ_ENTRY s h e) fL,hL))` by ( 4711 FULL_SIMP_TAC list_ss [MEM_ZIP, MEM_EL] THEN 4712 Q.EXISTS_TAC `n'` THEN 4713 ASM_SIMP_TAC std_ss [EL_MAP] 4714 ) THEN 4715 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 4716 RES_TAC THEN 4717 FULL_SIMP_TAC std_ss [] THEN 4718 Cases_on `~DS_EXPRESSION_EQUAL s (dse_const (THE (HEAP_READ_ENTRY s h e f))) es` THENL [ 4719 `?e'. DS_POINTS_TO s h' e' [(f,es)]` by METIS_TAC[] THEN 4720 Q.EXISTS_TAC `e'` THEN 4721 4722 `h' SUBMAP h` by ( 4723 `MEM h' hL` by ( 4724 Q.PAT_X_ASSUM `MEM X (ZIP Y)` MP_TAC THEN 4725 ASM_SIMP_TAC list_ss [MEM_ZIP] THEN 4726 METIS_TAC[MEM_EL, LENGTH_MAP] 4727 ) THEN 4728 POP_ASSUM MP_TAC THEN 4729 Q.PAT_X_ASSUM `X = h \\ Y` MP_TAC THEN 4730 Q.PAT_X_ASSUM `ALL_DISJOINT X` MP_TAC THEN 4731 4732 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 4733 REPEAT STRIP_TAC THEN 4734 `h' SUBMAP h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)` suffices_by (STRIP_TAC THEN 4735 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FDOM_DOMSUB, DOMSUB_FAPPLY_THM, IN_DELETE] 4736 ) THEN 4737 Q.PAT_X_ASSUM `X = h \\ Y` (fn thm => ASM_REWRITE_TAC [GSYM thm]) THEN 4738 4739 Induct_on `hL` THENL [ 4740 SIMP_TAC list_ss [], 4741 4742 FULL_SIMP_TAC list_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, 4743 DISJ_IMP_THM, ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, 4744 GSYM RIGHT_EXISTS_AND_THM, GSYM LEFT_FORALL_IMP_THM] THEN 4745 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 4746 METIS_TAC[] 4747 ] 4748 ) THEN 4749 4750 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, SUBMAP_DEF] THEN 4751 METIS_TAC[], 4752 4753 4754 4755 Q.EXISTS_TAC `e` THEN 4756 POP_ASSUM MP_TAC THEN 4757 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 4758 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, HEAP_READ_ENTRY_def, 4759 DS_EXPRESSION_EVAL_def, DS_POINTS_TO_def] 4760 ] 4761); 4762 4763 4764 4765val LEMMA_26a = store_thm ("LEMMA_26a", 4766 ``!s h fL es e e'. (~(DS_EXPRESSION_EQUAL s e e') /\ 4767 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e')) /\ 4768 (DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h) /\ 4769 (SF_SEM s h (sf_tree fL es e))) ==> 4770 (?e'' f. MEM f fL /\ DS_POINTS_TO s h e'' [(f, e')])``, 4771 4772 4773 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM RIGHT_EXISTS_AND_THM, 4774 GSYM LEFT_FORALL_IMP_THM] THEN 4775 Induct_on `n` THEN1 ( 4776 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY] 4777 ) THEN 4778 4779 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 4780 REPEAT STRIP_TAC THEN1 ( 4781 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 4782 ) THEN 4783 4784 4785 `?h'. MEM h' hL /\ DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h'` by ( 4786 `~(dsv_const (DS_EXPRESSION_EVAL_VALUE s e') = DS_EXPRESSION_EVAL s e)` suffices_by (STRIP_TAC THEN 4787 METIS_TAC[] 4788 ) THEN 4789 Cases_on `DS_EXPRESSION_EVAL s e'` THEN FULL_SIMP_TAC list_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def, 4790 DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_VALUE_def] 4791 ) THEN 4792 4793 `?n. (n < LENGTH hL) /\ (EL n hL = h')` by METIS_TAC[MEM_EL] THEN 4794 `?f. (EL n' fL = f) /\ (MEM f fL)` by METIS_TAC[MEM_EL] THEN 4795 `IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 4796 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 4797 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 4798 Cases_on `DS_EXPRESSION_EVAL s e' = (h ' v ' f)` THEN1 ( 4799 Q.EXISTS_TAC `e` THEN 4800 Q.EXISTS_TAC `f` THEN 4801 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, IS_DSV_NIL_def] 4802 ) THEN 4803 4804 `?e'' f. MEM f fL /\ DS_POINTS_TO s h' e'' [(f,e')]` suffices_by (STRIP_TAC THEN 4805 METIS_TAC[DS_POINTS_TO___SUBMAP] 4806 ) THEN 4807 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 4808 Q.EXISTS_TAC `es` THEN 4809 Q.EXISTS_TAC `dse_const (h ' v ' f)` THEN 4810 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 4811 METIS_TAC[] 4812); 4813 4814 4815val LEMMA_26b = store_thm ("LEMMA_26b", 4816 ``!s h fL es e e' f. (~(DS_EXPRESSION_EQUAL s es e') /\ 4817 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e')) /\ 4818 (DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h) /\ 4819 (SF_SEM s h (sf_tree fL es e)) /\ MEM f fL) ==> 4820 ?e''. DS_POINTS_TO s h e' [(f, e'')]``, 4821 4822 4823 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM RIGHT_EXISTS_AND_THM, 4824 GSYM LEFT_FORALL_IMP_THM, GSYM LEFT_EXISTS_AND_THM] THEN 4825 Induct_on `n` THEN1 ( 4826 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY] 4827 ) THEN 4828 4829 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 4830 REPEAT STRIP_TAC THEN1 ( 4831 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 4832 ) THEN 4833 4834 4835 Cases_on `DS_EXPRESSION_EVAL s e' = DS_EXPRESSION_EVAL s e` THEN1 ( 4836 `IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 4837 POP_ASSUM MP_TAC THEN 4838 SIMP_TAC list_ss [DS_POINTS_TO_def, HEAP_READ_ENTRY_THM] THEN 4839 ASM_SIMP_TAC std_ss [] THEN 4840 METIS_TAC[DS_EXPRESSION_EVAL_def] 4841 ) THEN 4842 `?h'. MEM h' hL /\ DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h'` by ( 4843 `~(dsv_const (DS_EXPRESSION_EVAL_VALUE s e') = DS_EXPRESSION_EVAL s e)` suffices_by (STRIP_TAC THEN 4844 METIS_TAC[] 4845 ) THEN 4846 FULL_SIMP_TAC list_ss [GET_DSV_VALUE_def, 4847 DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_VALUE_def, 4848 NOT_IS_DSV_NIL_THM] THEN 4849 METIS_TAC[] 4850 ) THEN 4851 4852 `?n. (n < LENGTH hL) /\ (EL n hL = h')` by METIS_TAC[MEM_EL] THEN 4853 `IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 4854 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, DS_EXPRESSION_EVAL_VALUE_def, NOT_IS_DSV_NIL_THM] THEN 4855 Q.PAT_X_ASSUM `DS_EXPRESSION_EVAL s e = Y` ASSUME_TAC THEN 4856 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def] THEN 4857 `?e''. DS_POINTS_TO s h' e' [(f,e'')]` suffices_by (STRIP_TAC THEN 4858 METIS_TAC[DS_POINTS_TO___SUBMAP] 4859 ) THEN 4860 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 4861 Q.EXISTS_TAC `fL` THEN 4862 Q.EXISTS_TAC `es` THEN 4863 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 4864 ds_value_11] THEN 4865 METIS_TAC[] 4866); 4867 4868 4869 4870val LEMMA_26c = store_thm ("LEMMA_26c", 4871 ``!s h fL es e e' e'' f. 4872 (~(DS_EXPRESSION_EQUAL s es e') /\ 4873 MEM f fL /\ 4874 DS_POINTS_TO s h e'' [(f, e')] /\ 4875 SF_SEM s h (sf_tree fL es e)) ==> 4876 4877 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e')) /\ 4878 (DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h)``, 4879 4880 SIMP_TAC list_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM RIGHT_EXISTS_AND_THM, 4881 GSYM LEFT_FORALL_IMP_THM, DS_POINTS_TO_def] THEN 4882 Induct_on `n` THEN1 ( 4883 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY] 4884 ) THEN 4885 4886 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 4887 REPEAT GEN_TAC THEN STRIP_TAC THEN1 ( 4888 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 4889 ) THEN 4890 4891 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 4892 Cases_on `DS_EXPRESSION_EVAL s e''` THEN FULL_SIMP_TAC list_ss [IS_DSV_NIL_def] THEN 4893 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def] THEN 4894 Cases_on `DS_EXPRESSION_EVAL s e = DS_EXPRESSION_EVAL s e''` THEN1 ( 4895 `?n h'. (n < LENGTH hL) /\ (EL n fL = f) /\ (EL n hL = h') /\ MEM h' hL` by METIS_TAC[MEM_EL] THEN 4896 `SF_SEM___sf_tree_len s h' fL n es (dse_const (h ' v ' f))` by METIS_TAC[GET_DSV_VALUE_def] THEN 4897 Cases_on `n` THENL [ 4898 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 4899 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def], 4900 4901 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 4902 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] THENL [ 4903 4904 METIS_TAC[], 4905 4906 `h' SUBMAP h` by METIS_TAC[] THEN 4907 FULL_SIMP_TAC std_ss [SUBMAP_DEF] 4908 ] 4909 ] 4910 ) THEN 4911 `?h'. MEM h' hL /\ v IN FDOM h'` by METIS_TAC[] THEN 4912 `h' SUBMAP h` by METIS_TAC[] THEN 4913 4914 `~IS_DSV_NIL (h' ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e'')) ' f) /\ GET_DSV_VALUE (h' ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e'')) ' f) IN FDOM h'` suffices_by (STRIP_TAC THEN 4915 `h ' v = h' ' v` by FULL_SIMP_TAC std_ss [SUBMAP_DEF] THEN 4916 Q.PAT_X_ASSUM `X = dsv_const v` ASSUME_TAC THEN 4917 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] THEN 4918 METIS_TAC [SUBMAP_DEF] 4919 ) THEN 4920 4921 `?n f. (n < LENGTH hL) /\ (EL n fL = f) /\ (EL n hL = h') /\ MEM f fL` by METIS_TAC[MEM_EL] THEN 4922 4923 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 4924 Q.EXISTS_TAC `fL` THEN 4925 Q.EXISTS_TAC `es` THEN 4926 Q.EXISTS_TAC `dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f')` THEN 4927 Q.EXISTS_TAC `dse_const (h' ' v ' f)` THEN 4928 4929 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, IS_DSV_NIL_def, DS_EXPRESSION_EVAL_def, 4930 DS_EXPRESSION_EQUAL_def] THEN 4931 REPEAT CONJ_TAC THENL [ 4932 METIS_TAC[SUBMAP_DEF], 4933 METIS_TAC[SUBMAP_DEF], 4934 METIS_TAC[] 4935 ] 4936); 4937 4938 4939 4940 4941val LEMMA_26d = store_thm ("LEMMA_26d", 4942 ``!s h fL es e e' m1 m2. (~(DS_EXPRESSION_EQUAL s es e') /\ 4943 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e')) /\ 4944 (DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h) /\ 4945 (SF_SEM s h (sf_tree fL es e)) /\ 4946 (m1 < LENGTH fL) /\ (m2 < LENGTH fL) /\ 4947 ~(m1 = m2)) ==> 4948 ?e1 e2. DS_POINTS_TO s h e' [(EL m1 fL, e1); (EL m2 fL, e2)] /\ 4949 ((DS_EXPRESSION_EQUAL s e1 es /\ 4950 DS_EXPRESSION_EQUAL s e2 es) \/ 4951 ~(DS_EXPRESSION_EQUAL s e1 e2))``, 4952 4953 4954 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM RIGHT_EXISTS_AND_THM, 4955 GSYM LEFT_FORALL_IMP_THM, GSYM LEFT_EXISTS_AND_THM] THEN 4956 Induct_on `n` THEN1 ( 4957 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY] 4958 ) THEN 4959 4960 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 4961 REPEAT STRIP_TAC THEN1 ( 4962 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 4963 ) THEN 4964 4965 4966 Cases_on `DS_EXPRESSION_EVAL s e' = DS_EXPRESSION_EVAL s e` THEN1 ( 4967 `IS_SOME (HEAP_READ_ENTRY s h e (EL m1 fL))` by METIS_TAC[MEM_EL] THEN 4968 `IS_SOME (HEAP_READ_ENTRY s h e (EL m2 fL))` by METIS_TAC[MEM_EL] THEN 4969 NTAC 2 (POP_ASSUM MP_TAC) THEN 4970 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, HEAP_READ_ENTRY_THM] THEN 4971 REPEAT STRIP_TAC THEN 4972 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 4973 Q.EXISTS_TAC `dse_const (h ' v ' (EL m1 fL))` THEN 4974 Q.EXISTS_TAC `dse_const (h ' v ' (EL m2 fL))` THEN 4975 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def] THEN 4976 MATCH_MP_TAC (prove (``(b ==> a) ==> (a \/ ~b)``, METIS_TAC[])) THEN 4977 SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 4978 STRIP_TAC THEN 4979 CCONTR_TAC THEN 4980 `SF_SEM___sf_tree_len s (EL m1 hL) fL n es (dse_const (h ' v ' (EL m1 fL))) /\ 4981 SF_SEM___sf_tree_len s (EL m2 hL) fL n es (dse_const (h ' v ' (EL m2 fL)))` by METIS_TAC[] THEN 4982 NTAC 2 (POP_ASSUM MP_TAC) THEN 4983 Cases_on `n` THENL [ 4984 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 4985 DS_EXPRESSION_EVAL_def] THEN 4986 ASM_SIMP_TAC std_ss [], 4987 4988 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 4989 DS_EXPRESSION_EVAL_def, AND_IMP_INTRO] THEN 4990 ASM_SIMP_TAC list_ss [] THEN 4991 `~(GET_DSV_VALUE (h ' v ' (EL m2 fL)) IN FDOM (EL m1 hL)) \/ 4992 ~(GET_DSV_VALUE (h ' v ' (EL m2 fL)) IN FDOM (EL m2 hL))` suffices_by (STRIP_TAC THEN 4993 METIS_TAC[] 4994 ) THEN 4995 FULL_SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP] THEN 4996 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 4997 METIS_TAC[] 4998 ] 4999 ) THEN 5000 `?h'. MEM h' hL /\ DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h'` by ( 5001 `~(dsv_const (DS_EXPRESSION_EVAL_VALUE s e') = DS_EXPRESSION_EVAL s e)` suffices_by (STRIP_TAC THEN 5002 METIS_TAC[] 5003 ) THEN 5004 FULL_SIMP_TAC list_ss [GET_DSV_VALUE_def, 5005 DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_VALUE_def, 5006 NOT_IS_DSV_NIL_THM] THEN 5007 METIS_TAC[] 5008 ) THEN 5009 5010 `?n. (n < LENGTH hL) /\ (EL n hL = h')` by METIS_TAC[MEM_EL] THEN 5011 Tactical.REVERSE (sg `?e1 e2. 5012 DS_POINTS_TO s h' e' [(EL m1 fL,e1); (EL m2 fL,e2)] /\ 5013 (DS_EXPRESSION_EQUAL s e1 es /\ DS_EXPRESSION_EQUAL s e2 es \/ 5014 ~DS_EXPRESSION_EQUAL s e1 e2)`) THENL [ 5015 METIS_TAC[DS_POINTS_TO___SUBMAP], 5016 METIS_TAC[DS_POINTS_TO___SUBMAP], 5017 ALL_TAC 5018 ] THEN 5019 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 5020 METIS_TAC[] 5021); 5022 5023 5024 5025val SF_EXPRESSION_SET___FDOM_HEAP = store_thm ("SF_EXPRESSION_SET___FDOM_HEAP", 5026`` !s h sf x. (SF_SEM s h sf /\ (x IN FDOM h)) ==> 5027 ((?e. (e IN SF_EXPRESSION_SET sf) /\ (DS_EXPRESSION_EVAL s e = dsv_const x)) \/ 5028 (?x' f. (x' IN FDOM h) /\ (f IN FDOM (h ' x')) /\ 5029 (h ' x' ' f = dsv_const x)))``, 5030 5031Induct_on `sf` THENL [ 5032 SIMP_TAC std_ss [SF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY], 5033 5034 5035 SIMP_TAC std_ss [SF_SEM_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, NOT_IS_DSV_NIL_THM, 5036 SF_EXPRESSION_SET_def, IN_INSERT, NOT_IN_EMPTY] THEN 5037 REPEAT STRIP_TAC THEN 5038 DISJ1_TAC THEN 5039 Q.EXISTS_TAC `d` THEN 5040 Q.PAT_X_ASSUM `x IN FDOM h` MP_TAC THEN 5041 ASM_SIMP_TAC std_ss [IN_SING, GET_DSV_VALUE_def], 5042 5043 REPEAT STRIP_TAC THEN 5044 Cases_on `DS_EXPRESSION_EVAL s d0 = dsv_const x` THEN1 ( 5045 SIMP_TAC std_ss [SF_EXPRESSION_SET_def, IN_INSERT, NOT_IN_EMPTY] THEN 5046 METIS_TAC[] 5047 ) THEN 5048 DISJ2_TAC THEN 5049 MP_TAC (Q.SPECL [`s`, `h`, `l`, `d`, `d0`, `dse_const (dsv_const x)`] LEMMA_26a) THEN 5050 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 5051 IS_DSV_NIL_def, DS_EXPRESSION_EVAL_VALUE_def, DS_POINTS_TO_def, NOT_IS_DSV_NIL_THM] THEN 5052 METIS_TAC[GET_DSV_VALUE_def], 5053 5054 5055 SIMP_TAC std_ss [SF_SEM_def, GSYM LEFT_FORALL_IMP_THM, GSYM RIGHT_EXISTS_AND_THM, 5056 GSYM LEFT_EXISTS_AND_THM, FUNION_DEF, SF_EXPRESSION_SET_def, IN_UNION, DISJOINT_DEF, 5057 EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 5058 METIS_TAC[] 5059]) 5060 5061 5062 5063val LEMMA_27 = store_thm ("LEMMA_27", 5064``!s h f e1 e2 e3. 5065 (SF_SEM s h (sf_ls f e1 e3) /\ 5066 ~(DS_POINTER_DANGLES s h e2)) ==> 5067 SF_SEM s h (sf_star (sf_ls f e1 e2) (sf_ls f e2 e3))``, 5068 5069SIMP_TAC std_ss [SF_SEM_def, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 5070 GSYM LEFT_FORALL_IMP_THM, sf_ls_def, SF_SEM___sf_tree_def] THEN 5071 5072Induct_on `n` THENL [ 5073 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, DS_POINTER_DANGLES, 5074 FDOM_FEMPTY, NOT_IN_EMPTY], 5075 5076 REPEAT GEN_TAC THEN 5077 Cases_on `DS_EXPRESSION_EQUAL s e1 e2` THEN1 ( 5078 REPEAT STRIP_TAC THEN 5079 Q.EXISTS_TAC `FEMPTY` THEN 5080 Q.EXISTS_TAC `h` THEN 5081 Q.EXISTS_TAC `0` THEN 5082 Q.EXISTS_TAC `SUC n` THEN 5083 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 5084 CONJ_TAC THENL [ 5085 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 5086 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def] 5087 ] 5088 ) THEN 5089 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 5090 STRIP_TAC THEN1 ( 5091 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 5092 METIS_TAC[FDOM_FEMPTY, NOT_IN_EMPTY] 5093 ) THEN 5094 `?h'. hL = [h']` by ( 5095 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [LENGTH_NIL] 5096 ) THEN 5097 FULL_SIMP_TAC list_ss [] THEN 5098 Q.PAT_X_ASSUM `IS_SOME Y` ASSUME_TAC THEN 5099 `?c. DS_EXPRESSION_EVAL s e1 = dsv_const c` by ( 5100 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 5101 ) THEN 5102 FULL_SIMP_TAC list_ss [GET_DSV_VALUE_def, FUNION_FEMPTY_2, IS_DSV_NIL_def, ALL_DISJOINT_def, 5103 HEAP_READ_ENTRY_THM, HEAP_READ_ENTRY_def] THEN 5104 `~(DS_POINTER_DANGLES s h' e2)` by ( 5105 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def, FDOM_DOMSUB, IN_DELETE] THEN 5106 METIS_TAC[GET_DSV_VALUE_def, NOT_IS_DSV_NIL_THM] 5107 ) THEN 5108 Q.PAT_X_ASSUM `!s h f e1 e2 e3. P s h f e1 e2 e3` (fn thm => MP_TAC ( 5109 Q.SPECL [`s`, `h'`, `f`, `dse_const ((h:('b, 'c) heap) ' c ' f)`, `e2`, `e3`] thm)) THEN 5110 ASM_SIMP_TAC std_ss [] THEN 5111 STRIP_TAC THEN 5112 Q.EXISTS_TAC `FUNION (DRESTRICT h {c}) h1` THEN 5113 Q.EXISTS_TAC `h2` THEN 5114 Q.EXISTS_TAC `SUC n'` THEN 5115 Q.EXISTS_TAC `n''` THEN 5116 ASM_SIMP_TAC std_ss [] THEN 5117 REPEAT STRIP_TAC THENL [ 5118 SIMP_TAC std_ss [GSYM FUNION___ASSOC] THEN 5119 Q.PAT_X_ASSUM `h \\ c = Y` (fn thm => REWRITE_TAC [GSYM thm]) THEN 5120 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, DRESTRICT_DEF, 5121 EXTENSION, IN_INTER, IN_SING, IN_UNION, IN_DELETE, FDOM_DOMSUB, 5122 DOMSUB_FAPPLY_THM] THEN 5123 METIS_TAC[], 5124 5125 5126 ASM_SIMP_TAC std_ss [FUNION_DEF, DISJOINT_UNION_BOTH] THEN 5127 `~(c IN FDOM h2)` by ( 5128 CCONTR_TAC THEN 5129 `c IN FDOM (h \\ c)` by FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 5130 FULL_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 5131 ) THEN 5132 FULL_SIMP_TAC std_ss [DISJOINT_DEF, IN_INTER, EXTENSION, NOT_IN_EMPTY, 5133 DRESTRICT_DEF, IN_SING], 5134 5135 5136 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 5137 Q.EXISTS_TAC `[h1]` THEN 5138 ASM_SIMP_TAC list_ss [DRESTRICT_DEF, FUNION_DEF, IN_UNION, IN_INTER, IN_SING, HEAP_READ_ENTRY_def, 5139 GET_DSV_VALUE_def, IS_DSV_NIL_def, ALL_DISJOINT_def, FUNION_FEMPTY_2] THEN 5140 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, 5141 FUNION_DEF, DRESTRICT_DEF, IN_UNION, IN_INTER, IN_SING, DOMSUB_FAPPLY_THM] THEN 5142 `~(c IN FDOM h1)` by ( 5143 CCONTR_TAC THEN 5144 `c IN FDOM (h \\ c)` by FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 5145 FULL_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 5146 ) THEN 5147 METIS_TAC[] 5148 ] 5149]); 5150 5151 5152 5153 5154 5155val LEMMA_28_1 = store_thm ("LEMMA_28_1", 5156 ``!s h fL es e. SF_SEM s h (sf_tree fL es e) ==> 5157 !e f. MEM f fL ==> ~(DS_POINTS_TO s h e [(f, e)])``, 5158 5159 SIMP_TAC std_ss [SF_SEM_def, GSYM LEFT_FORALL_IMP_THM, 5160 SF_SEM___sf_tree_def] THEN 5161 Induct_on `n` THENL [ 5162 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, DS_POINTS_TO_def, 5163 FDOM_FEMPTY, NOT_IN_EMPTY], 5164 5165 5166 5167 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def] THEN 5168 REPEAT GEN_TAC THEN STRIP_TAC THEN1 ( 5169 FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, FDOM_FEMPTY, NOT_IN_EMPTY] 5170 ) THEN 5171 5172 REPEAT STRIP_TAC THEN 5173 Cases_on `DS_EXPRESSION_EVAL s e' = DS_EXPRESSION_EVAL s e` THENL [ 5174 `?h'. MEM (HEAP_READ_ENTRY s h e f, h') (ZIP (MAP (HEAP_READ_ENTRY s h e) fL,hL))` by ( 5175 FULL_SIMP_TAC list_ss [MEM_ZIP, MEM_EL] THEN 5176 Q.EXISTS_TAC `n'` THEN 5177 ASM_SIMP_TAC std_ss [EL_MAP] 5178 ) THEN 5179 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 5180 HEAP_READ_ENTRY_THM] THEN 5181 RES_TAC THEN 5182 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 5183 5184 `DS_EXPRESSION_EQUAL s e (dse_const (THE (HEAP_READ_ENTRY s h e f)))` by ( 5185 FULL_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, HEAP_READ_ENTRY_def, 5186 DS_EXPRESSION_EVAL_def, DS_POINTS_TO_def] THEN 5187 METIS_TAC[] 5188 ) THEN 5189 5190 `SF_SEM___sf_tree_len s h' fL n es e` by METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, 5191 DS_EXPRESSION_EQUAL_def] THEN 5192 `SF_SEM___sf_tree_len s h' fL (SUC n) es e` by 5193 METIS_TAC[prove(``n <= SUC n``, DECIDE_TAC), SF_SEM___sf_tree_len_THM] THEN 5194 `SF_SEM___sf_tree_len s h fL (SUC n) es e` by ( 5195 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, EVERY_MEM, 5196 MEM_MAP, GSYM LEFT_FORALL_IMP_THM, HEAP_READ_ENTRY_THM] THEN 5197 METIS_TAC[] 5198 ) THEN 5199 5200 `(h' SUBMAP h) /\ ~(h' = h)` by ( 5201 `MEM h' hL` by ( 5202 Q.PAT_X_ASSUM `MEM X (ZIP Y)` MP_TAC THEN 5203 ASM_SIMP_TAC list_ss [MEM_ZIP] THEN 5204 METIS_TAC[MEM_EL, LENGTH_MAP] 5205 ) THEN 5206 POP_ASSUM MP_TAC THEN 5207 Q.PAT_X_ASSUM `X = h \\ Z` (fn thm=>MP_TAC (GSYM thm)) THEN 5208 Q.ABBREV_TAC `x = GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)` THEN 5209 Q.PAT_X_ASSUM `ALL_DISJOINT X` MP_TAC THEN 5210 Q.PAT_X_ASSUM `x IN FDOM h` MP_TAC THEN 5211 REPEAT (POP_ASSUM (fn thm=> ALL_TAC)) THEN 5212 5213 NTAC 4 STRIP_TAC THEN 5214 `h' SUBMAP h \\ x` by ( 5215 ASM_REWRITE_TAC[] THEN 5216 Q.PAT_X_ASSUM `h \\ x = Y` (fn thm => ALL_TAC) THEN 5217 Q.PAT_X_ASSUM `x IN FDOM h` (fn thm => ALL_TAC) THEN 5218 Induct_on `hL` THEN ( 5219 FULL_SIMP_TAC list_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, 5220 ALL_DISJOINT_def, EVERY_MEM, 5221 GSYM LEFT_FORALL_IMP_THM, MEM_MAP, 5222 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 5223 METIS_TAC[] 5224 ) 5225 ) THEN 5226 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FDOM_DOMSUB, IN_DELETE, 5227 DOMSUB_FAPPLY_THM, GSYM fmap_EQ_THM] THEN 5228 METIS_TAC[] 5229 ) THEN 5230 5231 METIS_TAC[SF_IS_PRECISE_def, SUBMAP_REFL, SF_IS_PRECISE_THM, SF_SEM_def, 5232 SF_SEM___sf_tree_def], 5233 5234 5235 5236 5237 `?h'. MEM h' hL /\ DS_POINTS_TO s h' e' [(f, e')]` by ( 5238 `DS_POINTS_TO s (h \\ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e))) e' [(f,e')]` by ( 5239 5240 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DOMSUB_FAPPLY_THM, GET_DSV_VALUE_11, 5241 FDOM_DOMSUB, IN_DELETE] THEN 5242 METIS_TAC[] 5243 ) THEN 5244 POP_ASSUM MP_TAC THEN 5245 Q.PAT_X_ASSUM `X = h \\ Y` (fn thm => REWRITE_TAC [GSYM thm]) THEN 5246 5247 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 5248 SIMP_TAC list_ss [DS_POINTS_TO_def] THEN 5249 Induct_on `hL` THENL [ 5250 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 5251 5252 FULL_SIMP_TAC list_ss [FUNION_DEF, IN_UNION] THEN 5253 GEN_TAC THEN 5254 Cases_on `GET_DSV_VALUE (DS_EXPRESSION_EVAL s e') IN FDOM h` THENL [ 5255 ASM_REWRITE_TAC[] THEN METIS_TAC[], 5256 5257 ASM_REWRITE_TAC[] THEN 5258 STRIP_TAC THEN 5259 FULL_SIMP_TAC std_ss [] THEN 5260 METIS_TAC[] 5261 ] 5262 ] 5263 ) THEN 5264 5265 `?f'. MEM (HEAP_READ_ENTRY s h e f', h') (ZIP (MAP (HEAP_READ_ENTRY s h e) fL,hL))` by ( 5266 ASM_SIMP_TAC list_ss [MEM_ZIP] THEN 5267 FULL_SIMP_TAC std_ss [MEM_EL] THEN 5268 Q.EXISTS_TAC `EL n'' fL` THEN 5269 Q.EXISTS_TAC `n''` THEN 5270 FULL_SIMP_TAC list_ss [EL_MAP] 5271 ) THEN 5272 FULL_SIMP_TAC std_ss [EVERY_MEM] THEN 5273 RES_TAC THEN 5274 FULL_SIMP_TAC std_ss [] THEN 5275 METIS_TAC[] 5276 ] 5277 ]); 5278 5279 5280 5281 5282 5283 5284val LEMMA_28_a = store_thm ("LEMMA_28_a", 5285 5286``!e1 e2 e3 fL h' h'' h. 5287(h' SUBMAP h /\ h'' SUBMAP h /\ ~(fL = []) /\ 5288~(DS_EXPRESSION_EQUAL s e2 e3) /\ 5289SF_SEM s h' (sf_tree fL e2 e1) /\ 5290SF_SEM s h'' (sf_tree fL e3 e1)) ==> 5291(~(DS_POINTER_DANGLES s h'' e2) \/ 5292 ~(DS_POINTER_DANGLES s h' e3))``, 5293 5294 5295 5296SIMP_TAC std_ss [SF_SEM_def, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 5297 GSYM LEFT_FORALL_IMP_THM, SF_SEM___sf_tree_def] THEN 5298Induct_on `n` THENL [ 5299 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_POINTER_DANGLES, 5300 FDOM_FEMPTY, NOT_IN_EMPTY] THEN 5301 REPEAT GEN_TAC THEN STRIP_TAC THEN 5302 `~(DS_EXPRESSION_EQUAL s e1 e3)` by METIS_TAC[DS_EXPRESSION_EQUAL_def] THEN 5303 Cases_on `n'` THENL [ 5304 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 5305 5306 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 5307 METIS_TAC[] 5308 ], 5309 5310 5311 5312 REPEAT STRIP_TAC THEN 5313 `?f fL'. fL = f::fL'` by ( 5314 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] 5315 ) THEN 5316 Cases_on `n'` THEN1 ( 5317 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THENL [ 5318 METIS_TAC[DS_EXPRESSION_EQUAL_def], 5319 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def] 5320 ] 5321 ) THEN 5322 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THENL [ 5323 METIS_TAC[DS_EXPRESSION_EQUAL_def], 5324 5325 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_POINTER_DANGLES] THEN 5326 METIS_TAC[], 5327 5328 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_POINTER_DANGLES] THEN 5329 METIS_TAC[], 5330 5331 5332 `0 < LENGTH hL` by ASM_SIMP_TAC list_ss [] THEN 5333 `0 < LENGTH hL'` by ASM_SIMP_TAC list_ss [] THEN 5334 Tactical.REVERSE (sg `~DS_POINTER_DANGLES s (EL 0 hL') e2 \/ ~DS_POINTER_DANGLES s (EL 0 hL) e3`) THENL [ 5335 `EL 0 hL SUBMAP h'` by METIS_TAC[MEM_EL] THEN 5336 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DS_POINTER_DANGLES], 5337 5338 `EL 0 hL' SUBMAP h''` by METIS_TAC[MEM_EL] THEN 5339 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DS_POINTER_DANGLES], 5340 5341 ALL_TAC 5342 ] THEN 5343 5344 `?c. DS_EXPRESSION_EVAL s e1 = dsv_const c` by FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] THEN 5345 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, ds_value_11] THEN 5346 5347 `h' ' c = h'' ' c` by ( 5348 FULL_SIMP_TAC list_ss [SUBMAP_DEF] 5349 ) THEN 5350 5351 Q.PAT_X_ASSUM `!e1 e2 e3. P e1 e2 e3` MATCH_MP_TAC THEN 5352 Q.EXISTS_TAC `dse_const ((h'':('a, 'c) heap) ' c ' f)` THEN 5353 Q.EXISTS_TAC `fL` THEN 5354 Q.EXISTS_TAC `h` THEN 5355 Q.EXISTS_TAC `n''` THEN 5356 ASM_SIMP_TAC std_ss [NOT_NIL_CONS] THEN 5357 METIS_TAC[EL,HD,MEM_EL,SUBMAP_TRANS] 5358 ] 5359]) 5360 5361 5362val LEMMA_28_2 = store_thm ("LEMMA_28_2", 5363 ``!s h h' f e1 e2 e3 e4. (SF_SEM s h (sf_ls f e1 e4) /\ 5364 ~(DS_EXPRESSION_EQUAL s e2 e3) /\ (h' SUBMAP h) /\ 5365 SF_SEM s h' (sf_ls f e2 e3)) ==> 5366 (!h''. h'' SUBMAP h ==> ~(SF_SEM s h'' (sf_ls f e3 e2)))``, 5367 5368 SIMP_TAC std_ss [SF_SEM_def, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 5369 GSYM LEFT_FORALL_IMP_THM, GSYM RIGHT_FORALL_IMP_THM, 5370 GSYM RIGHT_FORALL_OR_THM, IMP_DISJ_THM, 5371 GSYM LEFT_FORALL_OR_THM, sf_ls_def, SF_SEM___sf_tree_def] THEN 5372 5373 REPEAT STRIP_TAC THEN 5374 CCONTR_TAC THEN 5375 FULL_SIMP_TAC std_ss [] THEN 5376 `~(DS_POINTER_DANGLES s h' e2)` by ( 5377 Cases_on `n'` THENL [ 5378 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 5379 5380 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 5381 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] 5382 ] 5383 ) THEN 5384 5385 `~(DS_POINTER_DANGLES s h'' e3)` by ( 5386 Cases_on `n''` THENL [ 5387 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def], 5388 5389 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 5390 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] 5391 ] 5392 ) THEN 5393 5394 `SF_SEM s h (sf_star (sf_ls f e1 e2) (sf_ls f e2 e4))` by ( 5395 MATCH_MP_TAC LEMMA_27 THEN 5396 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, SF_SEM_def, SUBMAP_DEF, 5397 SF_SEM___sf_tree_def, SF_SEM_def, sf_ls_def] THEN 5398 METIS_TAC[] 5399 ) THEN 5400 5401 `DS_POINTER_DANGLES s h e4` by ( 5402 MATCH_MP_TAC LEMMA_3_1_1 THEN 5403 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 5404 METIS_TAC[] 5405 ) THEN 5406 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5407 5408 5409 `~(DS_POINTER_DANGLES s h1 e3) \/ ~(DS_POINTER_DANGLES s h2 e3)` by ( 5410 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DS_POINTER_DANGLES, FUNION_DEF, IN_UNION] 5411 ) THENL [ 5412 `~(DS_POINTER_DANGLES s h2 e3) \/ ~(DS_POINTER_DANGLES s h' e4)` by ( 5413 MATCH_MP_TAC LEMMA_28_a THEN 5414 Q.EXISTS_TAC `e2` THEN 5415 Q.EXISTS_TAC `[f]` THEN 5416 Q.EXISTS_TAC `h` THEN 5417 FULL_SIMP_TAC list_ss [SF_SEM_def, SUBMAP___FUNION___ID, 5418 sf_ls_def, SF_SEM___sf_tree_def] THEN 5419 REPEAT STRIP_TAC THENL [ 5420 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def] THEN 5421 METIS_TAC[SUBMAP_DEF], 5422 5423 METIS_TAC[], 5424 METIS_TAC[] 5425 ] 5426 ) THENL [ 5427 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 5428 METIS_TAC[], 5429 5430 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 5431 METIS_TAC[SUBMAP_DEF] 5432 ], 5433 5434 5435 5436 `SF_SEM s h2 (sf_star (sf_ls f e2 e3) (sf_ls f e3 e4))` by ( 5437 MATCH_MP_TAC LEMMA_27 THEN 5438 ASM_REWRITE_TAC[] 5439 ) THEN 5440 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5441 5442 `~(DS_POINTER_DANGLES s h2' e2) \/ ~(DS_POINTER_DANGLES s h'' e4)` by ( 5443 MATCH_MP_TAC LEMMA_28_a THEN 5444 Q.EXISTS_TAC `e3` THEN 5445 Q.EXISTS_TAC `[f]` THEN 5446 Q.EXISTS_TAC `h` THEN 5447 FULL_SIMP_TAC list_ss [SF_SEM_def, SUBMAP___FUNION___ID, SF_SEM___sf_tree_def, sf_ls_def] THEN 5448 REPEAT STRIP_TAC THENL [ 5449 SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION] THEN 5450 FULL_SIMP_TAC std_ss [DISJOINT_DEF, IN_INTER, EXTENSION, NOT_IN_EMPTY, 5451 FUNION_DEF, IN_UNION] THEN 5452 METIS_TAC[], 5453 5454 Q.PAT_X_ASSUM `DS_POINTER_DANGLES s h e4` MP_TAC THEN 5455 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def, 5456 FUNION_DEF, IN_UNION, SUBMAP_DEF], 5457 5458 METIS_TAC[], 5459 METIS_TAC[] 5460 ] 5461 ) THENL [ 5462 `~(DS_POINTER_DANGLES s h1' e2)` by ( 5463 Q.PAT_X_ASSUM `SF_SEM s h1' Y` MP_TAC THEN 5464 ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_THM, LET_THM] THEN 5465 SIMP_TAC list_ss [SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, 5466 DS_POINTER_DANGLES] 5467 ) THEN 5468 5469 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 5470 DS_POINTER_DANGLES] THEN 5471 METIS_TAC[], 5472 5473 Q.PAT_X_ASSUM `DS_POINTER_DANGLES s h e4` MP_TAC THEN 5474 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def, 5475 FUNION_DEF, IN_UNION, SUBMAP_DEF] 5476 ] 5477 ]); 5478 5479 5480val LEMMA_29 = store_thm ("LEMMA_29", 5481 5482 ``!s h h' f e1 e2 e3 e4. 5483 (SF_SEM s h (sf_ls f e1 e4) /\ 5484 ~(DS_EXPRESSION_EQUAL s e2 e3) /\ (h' SUBMAP h) /\ 5485 SF_SEM s h' (sf_ls f e2 e3)) ==> 5486 5487 SF_SEM s h (sf_star (sf_ls f e1 e2) (sf_star (sf_ls f e2 e3) (sf_ls f e3 e4)))``, 5488 5489 REPEAT STRIP_TAC THEN 5490 `SF_SEM s h (sf_star (sf_ls f e1 e2) (sf_ls f e2 e4))` by ( 5491 MATCH_MP_TAC LEMMA_27 THEN 5492 ASM_SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 5493 FULL_SIMP_TAC std_ss [SF_SEM_def, sf_ls_def, SF_SEM___sf_tree_def] THEN 5494 Cases_on `n'` THENL [ 5495 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 5496 5497 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 5498 FULL_SIMP_TAC std_ss [SUBMAP_DEF] 5499 ] 5500 ) THEN 5501 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5502 Q.EXISTS_TAC `h1` THEN 5503 Q.EXISTS_TAC `h2` THEN 5504 ASM_SIMP_TAC std_ss [] THEN 5505 Cases_on `DS_EXPRESSION_EQUAL s e3 e4` THEN1 ( 5506 Q.EXISTS_TAC `h2` THEN 5507 Q.EXISTS_TAC `FEMPTY` THEN 5508 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_2, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 5509 5510 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def, sf_ls_def] THEN 5511 CONJ_TAC THENL [ 5512 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def], 5513 5514 Q.EXISTS_TAC `0` THEN 5515 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def] 5516 ] 5517 ) THEN 5518 5519 `~(DS_POINTER_DANGLES s h e3)` by ( 5520 `?e. DS_POINTS_TO s h' e [(f, e3)]` by ( 5521 MP_TAC (Q.SPECL [`s`, `h'`, `[f]`, `e3`, `e2`] LEMMA_26) THEN 5522 FULL_SIMP_TAC list_ss [sf_ls_def] 5523 ) THEN 5524 5525 MATCH_MP_TAC LEMMA_3_1_2 THEN 5526 Q.EXISTS_TAC `f` THEN 5527 Q.EXISTS_TAC `[f]` THEN 5528 Q.EXISTS_TAC `e` THEN 5529 Q.EXISTS_TAC `e4` THEN 5530 Q.EXISTS_TAC `e1` THEN 5531 FULL_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, sf_ls_def] THEN 5532 METIS_TAC[DS_POINTS_TO___SUBMAP] 5533 ) THEN 5534 5535 5536 `~(DS_POINTER_DANGLES s h1 e3) \/ ~(DS_POINTER_DANGLES s h2 e3)` by ( 5537 Q.PAT_X_ASSUM `~(DS_POINTER_DANGLES s h e3)` MP_TAC THEN 5538 ASM_SIMP_TAC std_ss [DS_POINTER_DANGLES, FUNION_DEF, IN_UNION] 5539 ) THENL [ 5540 `SF_SEM s h1 (sf_star (sf_ls f e1 e3) (sf_ls f e3 e2))` by ( 5541 MATCH_MP_TAC LEMMA_27 THEN 5542 ASM_SIMP_TAC std_ss [SF_SEM_def] THEN 5543 METIS_TAC[] 5544 ) THEN 5545 MATCH_MP_TAC (prove (``F ==> X``, METIS_TAC[])) THEN 5546 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5547 MP_TAC (Q.SPECL [`s`, `h`, `h'`, `f`, `e1`, `e2`, `e3`, `e4`] LEMMA_28_2) THEN 5548 FULL_SIMP_TAC std_ss [SF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 5549 Q.EXISTS_TAC `h2'` THEN 5550 FULL_SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 5551 FUNION_DEF, IN_UNION] THEN 5552 METIS_TAC[], 5553 5554 5555 `SF_SEM s h2 (sf_star (sf_ls f e2 e3) (sf_ls f e3 e4))` by ( 5556 MATCH_MP_TAC LEMMA_27 THEN 5557 ASM_SIMP_TAC std_ss [SF_SEM_def] THEN 5558 METIS_TAC[] 5559 ) THEN 5560 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5561 5562 Q.EXISTS_TAC `h1'` THEN 5563 Q.EXISTS_TAC `h2'` THEN 5564 5565 ASM_SIMP_TAC std_ss [] 5566 ] 5567); 5568 5569 5570 5571(* 5572val LEMMA_30 = store_thm ("LEMMA_30", 5573``!s h e1 e2 e3 e4. 5574(SF_SEM s h (sf_ls e1 e4) /\ 5575SF_SEM s h (sf_star (sf_ls e2 e3) sf_true)) = 5576(?h1 h2. 5577 (h = FUNION h1 h2) /\ DISJOINT (FDOM h1) (FDOM h2) /\ 5578 (SF_SEM s h1 (sf_ls e2 e3)) /\ (DS_POINTER_DANGLES s h1 e4) /\ 5579 !h3. ((DISJOINT (FDOM h2) (FDOM h3)) /\ 5580 (SF_SEM s h3 (sf_ls e2 e3)) /\ (DS_POINTER_DANGLES s h3 e4)) ==> 5581 SF_SEM s (FUNION h3 h2) (sf_ls e1 e4))``, 5582 5583SIMP_TAC std_ss [SF_SEM___STAR_TRUE] THEN 5584REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 5585 Cases_on `DS_EXPRESSION_EQUAL s e2 e3` THENL [ 5586 `!h. SF_SEM s h (sf_ls e2 e3) = (h = FEMPTY)` by 5587 METIS_TAC[SF_SEM_EMP_EXTEND, PF_SEM_def, SF_SEM_EVAL___SF_LIST, SF_SEM_def] THEN 5588 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, DISJOINT_EMPTY, FUNION_FEMPTY_1, DS_POINTER_DANGLES, 5589 NOT_IN_EMPTY], 5590 5591 Q.EXISTS_TAC `h'` THEN 5592 `?h''. h'' = DRESTRICT h (FDOM h DIFF FDOM h')` by METIS_TAC[] THEN 5593 Q.EXISTS_TAC `h''` THEN 5594 MATCH_MP_TAC (prove (``(((a1 = a2) /\ b /\ c /\ d) /\ ((a2 = a1) /\ b /\ c /\ d ==> e)) ==> ((a1 = a2) /\ b /\ c /\ d /\ e)``, METIS_TAC[])) THEN 5595 CONJ_TAC THEN1( 5596 FULL_SIMP_TAC std_ss [SUBMAP_DEF, GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, 5597 DRESTRICT_DEF, IN_UNION, IN_INTER, IN_DIFF, DISJOINT_DEF, NOT_IN_EMPTY] THEN 5598 REPEAT STRIP_TAC THENL [ 5599 METIS_TAC[], 5600 METIS_TAC[], 5601 5602 `DS_POINTER_DANGLES s h e4` by ( 5603 MATCH_MP_TAC LEMMA_3_1_1 THEN 5604 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 5605 METIS_TAC[] 5606 ) THEN 5607 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 5608 METIS_TAC[] 5609 ] 5610 ) THEN 5611 5612 REPEAT STRIP_TAC THEN 5613 `SF_SEM s h'' (sf_star (sf_ls e1 e2) (sf_ls e3 e4))` by ( 5614 `SF_SEM s h (sf_star (sf_ls e1 e2) (sf_star (sf_ls e2 e3) (sf_ls e3 e4)))` by ( 5615 MATCH_MP_TAC LEMMA_29 THEN 5616 ASM_SIMP_TAC std_ss [SF_SEM___STAR_TRUE] THEN 5617 METIS_TAC[] 5618 ) THEN 5619 5620 FULL_SIMP_TAC std_ss [SF_SEM___STAR_THM] THEN 5621 5622 `h1' = h'` by ( 5623 `SF_IS_PRECISE (sf_ls e2 e3)` by PROVE_TAC[SF_IS_PRECISE___sf_ls] THEN 5624 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 5625 POP_ASSUM MATCH_MP_TAC THEN 5626 Q.EXISTS_TAC `s` THEN 5627 Q.EXISTS_TAC `h` THEN 5628 ASM_SIMP_TAC std_ss [] THEN 5629 5630 MATCH_MP_TAC SUBMAP___FUNION THEN 5631 DISJ2_TAC THEN 5632 REWRITE_TAC [SUBMAP___FUNION___ID] THEN 5633 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 5634 DRESTRICT_DEF, IN_DIFF, FDOM_FUNION, IN_UNION] THEN 5635 METIS_TAC[] 5636 ) THEN 5637 5638 5639 Q.EXISTS_TAC `h1` THEN 5640 Q.EXISTS_TAC `h2'` THEN 5641 5642 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 5643 FUNION_DEF, IN_UNION, GSYM fmap_EQ_THM, DRESTRICT_DEF, IN_DIFF] THEN 5644 METIS_TAC[] 5645 ) THEN 5646 5647 FULL_SIMP_TAC std_ss [SF_SEM___STAR_THM] THEN 5648 `DS_POINTER_DANGLES s h e4` by ( 5649 MATCH_MP_TAC LEMMA_3_1_1 THEN 5650 METIS_TAC[] 5651 ) THEN 5652 5653 `SF_SEM s (FUNION h1 h3) (sf_ls e1 e3)` by ( 5654 MATCH_MP_TAC LEMMA_25 THEN 5655 Q.EXISTS_TAC `e2` THEN 5656 ASM_SIMP_TAC std_ss [] THEN 5657 REPEAT STRIP_TAC THENL [ 5658 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION] THEN 5659 METIS_TAC[], 5660 5661 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION, 5662 SF_SEM_def] THEN 5663 SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 5664 Cases_on `(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e3) IN FDOM h2)` THEN1 ( 5665 METIS_TAC[] 5666 ) THEN 5667 Tactical.REVERSE (Cases_on `n''''`) THEN1 ( 5668 FULL_SIMP_TAC std_ss [SF_SEM_LIST_LEN_def, LET_THM] 5669 ) THEN 5670 FULL_SIMP_TAC std_ss [SF_SEM_LIST_LEN_def, PF_SEM_def, DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def] THEN 5671 5672 Q.PAT_X_ASSUM `FUNION h1 FEMPTY = X` (fn thm => ALL_TAC) THEN 5673 Q.PAT_X_ASSUM `X = h` (fn thm => (ASSUME_TAC (GSYM thm))) THEN 5674 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY, 5675 FUNION_FEMPTY_2, DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def, 5676 DRESTRICT_DEF, IN_INTER, IN_DIFF, SUBMAP_DEF, FUNION_DEF, IN_UNION] 5677 ] 5678 ) THEN 5679 5680 `SF_SEM s (FUNION (FUNION h1 h3) h2) (sf_ls e1 e4)` by ( 5681 MATCH_MP_TAC LEMMA_25 THEN 5682 Q.EXISTS_TAC `e3` THEN 5683 ASM_SIMP_TAC std_ss [] THEN 5684 REPEAT STRIP_TAC THENL [ 5685 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION] THEN 5686 METIS_TAC[], 5687 5688 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION, 5689 SF_SEM_def, DS_POINTER_DANGLES] THEN 5690 Q.PAT_X_ASSUM `X = h` (fn thm => (ASSUME_TAC (GSYM thm))) THEN 5691 FULL_SIMP_TAC std_ss [IN_UNION, FDOM_FUNION] 5692 ] 5693 ) THEN 5694 5695 `FUNION h3 (FUNION h1 h2) = FUNION (FUNION h1 h3) h2` suffices_by (STRIP_TAC THEN 5696 ASM_REWRITE_TAC[] 5697 ) THEN 5698 5699 5700 Q.PAT_X_ASSUM `h'' = DRESTRICT h X` (fn thm => ALL_TAC) THEN 5701 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, IN_UNION, DISJOINT_DEF, 5702 EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 5703 METIS_TAC[] 5704 ], 5705 5706 5707 5708 5709 CONJ_TAC THENL [ 5710 METIS_TAC[DISJOINT_SYM], 5711 5712 Q.EXISTS_TAC `h1` THEN 5713 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID] 5714 ] 5715]); 5716 5717 5718val LEMMA_3_1_3 = save_thm ("LEMMA_3_1_3", LEMMA_30); 5719*) 5720 5721 5722 5723 5724val DS_POINTS_TO___RTC___sf_tree_ROOT_TO_ALL = store_thm ("DS_POINTS_TO___RTC___sf_tree_ROOT_TO_ALL", 5725``!s h fL es e e'. 5726SF_SEM s h (sf_tree fL es e) /\ 5727~(DS_POINTER_DANGLES s h e') ==> 5728(DS_POINTS_TO___RTC s h fL e e')``, 5729 5730 5731SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM LEFT_EXISTS_AND_THM, 5732 GSYM LEFT_FORALL_IMP_THM, DS_POINTER_DANGLES] THEN 5733Induct_on `n` THEN1 ( 5734 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, FDOM_FEMPTY, NOT_IN_EMPTY] 5735) THEN 5736 5737SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 5738REPEAT STRIP_TAC THEN1 ( 5739 METIS_TAC[FDOM_FEMPTY, NOT_IN_EMPTY] 5740) THEN 5741 5742Cases_on `DS_EXPRESSION_EQUAL s e' e` THEN1 ( 5743 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 5744 Q.EXISTS_TAC `0` THEN 5745 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def] 5746) THEN 5747`?h'. MEM h' hL /\ (DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h')` by ( 5748 `(DS_EXPRESSION_EVAL_VALUE s e') IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 5749 FULL_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE, DS_EXPRESSION_EVAL_VALUE_def, 5750 GET_DSV_VALUE_11, DS_EXPRESSION_EQUAL_def] 5751 ) THEN 5752 POP_ASSUM MP_TAC THEN 5753 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 5754 Induct_on `hL` THENL [ 5755 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 5756 5757 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION, 5758 DISJ_IMP_THM, FORALL_AND_THM] THEN 5759 METIS_TAC[] 5760 ] 5761) THEN 5762 5763`?f. MEM (HEAP_READ_ENTRY s h e f, h') (ZIP (MAP (HEAP_READ_ENTRY s h e) fL,hL)) /\ 5764 MEM f fL` by ( 5765 ASM_SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_EXISTS_AND_THM] THEN 5766 FULL_SIMP_TAC std_ss [MEM_EL] THEN 5767 Q.EXISTS_TAC `EL n' fL` THEN 5768 Q.EXISTS_TAC `n'` THEN 5769 FULL_SIMP_TAC list_ss [EL_MAP] THEN 5770 METIS_TAC[] 5771) THEN 5772 5773`(\(c,h'). SF_SEM___sf_tree_len s h' fL n es (dse_const (THE c))) (HEAP_READ_ENTRY s h e f,h')` 5774 by METIS_TAC[EVERY_MEM] THEN 5775 5776MATCH_MP_TAC (REWRITE_RULE [transitive_def] DS_POINTS_TO___RTC___is_transitive) THEN 5777Q.EXISTS_TAC `dse_const (THE (HEAP_READ_ENTRY s h e f))` THEN 5778FULL_SIMP_TAC list_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, DS_EXPRESSION_EVAL_VALUE_def] THEN 5779`IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 5780FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 5781CONJ_TAC THEN1 ( 5782 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, DS_POINTS_TO___RTC_def] THEN 5783 Q.EXISTS_TAC `SUC 0` THEN 5784 REWRITE_TAC [DS_POINTS_TO___IN_DISTANCE_def] THEN 5785 Q.EXISTS_TAC `e` THEN 5786 Q.EXISTS_TAC `f` THEN 5787 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def] 5788) THEN 5789 5790 5791 5792MATCH_MP_TAC DS_POINTS_TO___RTC___SUBMAP THEN 5793Q.EXISTS_TAC `h'` THEN 5794Tactical.REVERSE (CONJ_TAC) THEN1 ( 5795 `h' SUBMAP (FOLDR FUNION FEMPTY hL)` suffices_by (STRIP_TAC THEN 5796 POP_ASSUM MP_TAC THEN 5797 ASM_REWRITE_TAC[] THEN 5798 SIMP_TAC std_ss [SUBMAP_DEF, FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM] 5799 ) THEN 5800 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 5801 Q.PAT_X_ASSUM `ALL_DISJOINT P` MP_TAC THEN 5802 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 5803 Induct_on `hL` THENL [ 5804 SIMP_TAC list_ss [], 5805 5806 SIMP_TAC list_ss [ALL_DISJOINT_def, DISJ_IMP_THM, SUBMAP___FUNION___ID] THEN 5807 REPEAT STRIP_TAC THEN 5808 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 5809 MATCH_MP_TAC SUBMAP___FUNION THEN 5810 METIS_TAC[DISJOINT_SYM] 5811 ] 5812) THEN 5813 5814Q.PAT_X_ASSUM `!s h fL. P s h fL` MATCH_MP_TAC THEN 5815FULL_SIMP_TAC std_ss [] THEN 5816METIS_TAC[] 5817); 5818 5819 5820 5821val DS_POINTS_TO___RTC___sf_tree_ROOT_TO_LEAF = store_thm ("DS_POINTS_TO___RTC___sf_tree_ROOT_TO_LEAF", 5822``!s h fL f es e. 5823MEM f fL /\ 5824SF_SEM s h (sf_tree fL es e) ==> 5825DS_POINTS_TO___RTC s h [f] e es``, 5826 5827 5828SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM LEFT_EXISTS_AND_THM, 5829 GSYM LEFT_FORALL_IMP_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 5830Induct_on `n` THEN1 ( 5831 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_POINTS_TO___RTC_def] THEN 5832 REPEAT STRIP_TAC THEN 5833 Q.EXISTS_TAC `0` THEN 5834 ASM_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] 5835) THEN 5836 5837SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 5838REPEAT STRIP_TAC THEN1 ( 5839 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 5840 REPEAT STRIP_TAC THEN 5841 Q.EXISTS_TAC `0` THEN 5842 ASM_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] 5843) THEN 5844 5845MATCH_MP_TAC (REWRITE_RULE [transitive_def] DS_POINTS_TO___RTC___is_transitive) THEN 5846`IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[] THEN 5847FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 5848Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 5849 IS_DSV_NIL_def] THEN 5850Q.EXISTS_TAC `dse_const (h ' v ' f)` THEN 5851CONJ_TAC THEN1 ( 5852 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 5853 EXISTS_TAC ``SUC 0`` THEN 5854 REWRITE_TAC [DS_POINTS_TO___IN_DISTANCE_def] THEN 5855 Q.EXISTS_TAC `e` THEN 5856 Q.EXISTS_TAC `f` THEN 5857 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, 5858 GET_DSV_VALUE_def, IS_DSV_NIL_def] 5859) THEN 5860 5861`?n. (n < LENGTH hL) /\ (EL n fL = f)` by METIS_TAC[MEM_EL] THEN 5862MATCH_MP_TAC DS_POINTS_TO___RTC___SUBMAP THEN 5863Q.EXISTS_TAC `EL n' hL` THEN 5864CONJ_TAC THENL [ 5865 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 5866 METIS_TAC[], 5867 5868 METIS_TAC[MEM_EL] 5869]) 5870 5871 5872 5873 5874val SF_SEM___sf_tree_SUBTREE_THM = store_thm ("SF_SEM___sf_tree_SUBTREE_THM", 5875``!s h fL es e e'. 5876SF_SEM s h (sf_tree fL es e) /\ 5877~(DS_POINTER_DANGLES s h e') ==> 5878(?h'. h' SUBMAP h /\ ((DS_EXPRESSION_EVAL_VALUE s e IN FDOM h') ==> DS_EXPRESSION_EQUAL s e e') /\ 5879SF_SEM s h' (sf_tree fL es e'))``, 5880 5881SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM LEFT_EXISTS_AND_THM, 5882 GSYM LEFT_FORALL_IMP_THM, DS_POINTER_DANGLES] THEN 5883Induct_on `n` THEN1 ( 5884 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, FDOM_FEMPTY, NOT_IN_EMPTY] 5885) THEN 5886 5887REPEAT STRIP_TAC THEN 5888Cases_on `DS_EXPRESSION_EQUAL s e e'` THEN1 ( 5889 Q.EXISTS_TAC `h` THEN 5890 ASM_REWRITE_TAC [SUBMAP_REFL] THEN 5891 Q.EXISTS_TAC `SUC n` THEN 5892 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def] 5893) THEN 5894 5895FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN1 ( 5896 METIS_TAC[FDOM_FEMPTY, NOT_IN_EMPTY] 5897) THEN 5898`?c c'. (DS_EXPRESSION_EVAL s e = dsv_const c) /\ (DS_EXPRESSION_EVAL s e' = dsv_const c')` by ( 5899 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 5900) THEN 5901FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, ds_value_11, IS_DSV_NIL_def, 5902 DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EQUAL_def] THEN 5903 5904`?h'. MEM h' hL /\ (c' IN FDOM h')` by METIS_TAC[] THEN 5905`?n f. (n < LENGTH hL) /\ (EL n hL = h') /\ (EL n fL = f)` by METIS_TAC[MEM_EL] THEN 5906 5907Q.PAT_X_ASSUM `!s h. P s h` (fn thm => MP_TAC (Q.SPECL [`s`, `h'`, `fL`, `es`, `dse_const ((h:('b, 'c) heap) ' c ' f)`, `e'`] thm)) THEN 5908ASM_SIMP_TAC std_ss [IS_DSV_NIL_def, 5909 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] THEN 5910MATCH_MP_TAC (prove (``(a /\ (b ==>c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 5911CONJ_TAC THEN1 ( 5912 METIS_TAC[] 5913) THEN 5914 5915 5916`~(c IN FDOM h')` by ( 5917 CCONTR_TAC THEN 5918 `c IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 5919 POP_ASSUM MP_TAC THEN 5920 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 5921 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 5922 Induct_on `hL` THENL [ 5923 SIMP_TAC list_ss [], 5924 5925 FULL_SIMP_TAC list_ss [FUNION_DEF, DISJ_IMP_THM, IN_UNION] 5926 ] 5927 ) THEN 5928 POP_ASSUM MP_TAC THEN 5929 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 5930) THEN 5931 5932STRIP_TAC THEN 5933Q.EXISTS_TAC `h''` THEN 5934REPEAT STRIP_TAC THENL [ 5935 PROVE_TAC[SUBMAP_TRANS], 5936 METIS_TAC[SUBMAP_DEF], 5937 METIS_TAC[] 5938]); 5939 5940 5941 5942 5943val DS_POINTS_TO___RTC___sf_tree_ALL_TO_LEAF = store_thm ("DS_POINTS_TO___RTC___sf_tree_ALL_TO_LEAF", 5944``!s h fL f es e e'. 5945SF_SEM s h (sf_tree fL es e) /\ MEM f fL /\ 5946~(DS_POINTER_DANGLES s h e') ==> 5947(DS_POINTS_TO___RTC s h [f] e' es)``, 5948 5949 5950REPEAT STRIP_TAC THEN 5951Cases_on `DS_EXPRESSION_EQUAL s e' es` THEN1 ( 5952 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 5953 EXISTS_TAC ``0`` THEN 5954 ASM_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def] 5955) THEN 5956 5957`?h'. h' SUBMAP h /\ SF_SEM s h' (sf_tree fL es e')` by METIS_TAC[SF_SEM___sf_tree_SUBTREE_THM] THEN 5958 5959MATCH_MP_TAC DS_POINTS_TO___RTC___SUBMAP THEN 5960Q.EXISTS_TAC `h'` THEN 5961ASM_REWRITE_TAC[] THEN 5962METIS_TAC [DS_POINTS_TO___RTC___sf_tree_ROOT_TO_LEAF]); 5963 5964 5965 5966val DS_POINTS_TO___IN_DISTANCE___SING_UNIQUE = store_thm ( 5967 "DS_POINTS_TO___IN_DISTANCE___SING_UNIQUE", 5968 5969``!s h1 h2 h f e e1 e2 n. 5970 ((h1 SUBMAP h) /\ (h2 SUBMAP h) /\ 5971 DS_POINTS_TO___IN_DISTANCE s h1 [f] e e1 n /\ 5972 DS_POINTS_TO___IN_DISTANCE s h2 [f] e e2 n) ==> 5973 5974 (DS_EXPRESSION_EQUAL s e1 e2)``, 5975 5976Induct_on `n` THENL [ 5977 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def] THEN 5978 METIS_TAC[], 5979 5980 SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE_def] THEN 5981 REPEAT STRIP_TAC THEN 5982 `DS_EXPRESSION_EQUAL s y y'` by METIS_TAC[] THEN 5983 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EQUAL_def, SUBMAP_DEF] 5984]) 5985 5986 5987 5988 5989 5990 5991val SF_SEM___sf_tree___DS_POINTS_TO___RTC___SUBMAP = store_thm ("SF_SEM___sf_tree___DS_POINTS_TO___RTC___SUBMAP", 5992``!s h h' fL es e e'. (SF_SEM s h (sf_tree fL es e) /\ (h SUBMAP h') /\ 5993 (DS_POINTS_TO___RTC s h' fL e e') /\ 5994 ~(DS_POINTS_TO___RTC s h' fL es e')) ==> 5995 ~(DS_POINTER_DANGLES s h e')``, 5996 5997 5998 5999SIMP_TAC std_ss [SF_SEM_def, GSYM RIGHT_EXISTS_AND_THM, 6000 GSYM LEFT_FORALL_IMP_THM, GSYM LEFT_EXISTS_AND_THM, 6001 SF_SEM___sf_tree_def] THEN 6002Induct_on `n` THENL [ 6003 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, 6004 DS_POINTS_TO___RTC_def] THEN 6005 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL], 6006 6007 6008 SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 6009 REPEAT GEN_TAC THEN 6010 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN1 ( 6011 FULL_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6012 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL] 6013 ) THEN 6014 ASM_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6015 STRIP_TAC THEN 6016 Cases_on `n'` THEN1 ( 6017 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, 6018 DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def] 6019 ) THEN 6020 FULL_SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def] THEN 6021 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 6022 `?n. (n < LENGTH hL) /\ (EL n fL = f)` by METIS_TAC[MEM_EL] THEN 6023 `(EL n' hL) SUBMAP h` by METIS_TAC[MEM_EL] THEN 6024 `~(DS_POINTER_DANGLES s (EL n' hL) e')` suffices_by (STRIP_TAC THEN 6025 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, SUBMAP_DEF] 6026 ) THEN 6027 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 6028 Q.EXISTS_TAC `h'` THEN 6029 Q.EXISTS_TAC `fL` THEN 6030 Q.EXISTS_TAC `es` THEN 6031 Q.EXISTS_TAC `y` THEN 6032 ASM_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6033 REPEAT STRIP_TAC THENL [ 6034 `DS_EXPRESSION_EQUAL s y (dse_const (h ' v ' f))` by ( 6035 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 6036 METIS_TAC[SUBMAP_DEF] 6037 ) THEN 6038 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def], 6039 6040 METIS_TAC[SUBMAP_TRANS], 6041 6042 METIS_TAC[] 6043 ] 6044]); 6045 6046 6047 6048val SF_SEM___sf_tree___DS_POINTS_TO___RTC = store_thm ("SF_SEM___sf_tree___DS_POINTS_TO___RTC", 6049``!s h fL es e e'. (SF_SEM s h (sf_tree fL es e) /\ 6050 (DS_POINTS_TO___RTC s h fL e e')) ==> 6051 (DS_EXPRESSION_EQUAL s es e' \/ ~(DS_POINTER_DANGLES s h e'))``, 6052 6053REPEAT STRIP_TAC THEN 6054MP_TAC ( 6055 Q.SPECL [`s`, `h`, `h`, `fL`, `es`, `e`, `e'`] SF_SEM___sf_tree___DS_POINTS_TO___RTC___SUBMAP) THEN 6056ASM_REWRITE_TAC[SUBMAP_REFL] THEN 6057MATCH_MP_TAC (prove (``(a ==> c) ==> ((~a ==> b) ==> (c \/ b))``, METIS_TAC[])) THEN 6058`DS_POINTER_DANGLES s h es` by METIS_TAC[LEMMA_3_1_1] THEN 6059SIMP_TAC std_ss [DS_POINTS_TO___RTC_def, GSYM LEFT_FORALL_IMP_THM] THEN 6060Cases_on `n` THENL [ 6061 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def], 6062 6063 FULL_SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6064 DS_POINTER_DANGLES] 6065]) 6066 6067 6068 6069 6070val TREE_NIL_THM = store_thm ("TREE_NIL_THM", 6071``!s h es e. ~(DS_EXPRESSION_EQUAL s e es) ==> 6072(SF_SEM s h (sf_tree [] es e) = SF_SEM s h (sf_points_to e []))``, 6073 6074 6075SIMP_TAC list_ss [SF_EQUIV_def, SF_SEM_def, SF_SEM___sf_tree_def, 6076 DS_POINTS_TO_def] THEN 6077REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 6078 Cases_on `n` THENL [ 6079 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, 6080 DS_EXPRESSION_EQUAL_def], 6081 6082 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def] THEN 6083 FULL_SIMP_TAC std_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 6084 FULL_SIMP_TAC list_ss [LENGTH_NIL] THEN 6085 Q.PAT_X_ASSUM `X = h \\ Y` MP_TAC THEN 6086 ASM_SIMP_TAC list_ss [] THEN 6087 6088 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, 6089 FDOM_FEMPTY, NOT_IN_EMPTY, FDOM_DOMSUB, IN_DELETE, 6090 IN_SING, DS_EXPRESSION_EVAL_VALUE_def] THEN 6091 METIS_TAC[] 6092 ], 6093 6094 6095 6096 Q.EXISTS_TAC `SUC 0` THEN 6097 ASM_REWRITE_TAC [SF_SEM___sf_tree_len_def] THEN 6098 FULL_SIMP_TAC list_ss [PF_SEM_def, LENGTH_NIL, ALL_DISJOINT_def, 6099 DS_EXPRESSION_EQUAL_def] THEN 6100 6101 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, FDOM_DOMSUB, NOT_IN_EMPTY, 6102 EXTENSION, IN_DELETE, IN_SING, DS_EXPRESSION_EVAL_VALUE_def] 6103]); 6104 6105 6106 6107 6108val SUBTREE_SUBTREE_SING = store_thm ("SUBTREE_SUBTREE_SING", 6109``!s h h' fL n es e es' e'. 6110 6111(SF_SEM___sf_tree_len s h fL (SUC n) es e /\ h' SUBMAP h /\ ~(fL = []) /\ 6112~(DS_EXPRESSION_EQUAL s e' es') /\ 6113SF_SEM___sf_tree s h' fL es' e') ==> 6114 6115(DS_EXPRESSION_EQUAL s e' e \/ 6116?h'' f. (h'' SUBMAP h) /\ (h' SUBMAP h'') /\ 6117 MEM f fL /\ 6118 SF_SEM___sf_tree_len s h'' fL n es (dse_const (THE (HEAP_READ_ENTRY s h e f))))``, 6119 6120 6121REPEAT STRIP_TAC THEN 6122`DS_POINTER_DANGLES s h es` by ( 6123 MATCH_MP_TAC LEMMA_3_1_1 THEN 6124 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6125 METIS_TAC[] 6126) THEN 6127FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_def, GSYM LEFT_FORALL_IMP_THM, GSYM RIGHT_EXISTS_AND_THM, 6128 SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN 6129REPEAT STRIP_TAC THENL [ 6130 Q.PAT_X_ASSUM `SF_SEM___sf_tree_len s h' fL n' es' e'` MP_TAC THEN 6131 `h' = FEMPTY` by METIS_TAC[FEMPTY_SUBMAP] THEN 6132 Cases_on `n'` THENL [ 6133 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def], 6134 6135 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def, FDOM_FEMPTY, NOT_IN_EMPTY] 6136 ], 6137 6138 6139 `?v. (DS_EXPRESSION_EVAL s e' = dsv_const v) /\ 6140 (v IN FDOM h')` by ( 6141 Cases_on `n'` THENL [ 6142 Q.PAT_X_ASSUM `SF_SEM___sf_tree_len s h' fL n' es' e'` MP_TAC THEN 6143 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def], 6144 6145 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN1 ( 6146 PROVE_TAC[] 6147 ) THEN 6148 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] THEN 6149 METIS_TAC[GET_DSV_VALUE_def] 6150 ] 6151 ) THEN 6152 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def, 6153 DS_EXPRESSION_EVAL_def] THEN 6154 6155 ASM_REWRITE_TAC[DS_EXPRESSION_EQUAL_def, ds_value_11] THEN 6156 Cases_on `v = v'` THEN ASM_SIMP_TAC std_ss [] THEN 6157 `?h''. MEM h'' hL /\ v IN FDOM h''` by METIS_TAC[SUBMAP_DEF, ds_value_11] THEN 6158 `?n f. (n < LENGTH hL) /\ (EL n hL = h'') /\ (EL n fL = f)` by METIS_TAC[MEM_EL] THEN 6159 Q.EXISTS_TAC `h''` THEN 6160 Q.EXISTS_TAC `f` THEN 6161 REPEAT STRIP_TAC THENL [ 6162 PROVE_TAC[], 6163 6164 ALL_TAC, (*rotate 1*) 6165 6166 METIS_TAC[MEM_EL], 6167 6168 6169 `IS_SOME (HEAP_READ_ENTRY s h e f)` by METIS_TAC[MEM_EL] THEN 6170 POP_ASSUM MP_TAC THEN 6171 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, HEAP_READ_ENTRY_def, IS_DSV_NIL_def, 6172 GET_DSV_VALUE_def] THEN 6173 METIS_TAC[] 6174 ] THEN 6175 6176 SIMP_TAC std_ss [SUBMAP_DEF] THEN 6177 GEN_TAC THEN STRIP_TAC THEN 6178 MATCH_MP_TAC (prove (``((a ==> b) /\ a) ==> (a /\ b)``, METIS_TAC[])) THEN 6179 CONJ_TAC THEN1 ( 6180 STRIP_TAC THEN 6181 `h' SUBMAP h /\ h'' SUBMAP h` by METIS_TAC[] THEN 6182 FULL_SIMP_TAC std_ss [SUBMAP_DEF] 6183 ) THEN 6184 `DS_POINTS_TO___RTC s h' fL e' (dse_const (dsv_const x))` by ( 6185 MATCH_MP_TAC DS_POINTS_TO___RTC___sf_tree_ROOT_TO_ALL THEN 6186 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def, 6187 DS_POINTER_DANGLES, GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def] THEN 6188 METIS_TAC[] 6189 ) THEN 6190 POP_ASSUM MP_TAC THEN 6191 SIMP_TAC std_ss [DS_POINTS_TO___RTC_def, GSYM LEFT_FORALL_IMP_THM] THEN 6192 GEN_TAC THEN 6193 `DS_EXPRESSION_EVAL_VALUE s e' IN FDOM h''` by ( 6194 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] 6195 ) THEN 6196 POP_ASSUM MP_TAC THEN 6197 REWRITE_TAC [AND_IMP_INTRO] THEN 6198 Q.SPEC_TAC (`e'`, `e`) THEN 6199 6200 Induct_on `n'''` THENL [ 6201 SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 6202 DS_EXPRESSION_EVAL_VALUE_def] THEN 6203 METIS_TAC[GET_DSV_VALUE_def], 6204 6205 6206 6207 SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def] THEN 6208 REPEAT STRIP_TAC THEN 6209 Cases_on `DS_EXPRESSION_EVAL s e''` THEN ( 6210 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def, GET_DSV_VALUE_def, 6211 DS_EXPRESSION_EVAL_VALUE_def] 6212 ) THEN 6213 6214 Q.PAT_X_ASSUM `!e. P e` MATCH_MP_TAC THEN 6215 Q.EXISTS_TAC `y` THEN 6216 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 6217 Cases_on `DS_EXPRESSION_EQUAL s es (dse_const (h' ' v'' ' f'))` THEN1 ( 6218 Cases_on `n'''` THENL [ 6219 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def, 6220 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] THEN 6221 Q.PAT_X_ASSUM `Y = dsv_const x` ASSUME_TAC THEN 6222 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 6223 METIS_TAC[SUBMAP_DEF], 6224 6225 FULL_SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6226 DS_EXPRESSION_EQUAL_def, DS_POINTER_DANGLES, DS_EXPRESSION_EVAL_def] THEN 6227 METIS_TAC[SUBMAP_DEF] 6228 ] 6229 ) THEN 6230 `~(DS_POINTER_DANGLES s h'' (dse_const (h' ' v'' ' f')))` by ( 6231 MATCH_MP_TAC LEMMA_3_1_2 THEN 6232 Q.EXISTS_TAC `f'` THEN 6233 Q.EXISTS_TAC `fL` THEN 6234 Q.EXISTS_TAC `dse_const (dsv_const v'')` THEN 6235 Q.EXISTS_TAC `es` THEN 6236 `h'' ' v'' = h' ' v''` by METIS_TAC[SUBMAP_DEF] THEN 6237 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, IS_DSV_NIL_def, 6238 SF_SEM___sf_tree_def, SF_SEM_def] THEN 6239 METIS_TAC[] 6240 ) THEN 6241 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EVAL_def] 6242 ] 6243]) 6244 6245 6246val SUBTREE___IS_POSTFIX___OR___LIST = store_thm ("SUBTREE___IS_POSTFIX___OR___LIST", 6247 6248``!s h h' fL es e es' e'. 6249 6250(SF_SEM s h (sf_tree fL es e) /\ h' SUBMAP h /\ 6251SF_SEM s h' (sf_tree fL es' e') /\ ~(fL = []) /\ 6252~DS_EXPRESSION_EQUAL s e' es') ==> 6253 6254(DS_EXPRESSION_EQUAL s es es' \/ ?f. (fL = [f]))``, 6255 6256 6257SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def, GSYM LEFT_EXISTS_AND_THM, 6258 GSYM RIGHT_EXISTS_AND_THM, GSYM LEFT_FORALL_IMP_THM] THEN 6259Induct_on `n` THENL [ 6260 Cases_on `n'` THENL [ 6261 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 6262 METIS_TAC[], 6263 6264 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 6265 METIS_TAC[FEMPTY_SUBMAP, FDOM_FEMPTY, NOT_IN_EMPTY] 6266 ], 6267 6268 REPEAT STRIP_TAC THEN 6269 MP_TAC (Q.SPECL [`s`, `h`, `h'`, `fL`, `n`, `es`, `e`, `es'`, `e'`] 6270 SUBTREE_SUBTREE_SING) THEN 6271 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 6272 CONJ_TAC THEN1 ( 6273 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_def] THEN 6274 METIS_TAC[] 6275 ) THEN 6276 Tactical.REVERSE (Cases_on `DS_EXPRESSION_EQUAL s e' e`) THEN1 ( 6277 ASM_REWRITE_TAC[] THEN 6278 STRIP_TAC THEN 6279 METIS_TAC[] 6280 ) THEN 6281 6282 6283 ASM_REWRITE_TAC[] THEN 6284 Cases_on `?f. fL = [f]` THEN ASM_REWRITE_TAC[] THEN 6285 `?f1 f2 fL'. fL = f1::f2::fL'` by ( 6286 Cases_on `fL` THEN1 FULL_SIMP_TAC list_ss [] THEN 6287 Cases_on `t` THEN1 FULL_SIMP_TAC list_ss [] THEN 6288 SIMP_TAC list_ss [] 6289 ) THEN 6290 FULL_SIMP_TAC list_ss [] THEN 6291 6292 `DS_POINTS_TO___RTC s h [f1] e es' /\ 6293 DS_POINTS_TO___RTC s h [f2] e es'` by ( 6294 `DS_POINTS_TO___RTC s h' [f1] e' es' /\ 6295 DS_POINTS_TO___RTC s h' [f2] e' es'` by ( 6296 `SF_SEM s h' (sf_tree fL es' e')` by ( 6297 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6298 METIS_TAC[] 6299 ) THEN 6300 `MEM f1 fL /\ MEM f2 fL` by ASM_SIMP_TAC list_ss [] THEN 6301 METIS_TAC[DS_POINTS_TO___RTC___sf_tree_ROOT_TO_LEAF] 6302 ) THEN 6303 METIS_TAC[DS_POINTS_TO___RTC___SUBMAP, DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL, 6304 DS_POINTS_TO___RTC_def] 6305 ) THEN 6306 `~(DS_POINTER_DANGLES s h e)` by ( 6307 Cases_on `n'` THENL [ 6308 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 6309 6310 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, DS_POINTER_DANGLES, 6311 DS_EXPRESSION_EQUAL_def, PF_SEM_def] THEN 6312 METIS_TAC[FEMPTY_SUBMAP, NOT_IN_EMPTY, FDOM_FEMPTY] 6313 ] 6314 ) THEN 6315 Cases_on `DS_EXPRESSION_EVAL s e` THEN ( 6316 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, IS_DSV_NIL_def, GET_DSV_VALUE_def, 6317 DS_EXPRESSION_EVAL_def] 6318 ) THEN 6319 6320 `?h1 h2. (DISJOINT (FDOM h1) (FDOM h2)) /\ 6321 (h1 SUBMAP h) /\ (h2 SUBMAP h) /\ 6322 (SF_SEM___sf_tree_len s h1 fL n es (dse_const (h ' v ' f1))) /\ 6323 (SF_SEM___sf_tree_len s h2 fL n es (dse_const (h ' v ' f2)))` by ( 6324 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN1 ( 6325 METIS_TAC[FDOM_FEMPTY, NOT_IN_EMPTY] 6326 ) THEN 6327 Q.EXISTS_TAC `EL 0 hL` THEN 6328 Q.EXISTS_TAC `EL 1 hL` THEN 6329 `(0 < LENGTH hL) /\ (1 < LENGTH hL)` by FULL_SIMP_TAC list_ss [] THEN 6330 `(EL 0 fL = f1) /\ (EL 1 fL = f2)` by ASM_SIMP_TAC list_ss [] THEN 6331 REPEAT STRIP_TAC THENL [ 6332 FULL_SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP], 6333 METIS_TAC[MEM_EL], 6334 METIS_TAC[MEM_EL], 6335 METIS_TAC[GET_DSV_VALUE_def], 6336 METIS_TAC[GET_DSV_VALUE_def] 6337 ] 6338 ) THEN 6339 6340 `DS_POINTS_TO___RTC s h [f1] (dse_const (h ' v ' f1)) es' /\ 6341 DS_POINTS_TO___RTC s h [f2] (dse_const (h ' v ' f2)) es'` by ( 6342 FULL_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6343 CONJ_TAC THENL [ 6344 Cases_on `n''` THEN1 ( 6345 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def] 6346 ) THEN 6347 FULL_SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6348 GET_DSV_VALUE_def] THEN 6349 `DS_EXPRESSION_EQUAL s y (dse_const (h ' v ' f1))` by ( 6350 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] 6351 ) THEN 6352 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL], 6353 6354 6355 Cases_on `n'''` THEN1 ( 6356 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def, DS_EXPRESSION_EQUAL_def] 6357 ) THEN 6358 FULL_SIMP_TAC list_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6359 GET_DSV_VALUE_def] THEN 6360 `DS_EXPRESSION_EQUAL s y (dse_const (h ' v ' f2))` by ( 6361 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] 6362 ) THEN 6363 METIS_TAC[DS_POINTS_TO___IN_DISTANCE___DS_EXPRESSION_EQUAL] 6364 ] 6365 ) THEN 6366 6367 `DS_POINTER_DANGLES s h es` by ( 6368 MATCH_MP_TAC LEMMA_3_1_1 THEN 6369 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6370 METIS_TAC[] 6371 ) THEN 6372 CCONTR_TAC THEN 6373 `~(DS_POINTER_DANGLES s h1 es')` by ( 6374 MATCH_MP_TAC SF_SEM___sf_tree___DS_POINTS_TO___RTC___SUBMAP THEN 6375 Q.EXISTS_TAC `h` THEN 6376 Q.EXISTS_TAC `fL` THEN 6377 Q.EXISTS_TAC `es` THEN 6378 Q.EXISTS_TAC `(dse_const (h ' v ' f1))` THEN 6379 ASM_SIMP_TAC std_ss [] THEN 6380 REPEAT STRIP_TAC THENL [ 6381 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6382 METIS_TAC[], 6383 6384 MATCH_MP_TAC DS_POINTS_TO___RTC___SUBSET THEN 6385 Q.EXISTS_TAC `[f1]` THEN 6386 ASM_SIMP_TAC list_ss [], 6387 6388 FULL_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6389 Cases_on `n''''''` THENL [ 6390 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def], 6391 6392 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6393 DS_POINTER_DANGLES] THEN 6394 FULL_SIMP_TAC std_ss [] 6395 ] 6396 ] 6397 ) THEN 6398 6399 `~(DS_POINTER_DANGLES s h2 es')` by ( 6400 MATCH_MP_TAC SF_SEM___sf_tree___DS_POINTS_TO___RTC___SUBMAP THEN 6401 Q.EXISTS_TAC `h` THEN 6402 Q.EXISTS_TAC `fL` THEN 6403 Q.EXISTS_TAC `es` THEN 6404 Q.EXISTS_TAC `(dse_const (h ' v ' f2))` THEN 6405 ASM_SIMP_TAC std_ss [] THEN 6406 REPEAT STRIP_TAC THENL [ 6407 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6408 METIS_TAC[], 6409 6410 MATCH_MP_TAC DS_POINTS_TO___RTC___SUBSET THEN 6411 Q.EXISTS_TAC `[f2]` THEN 6412 ASM_SIMP_TAC list_ss [], 6413 6414 FULL_SIMP_TAC std_ss [DS_POINTS_TO___RTC_def] THEN 6415 Cases_on `n''''''` THENL [ 6416 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE_def], 6417 6418 FULL_SIMP_TAC std_ss [DS_POINTS_TO___IN_DISTANCE___LEFT, DS_POINTS_TO_def, 6419 DS_POINTER_DANGLES] THEN 6420 FULL_SIMP_TAC std_ss [] 6421 ] 6422 ] 6423 ) THEN 6424 6425 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DISJOINT_DEF, EXTENSION, 6426 NOT_IN_EMPTY, IN_INTER] THEN 6427 METIS_TAC[] 6428]); 6429 6430 6431 6432 6433 6434val SUBTREE_EXCHANGEABLE_THM = store_thm ("SUBTREE_EXCHANGEABLE_THM", 6435 6436``!s h1 h2 fL es e e1' e2'. 6437 6438(SF_SEM s (FUNION h1 h2) (sf_tree fL es e) /\ 6439SF_SEM s h1 (sf_tree fL e1' e2') /\ 6440(DISJOINT (FDOM h1) (FDOM h2))) ==> 6441 6442(!h1'. 6443SF_SEM s h1' (sf_tree fL e1' e2') /\ 6444DS_POINTER_DANGLES s h1' es /\ 6445(DISJOINT (FDOM h1') (FDOM h2)) ==> 6446SF_SEM s (FUNION h1' h2) (sf_tree fL es e))``, 6447 6448 6449REPEAT GEN_TAC THEN 6450Cases_on `DS_EXPRESSION_EQUAL s e es` THEN1 ( 6451 `DS_EXPRESSION_EQUAL s e es` by FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def] THEN 6452 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_THM, FUNION_EQ_FEMPTY, LET_THM] THEN 6453 Cases_on `DS_EXPRESSION_EQUAL s e2' e1'` THEN ASM_REWRITE_TAC[] THEN1 ( 6454 METIS_TAC[] 6455 ) THEN 6456 Cases_on `h1 = FEMPTY` THEN ASM_REWRITE_TAC[] THEN 6457 SIMP_TAC std_ss [SF_SEM___sf_points_to_THM] THEN 6458 SIMP_TAC std_ss [DS_POINTS_TO_def, FDOM_FEMPTY, NOT_IN_EMPTY] 6459) THEN 6460Cases_on `fL = []` THEN1 ( 6461 ASM_SIMP_TAC std_ss [TREE_NIL_THM, DS_POINTS_TO_def] THEN 6462 Cases_on `~DS_EXPRESSION_EQUAL s e2' e1'` THENL [ 6463 ASM_SIMP_TAC std_ss [TREE_NIL_THM, DS_POINTS_TO_def] THEN 6464 SIMP_TAC list_ss [SF_SEM_def, DS_POINTS_TO_def, FUNION_DEF, IN_UNION, 6465 IN_SING, DS_EXPRESSION_EVAL_VALUE_def] THEN 6466 Cases_on `FDOM h1 = {GET_DSV_VALUE (DS_EXPRESSION_EVAL s e2')}` THEN ASM_REWRITE_TAC[] THEN 6467 SIMP_TAC std_ss [IN_SING], 6468 6469 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_THM] THEN 6470 Cases_on `h1 = FEMPTY` THEN ASM_REWRITE_TAC[] THEN 6471 SIMP_TAC std_ss [] 6472 ] 6473) THEN 6474Cases_on `DS_EXPRESSION_EQUAL s e2' e1'` THEN1 ( 6475 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_THM, LET_THM] THEN 6476 METIS_TAC[] 6477) THEN 6478REPEAT STRIP_TAC THEN 6479 6480`DS_EXPRESSION_EQUAL s es e1' \/ ~DS_EXPRESSION_EQUAL s es e1' /\ ?f. fL = [f]` by ( 6481 METIS_TAC[SUBTREE___IS_POSTFIX___OR___LIST, SUBMAP___FUNION___ID] 6482) THENL [ 6483 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6484 Q.PAT_X_ASSUM `SF_SEM___sf_tree_len s (FUNION h1 h2) fL n es e` MP_TAC THEN 6485 Q_TAC MP_FREE_VAR_TAC `h2` THEN 6486 Q.PAT_X_ASSUM `~(DS_EXPRESSION_EQUAL s e es)` (K ALL_TAC) THEN 6487 6488 REWRITE_TAC [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN 6489 Q.SPEC_TAC (`h2`, `h2`) THEN 6490 Q.SPEC_TAC (`e`, `e`) THEN 6491 6492 6493 Induct_on `n` THENL [ 6494 SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, FUNION_EQ_FEMPTY, 6495 FDOM_FEMPTY, DISJOINT_EMPTY] THEN 6496 REPEAT STRIP_TAC THEN 6497 Cases_on `n'` THENL [ 6498 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 6499 6500 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 6501 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 6502 ], 6503 6504 6505 6506 REPEAT STRIP_TAC THEN 6507 MP_TAC (Q.SPECL [`s`, `FUNION h1 h2`, `h1`, `fL`, `n`, `es`, `e`, `e1'`, `e2'`] SUBTREE_SUBTREE_SING) THEN 6508 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, SIMP_TAC std_ss [])) THEN 6509 CONJ_TAC THEN1 ( 6510 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID, SF_SEM___sf_tree_len_def, SF_SEM___sf_tree_def] THEN 6511 METIS_TAC[] 6512 ) THEN 6513 STRIP_TAC THEN1 ( 6514 `SF_SEM s h1 (sf_tree fL es e) /\ 6515 SF_SEM s h1' (sf_tree fL es e)` by ( 6516 FULL_SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 6517 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def] 6518 ) THEN 6519 `FUNION h1 h2 = h1` by ( 6520 `SF_IS_PRECISE (sf_tree fL es e)` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 6521 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 6522 POP_ASSUM MATCH_MP_TAC THEN 6523 Q.EXISTS_TAC `s` THEN 6524 Q.EXISTS_TAC `FUNION h1 h2` THEN 6525 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID, SUBMAP_REFL, 6526 SF_SEM___sf_tree_def, SF_SEM_def] THEN 6527 METIS_TAC[] 6528 ) THEN 6529 `h2 = FEMPTY` by ( 6530 `!x. x IN FDOM h2 ==> x IN FDOM h1` by ( 6531 POP_ASSUM MP_TAC THEN 6532 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, IN_UNION] THEN 6533 METIS_TAC[] 6534 ) THEN 6535 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 6536 `!x. ~(x IN FDOM h2)` by METIS_TAC[] THEN 6537 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, NOT_IN_EMPTY, FDOM_FEMPTY] 6538 ) THEN 6539 FULL_SIMP_TAC std_ss [FUNION_FEMPTY_2, SF_SEM___sf_tree_def, SF_SEM_def] THEN 6540 METIS_TAC[] 6541 ) THEN 6542 6543 `?hx. DRESTRICT h'' (COMPL (FDOM h1)) = hx` by METIS_TAC[] THEN 6544 `(h'' = FUNION h1 hx) /\ (hx SUBMAP h2)` by ( 6545 POP_ASSUM (fn thm => REWRITE_TAC[GSYM thm]) THEN 6546 Q.PAT_X_ASSUM `h1 SUBMAP h''` MP_TAC THEN 6547 Q.PAT_X_ASSUM `h'' SUBMAP FUNION h1 h2` MP_TAC THEN 6548 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6549 SIMP_TAC std_ss [SUBMAP_DEF, GSYM fmap_EQ_THM, 6550 EXTENSION, DRESTRICT_DEF, FUNION_DEF, IN_UNION, IN_INTER, IN_COMPL] THEN 6551 METIS_TAC[] 6552 ) THEN 6553 6554 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def] THEN1 ( 6555 Q.EXISTS_TAC `0` THEN 6556 FULL_SIMP_TAC std_ss [FUNION_EQ_FEMPTY, SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 6557 Cases_on `n'` THENL [ 6558 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 6559 6560 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 6561 FULL_SIMP_TAC std_ss [FDOM_FEMPTY, NOT_IN_EMPTY] 6562 ] 6563 ) THEN 6564 `?nx. (nx < LENGTH hL) /\ (EL nx fL = f)` by METIS_TAC[MEM_EL] THEN 6565 6566 `?c. DS_EXPRESSION_EVAL s e = dsv_const c` by FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] THEN 6567 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, ds_value_11] THEN 6568 `EL nx hL = h''` by ( 6569 `SF_IS_PRECISE (sf_tree fL es (dse_const (FUNION h1 h2 ' c ' f)))` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 6570 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 6571 POP_ASSUM MATCH_MP_TAC THEN 6572 Q.EXISTS_TAC `s` THEN 6573 Q.EXISTS_TAC `FUNION h1 h2` THEN 6574 ASM_SIMP_TAC list_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 6575 REPEAT STRIP_TAC THENL [ 6576 METIS_TAC[MEM_EL], 6577 METIS_TAC[], 6578 6579 Q.PAT_X_ASSUM `SF_SEM___sf_tree_len s (FUNION h1 hx) fL n es Y` MP_TAC THEN 6580 `IS_SOME (HEAP_READ_ENTRY s (FUNION h1 h2) e f)` by METIS_TAC[] THEN 6581 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, HEAP_READ_ENTRY_def, GET_DSV_VALUE_def] THEN 6582 METIS_TAC[] 6583 ] 6584 ) THEN 6585 6586 `~(c IN FDOM h1)` by ( 6587 `~(c IN FDOM h'')` suffices_by (STRIP_TAC THEN 6588 POP_ASSUM MP_TAC THEN 6589 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] 6590 ) THEN 6591 CCONTR_TAC THEN 6592 `c IN FDOM (FOLDR FUNION FEMPTY hL)` suffices_by (STRIP_TAC THEN 6593 POP_ASSUM MP_TAC THEN 6594 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 6595 ) THEN 6596 POP_ASSUM MP_TAC THEN 6597 `MEM h'' hL` by METIS_TAC[MEM_EL] THEN 6598 POP_ASSUM MP_TAC THEN 6599 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6600 6601 Induct_on `hL` THENL [ 6602 SIMP_TAC list_ss [], 6603 FULL_SIMP_TAC list_ss [FUNION_DEF, IN_UNION, DISJ_IMP_THM] 6604 ] 6605 ) THEN 6606 `c IN FDOM h2` by FULL_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] THEN 6607 `~(c IN FDOM h1')` by ( 6608 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 6609 METIS_TAC[] 6610 ) THEN 6611 `!n. (n < LENGTH hL) /\ (~(n = nx)) ==> 6612 (EL n hL) SUBMAP h2 /\ 6613 (DISJOINT (FDOM (EL n hL)) (FDOM (FUNION h1 hx)))` by ( 6614 GEN_TAC THEN STRIP_TAC THEN 6615 6616 `(EL n''' hL) SUBMAP FUNION h1 h2` by METIS_TAC[MEM_EL] THEN 6617 POP_ASSUM MP_TAC THEN 6618 6619 FULL_SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP] THEN 6620 `DISJOINT (FDOM (EL n''' hL)) (FDOM (EL nx hL))` by METIS_TAC[] THEN 6621 POP_ASSUM MP_TAC THEN 6622 ASM_REWRITE_TAC[] THEN 6623 6624 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6625 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 6626 SUBMAP_DEF, FUNION_DEF, IN_UNION] THEN 6627 METIS_TAC[] 6628 ) THEN 6629 FULL_SIMP_TAC std_ss [FUNION_DEF, ds_value_11, DISJOINT_UNION_BOTH] THEN 6630 6631 `?n. SF_SEM___sf_tree_len s (FUNION h1' hx) fL n es (dse_const (h2 ' c ' f))` by ( 6632 Q.PAT_X_ASSUM `!e h2. P e h2` MATCH_MP_TAC THEN 6633 REWRITE_TAC[CONJ_ASSOC] THEN 6634 CONJ_TAC THENL [ 6635 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, SUBMAP_DEF] THEN 6636 METIS_TAC[], 6637 6638 METIS_TAC[] 6639 ] 6640 ) THEN 6641 6642 `?m. (n''' <= m) /\ (n <= m)` by ( 6643 Q.EXISTS_TAC `MAX n''' n` THEN 6644 SIMP_TAC arith_ss [] 6645 ) THEN 6646 Q.EXISTS_TAC `SUC m` THEN 6647 6648 6649 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len___EXTENDED_DEF, PF_SEM_def, GET_DSV_VALUE_def, 6650 FUNION_DEF, IN_UNION, ds_value_11] THEN 6651 6652 Q.EXISTS_TAC `REPLACE_ELEMENT (FUNION h1' hx) nx hL` THEN 6653 ASM_SIMP_TAC std_ss [REPLACE_ELEMENT_SEM] THEN 6654 6655 REPEAT STRIP_TAC THENL [ 6656 `IS_SOME (HEAP_READ_ENTRY s (FUNION h1 h2) e f')` by METIS_TAC[] THEN 6657 POP_ASSUM MP_TAC THEN 6658 SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, FUNION_DEF, IN_UNION] THEN 6659 ASM_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def], 6660 6661 6662 Q.PAT_X_ASSUM `ALL_DISJOINT Y` MP_TAC THEN 6663 SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, REPLACE_ELEMENT_SEM, EL_MAP] THEN 6664 HO_MATCH_MP_TAC (prove (``(!n1 n2. P n1 n2 ==> ((Q n1 n2) ==> (Q' n1 n2))) ==> 6665 ((!n1 n2. P n1 n2 ==> Q n1 n2) ==> 6666 (!n1 n2. P n1 n2 ==> Q' n1 n2))``, METIS_TAC[])) THEN 6667 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 6668 REPEAT GEN_TAC THEN STRIP_TAC THEN 6669 Cases_on `n1 = nx` THEN 6670 Cases_on `n2 = nx` THEN 6671 ASM_SIMP_TAC list_ss [] THENL [ 6672 `EL n2 hL SUBMAP h2` by METIS_TAC[] THEN 6673 POP_ASSUM MP_TAC THEN 6674 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6675 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6676 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 6677 FDOM_FUNION, IN_UNION, SUBMAP_DEF] THEN 6678 METIS_TAC[], 6679 6680 `EL n1 hL SUBMAP h2` by METIS_TAC[] THEN 6681 POP_ASSUM MP_TAC THEN 6682 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6683 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6684 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 6685 FDOM_FUNION, IN_UNION, SUBMAP_DEF] THEN 6686 METIS_TAC[] 6687 ], 6688 6689 6690 6691 Q.PAT_X_ASSUM `Y = Z \\ c` MP_TAC THEN 6692 `((h1 \\ c) = h1) /\ 6693 ((h1' \\ c) = h1')` by ( 6694 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, IN_DELETE, 6695 DOMSUB_FAPPLY_NEQ, EXTENSION] THEN 6696 METIS_TAC[] 6697 ) THEN 6698 ASM_SIMP_TAC std_ss [DOMSUB_FUNION] THEN 6699 Q.PAT_X_ASSUM `ALL_DISJOINT Y` MP_TAC THEN 6700 Q.PAT_X_ASSUM `DISJOINT X Y` MP_TAC THEN 6701 Q.PAT_X_ASSUM `DISJOINT X Y` MP_TAC THEN 6702 Q.PAT_X_ASSUM `hx SUBMAP h2` MP_TAC THEN 6703 `EL nx hL = FUNION h1 hx` by METIS_TAC[] THEN POP_ASSUM MP_TAC THEN 6704 Q.PAT_X_ASSUM `nx < LENGTH hL` MP_TAC THEN 6705 Q.PAT_X_ASSUM `!n. (n < LENGTH hL) /\ ~(n = nx) ==> P n` MP_TAC THEN 6706 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6707 `?h. (!h1. (FUNION h1 (h2 \\ c)) = (FUNION h1 h)) /\ 6708 (FDOM h SUBSET FDOM h2)` by ( 6709 Q.EXISTS_TAC `h2 \\ c` THEN 6710 SIMP_TAC std_ss [SUBSET_DEF, FDOM_DOMSUB, IN_DELETE] 6711 ) THEN 6712 ASM_REWRITE_TAC [] THEN 6713 POP_ASSUM MP_TAC THEN 6714 SIMP_TAC std_ss [AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN 6715 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6716 6717 Q.SPEC_TAC (`h`, `h`) THEN 6718 Q.SPEC_TAC (`nx`, `nx`) THEN 6719 6720 Induct_on `hL` THENL [ 6721 SIMP_TAC list_ss [], 6722 6723 SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM, ALL_DISJOINT_def] THEN 6724 REPEAT STRIP_TAC THEN 6725 Cases_on `nx` THENL [ 6726 FULL_SIMP_TAC list_ss [REPLACE_ELEMENT_def] THEN 6727 Q.PAT_X_ASSUM `Y = FUNION h1 h'` MP_TAC THEN 6728 6729 ASM_SIMP_TAC std_ss [GSYM FUNION___ASSOC] THEN 6730 `FDOM (FUNION hx (FOLDR FUNION FEMPTY hL)) SUBSET (FDOM h2)` suffices_by (STRIP_TAC THEN 6731 `DISJOINT (FDOM h1) (FDOM h') /\ 6732 DISJOINT (FDOM h1) (FDOM (FUNION hx (FOLDR FUNION FEMPTY hL))) /\ 6733 DISJOINT (FDOM h1') (FDOM h') /\ 6734 DISJOINT (FDOM h1') (FDOM (FUNION hx (FOLDR FUNION FEMPTY hL)))` by ( 6735 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 6736 FDOM_DOMSUB, IN_DELETE, SUBSET_DEF] THEN 6737 METIS_TAC[] 6738 ) THEN 6739 ASM_SIMP_TAC std_ss [FUNION_EQ] 6740 ) THEN 6741 `!h'. MEM h' hL ==> FDOM h' SUBSET FDOM h2` suffices_by (STRIP_TAC THEN 6742 SIMP_TAC std_ss [FDOM_FUNION, UNION_SUBSET] THEN 6743 CONJ_TAC THENL [ 6744 FULL_SIMP_TAC std_ss [SUBMAP_DEF, SUBSET_DEF], 6745 6746 POP_ASSUM MP_TAC THEN 6747 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6748 Induct_on `hL` THENL [ 6749 SIMP_TAC list_ss [FDOM_FEMPTY, EMPTY_SUBSET], 6750 6751 FULL_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM, FDOM_FUNION, 6752 UNION_SUBSET] 6753 ] 6754 ] 6755 ) THEN 6756 SIMP_TAC std_ss [MEM_EL] THEN 6757 REPEAT STRIP_TAC THEN 6758 Q.PAT_X_ASSUM `!n. P n` (fn thm => (MP_TAC (Q.SPEC `SUC n` thm))) THEN 6759 ASM_SIMP_TAC list_ss [SUBMAP_DEF, SUBSET_DEF], 6760 6761 6762 6763 FULL_SIMP_TAC list_ss [REPLACE_ELEMENT_def] THEN 6764 Q.PAT_X_ASSUM `!nx h''. P nx h''` (fn thm => 6765 MP_TAC (Q.SPECL [`n`, `DRESTRICT h' (COMPL (FDOM (h:('b, 'c) heap)))`] thm)) THEN 6766 ASM_SIMP_TAC std_ss [] THEN 6767 `DISJOINT (FDOM (h:('b, 'c) heap)) (FDOM (FOLDR FUNION FEMPTY (hL:('b, 'c) heap list)))` by ( 6768 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 6769 Q.PAT_X_ASSUM `!y. MEM y hL ==> P y` MP_TAC THEN 6770 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6771 Induct_on `hL` THENL [ 6772 SIMP_TAC list_ss [FDOM_FEMPTY, DISJOINT_EMPTY], 6773 6774 FULL_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM, FDOM_FUNION, 6775 DISJOINT_UNION_BOTH, DISJOINT_SYM] 6776 ] 6777 ) THEN 6778 6779 `FOLDR FUNION FEMPTY hL = DRESTRICT (FUNION h1 h') (COMPL (FDOM h))` by 6780 METIS_TAC[DRESTRICT_EQ_FUNION] THEN 6781 `DISJOINT (FDOM h) (FDOM h1) /\ 6782 DISJOINT (FDOM h) (FDOM hx) /\ 6783 h SUBMAP h2` by ( 6784 Q.PAT_X_ASSUM `!n. P n` (fn thm => (MP_TAC (Q.SPEC `0` thm))) THEN 6785 ASM_SIMP_TAC list_ss [SUBMAP_DEF, SUBSET_DEF, DISJOINT_SYM] 6786 ) THEN 6787 6788 `DRESTRICT (FUNION h1 h') (COMPL (FDOM h)) = 6789 FUNION h1 (DRESTRICT h' (COMPL (FDOM h)))` by ( 6790 Q.PAT_X_ASSUM `DISJOINT (FDOM h) (FDOM h1)` MP_TAC THEN 6791 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6792 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, DRESTRICT_DEF, DISJOINT_DEF, 6793 NOT_IN_EMPTY, IN_INTER, FUNION_DEF, IN_UNION, IN_COMPL, 6794 DISJ_IMP_THM] THEN 6795 METIS_TAC[] 6796 ) THEN 6797 FULL_SIMP_TAC std_ss [DRESTRICT_DEF, SUBSET_DEF, IN_INTER] THEN 6798 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 6799 CONJ_TAC THEN1 ( 6800 GEN_TAC THEN STRIP_TAC THEN 6801 Q.PAT_X_ASSUM `!n. P n` (fn thm => (MP_TAC (Q.SPEC `SUC n'` thm))) THEN 6802 ASM_SIMP_TAC list_ss [] 6803 ) THEN 6804 SIMP_TAC std_ss [] THEN 6805 STRIP_TAC THEN 6806 `DISJOINT (FDOM h) (FDOM h1')` by ( 6807 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6808 Q.PAT_X_ASSUM `h SUBMAP h2` MP_TAC THEN 6809 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6810 6811 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 6812 METIS_TAC[] 6813 ) THEN 6814 `(!Y. FUNION h (FUNION h1 Y) = FUNION h1 (FUNION h Y)) /\ 6815 (!Y. FUNION h (FUNION h1' Y) = FUNION h1' (FUNION h Y))` by METIS_TAC[FUNION___ASSOC, 6816 FUNION___COMM] THEN 6817 Q.PAT_X_ASSUM `Y = FUNION h1 h'` MP_TAC THEN 6818 ASM_REWRITE_TAC[] THEN 6819 6820 `DISJOINT (FDOM h1) (FDOM (FUNION h (DRESTRICT h' (COMPL (FDOM h))))) /\ 6821 DISJOINT (FDOM h1) (FDOM h') /\ 6822 DISJOINT (FDOM h1') (FDOM (FUNION h (DRESTRICT h' (COMPL (FDOM h))))) /\ 6823 DISJOINT (FDOM h1') (FDOM h')` by ( 6824 ASM_SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_UNION_BOTH] THEN 6825 Q.PAT_X_ASSUM `!x. x IN FDOM h' ==> P x` MP_TAC THEN 6826 Q.PAT_X_ASSUM `DISJOINT (FDOM h1) (FDOM h2)` MP_TAC THEN 6827 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6828 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6829 6830 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 6831 DRESTRICT_DEF] THEN 6832 METIS_TAC[] 6833 ) THEN 6834 ASM_SIMP_TAC std_ss [FUNION_EQ] 6835 ] 6836 ], 6837 6838 6839 6840 POP_ASSUM MP_TAC THEN 6841 ASM_SIMP_TAC std_ss [MEM_EL, REPLACE_ELEMENT_SEM] THEN 6842 STRIP_TAC THEN 6843 ASM_SIMP_TAC std_ss [REPLACE_ELEMENT_SEM] THEN 6844 Cases_on `n'''' = nx` THENL [ 6845 ASM_SIMP_TAC std_ss [] THEN 6846 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6847 Q.PAT_X_ASSUM `hx SUBMAP h2` MP_TAC THEN 6848 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6849 6850 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 6851 DRESTRICT_DEF, FUNION_DEF, IN_UNION, DISJ_IMP_THM], 6852 6853 6854 ASM_SIMP_TAC std_ss [] THEN 6855 `EL n'''' hL SUBMAP h2` by METIS_TAC[MEM_EL] THEN 6856 POP_ASSUM MP_TAC THEN 6857 Q.PAT_X_ASSUM `DISJOINT (FDOM h1') (FDOM h2)` MP_TAC THEN 6858 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6859 6860 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 6861 FUNION_DEF, IN_UNION, DISJ_IMP_THM] THEN 6862 METIS_TAC[] 6863 ], 6864 6865 6866 Cases_on `n'''' = nx` THENL [ 6867 ASM_SIMP_TAC std_ss [] THEN 6868 METIS_TAC[SF_SEM___sf_tree_len_THM], 6869 6870 ASM_SIMP_TAC std_ss [] THEN 6871 METIS_TAC[SF_SEM___sf_tree_len_THM] 6872 ], 6873 6874 6875 Q.EXISTS_TAC `(FUNION h1' hx)` THEN 6876 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION, MEM_EL] THEN 6877 Q.EXISTS_TAC `nx` THEN 6878 ASM_SIMP_TAC std_ss [REPLACE_ELEMENT_SEM] THEN 6879 METIS_TAC[], 6880 6881 6882 `x IN FDOM (FOLDR FUNION FEMPTY hL)` by ( 6883 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE, FDOM_FUNION, IN_UNION] 6884 ) THEN 6885 `?h. MEM h hL /\ x IN FDOM h` by ( 6886 POP_ASSUM MP_TAC THEN 6887 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 6888 6889 Induct_on `hL` THENL [ 6890 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY], 6891 6892 SIMP_TAC list_ss [FDOM_FEMPTY, NOT_IN_EMPTY, FDOM_FUNION, IN_UNION] THEN 6893 METIS_TAC[] 6894 ] 6895 ) THEN 6896 `?n1. (n1 < LENGTH hL) /\ (h = EL n1 hL)` by METIS_TAC[MEM_EL] THEN 6897 Cases_on `n1 = nx` THENL [ 6898 Q.EXISTS_TAC `(FUNION h1' hx)` THEN 6899 Q.PAT_X_ASSUM `x IN FDOM h` MP_TAC THEN 6900 `~(x IN FDOM h1)` by ( 6901 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 6902 METIS_TAC[] 6903 ) THEN 6904 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION, MEM_EL] THEN 6905 STRIP_TAC THEN 6906 Q.EXISTS_TAC `nx` THEN 6907 ASM_SIMP_TAC std_ss [REPLACE_ELEMENT_SEM] THEN 6908 METIS_TAC[], 6909 6910 6911 Q.EXISTS_TAC `EL n1 hL` THEN 6912 CONJ_TAC THENL [ 6913 REWRITE_TAC[MEM_EL] THEN 6914 Q.EXISTS_TAC `n1` THEN 6915 ASM_SIMP_TAC std_ss [REPLACE_ELEMENT_SEM] THEN 6916 METIS_TAC[], 6917 6918 METIS_TAC[] 6919 ] 6920 ] 6921 ] 6922 ], 6923 6924 6925 6926 FULL_SIMP_TAC std_ss [GSYM sf_ls_def] THEN 6927 6928 MP_TAC ( 6929 Q.SPECL [`s`, `FUNION h1 (h2:('b, 'c) heap)`, `h1`, `f`, `e`, `e2'`, `e1'`, `es`] LEMMA_29) THEN 6930 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID] THEN 6931 SIMP_TAC std_ss [SF_SEM___STAR_THM, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 6932 FDOM_FUNION, DISJOINT_UNION_BOTH] THEN 6933 REPEAT STRIP_TAC THEN 6934 6935 `h1''' = h1` by ( 6936 `SF_IS_PRECISE (sf_ls f e2' e1')` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 6937 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 6938 POP_ASSUM MATCH_MP_TAC THEN 6939 Q.EXISTS_TAC `s` THEN 6940 Q.EXISTS_TAC `FUNION h1 h2` THEN 6941 REWRITE_TAC [SUBMAP___FUNION___ID] THEN 6942 ASM_SIMP_TAC std_ss [SUBMAP___FUNION_EQ, SUBMAP___FUNION___ID] 6943 ) THEN 6944 `h2 = FUNION h1'' h2''` by ( 6945 Q.PAT_X_ASSUM `FUNION h1 h2 = Y` MP_TAC THEN 6946 `FUNION h1'' (FUNION h1''' h2'') = 6947 FUNION h1''' (FUNION h1'' h2'')` by METIS_TAC[FUNION___COMM, FUNION___ASSOC] THEN 6948 ` DISJOINT (FDOM h1) (FDOM (FUNION h1'' h2''))` by ( 6949 FULL_SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_SYM, DISJOINT_UNION_BOTH] 6950 ) THEN 6951 METIS_TAC [FUNION_EQ] 6952 ) THEN 6953 Q.PAT_X_ASSUM `FUNION h1 h2 = Y` (K ALL_TAC) THEN 6954 FULL_SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_UNION_BOTH] THEN 6955 6956 `SF_SEM s (FUNION h1'' h1') (sf_ls f e e1')` by ( 6957 `DS_POINTER_DANGLES s h1'' e1'` by ( 6958 `~DS_POINTER_DANGLES s h2'' e1'` by METIS_TAC[SF_SEM___sf_ls___ROOT_DANGLES, 6959 DS_EXPRESSION_EQUAL_def] THEN 6960 6961 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 6962 METIS_TAC[] 6963 ) THEN 6964 6965 MATCH_MP_TAC LEMMA_25 THEN 6966 Q.EXISTS_TAC `e2'` THEN 6967 ASM_SIMP_TAC std_ss [] 6968 ) THEN 6969 6970 `SF_SEM s (FUNION (FUNION h1'' h1') h2'') (sf_ls f e es)` by ( 6971 MATCH_MP_TAC LEMMA_25 THEN 6972 Q.EXISTS_TAC `e1'` THEN 6973 FULL_SIMP_TAC std_ss [DISJOINT_UNION_BOTH, FDOM_FUNION, DISJOINT_SYM] THEN 6974 6975 `DS_POINTER_DANGLES s (FUNION h1 (FUNION h1'' h2'')) es` by METIS_TAC[LEMMA_3_1_1___sf_ls] THEN 6976 POP_ASSUM MP_TAC THEN 6977 Q.PAT_X_ASSUM `DS_POINTER_DANGLES s h1' es` MP_TAC THEN 6978 SIMP_TAC std_ss [DS_POINTER_DANGLES, FDOM_FUNION, IN_UNION, DISJ_IMP_THM] 6979 ) THEN 6980 `FUNION h1' (FUNION h1'' h2'') = FUNION (FUNION h1'' h1') h2''` by METIS_TAC[FUNION___COMM, FUNION___ASSOC] THEN 6981 METIS_TAC[] 6982]); 6983 6984 6985 6986 6987val BALANCED_SF_SEM___sf_tree_len___MODEL_EXISTS = store_thm ("BALANCED_SF_SEM___sf_tree_len___MODEL_EXISTS", 6988 ``!s fL n es e X. ((FINITE (X:'b set)) /\ INFINITE (UNIV:'b set) /\ 6989 (ALL_DISTINCT fL) /\ 6990 ((n = 0) ==> DS_EXPRESSION_EQUAL s es e) /\ 6991 (~(n = 0) ==> ( 6992 ~DS_EXPRESSION_EQUAL s es e /\ 6993 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s e)))) ==> 6994 (?h. (BALANCED_SF_SEM___sf_tree_len s h fL n es e) /\ 6995 (!h'. h' IN (FRANGE h) ==> (FDOM h' = LIST_TO_SET fL)) /\ 6996 (DISJOINT (FDOM h DIFF ( 6997 if IS_DSV_NIL(DS_EXPRESSION_EVAL s e) then {} else 6998 {DS_EXPRESSION_EVAL_VALUE s e})) X))``, 6999 7000 7001Cases_on `n` THENL [ 7002 SIMP_TAC std_ss [BALANCED_SF_SEM___sf_tree_len_def, FDOM_FEMPTY, EMPTY_DIFF, DISJOINT_EMPTY, 7003 DS_EXPRESSION_EQUAL_def, PF_SEM_def, FRANGE_FEMPTY, NOT_IN_EMPTY], 7004 7005 SIMP_TAC arith_ss [] THEN 7006 Induct_on `n'` THENL [ 7007 REWRITE_TAC [BALANCED_SF_SEM___sf_tree_len_def] THEN 7008 SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 7009 REPEAT STRIP_TAC THEN 7010 Q.EXISTS_TAC `FEMPTY |+ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e), 7011 FUN_FMAP (\x. DS_EXPRESSION_EVAL s es) (LIST_TO_SET fL))` THEN 7012 7013 ASM_SIMP_TAC std_ss [FDOM_FUPDATE, DISJOINT_DEF, IN_INSERT, EXTENSION, NOT_IN_EMPTY, 7014 IN_DIFF, IN_INSERT, IN_INTER, FDOM_FEMPTY, DS_EXPRESSION_EVAL_VALUE_def, 7015 FRANGE_FUPDATE, DRESTRICT_FEMPTY, FRANGE_FEMPTY, NOT_IN_EMPTY, 7016 FUN_FMAP_DEF, FINITE_LIST_TO_SET] THEN 7017 7018 Q.EXISTS_TAC `MAP (\x. FEMPTY) fL` THEN 7019 ASM_SIMP_TAC list_ss [MAP_MAP_o, combinTheory.o_DEF, FDOM_FEMPTY, 7020 DOMSUB_FUPDATE, DOMSUB_FEMPTY, EVERY_MEM, MEM_ZIP, EL_MAP, GSYM LEFT_FORALL_IMP_THM, 7021 HEAP_READ_ENTRY_def, FDOM_FUPDATE, IN_SING, 7022 FAPPLY_FUPDATE_THM, FUN_FMAP_DEF, FINITE_LIST_TO_SET, EL_IS_EL, 7023 MEM_MAP] THEN 7024 7025 Induct_on `fL` THENL [ 7026 SIMP_TAC list_ss [ALL_DISJOINT_def], 7027 7028 ASM_SIMP_TAC list_ss [ALL_DISJOINT_def, FUNION_FEMPTY_1, EVERY_MEM, 7029 DISJOINT_EMPTY] 7030 ], 7031 7032 7033 7034 7035 REPEAT STRIP_TAC THEN 7036 ONCE_REWRITE_TAC [BALANCED_SF_SEM___sf_tree_len_def] THEN 7037 FULL_SIMP_TAC std_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 7038 7039 `?fL'. (ALL_DISTINCT fL') /\ 7040 (!x. MEM x fL ==> MEM x fL') /\ 7041 (LIST_TO_SET fL = LIST_TO_SET fL') /\ 7042 (!s h. BALANCED_SF_SEM___sf_tree_len s h fL = 7043 BALANCED_SF_SEM___sf_tree_len s h fL')` by METIS_TAC[] THEN 7044 ASM_REWRITE_TAC[] THEN 7045 NTAC 2 (POP_ASSUM (fn thm => ALL_TAC)) THEN 7046 Induct_on `fL` THENL [ 7047 SIMP_TAC list_ss [LENGTH_NIL, ALL_DISJOINT_def] THEN 7048 Q.EXISTS_TAC `FEMPTY |+ (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e), 7049 FUN_FMAP (\x. dsv_nil) (LIST_TO_SET fL'))` THEN 7050 ASM_SIMP_TAC list_ss [FDOM_FUPDATE, IN_INSERT, DOMSUB_FUPDATE, DOMSUB_FEMPTY, 7051 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, IN_DIFF, FDOM_FEMPTY, 7052 DS_EXPRESSION_EVAL_VALUE_def, FRANGE_FUPDATE, FRANGE_FEMPTY, DRESTRICT_FEMPTY, 7053 FUN_FMAP_DEF, FINITE_LIST_TO_SET], 7054 7055 7056 7057 7058 FULL_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM] THEN 7059 REPEAT STRIP_TAC THEN 7060 FULL_SIMP_TAC list_ss [] THEN 7061 7062 `?c. ~(c IN ((DS_EXPRESSION_EVAL_VALUE s es) INSERT (X UNION (FDOM (h':('b, 'c) heap)))))` by ( 7063 MATCH_MP_TAC 7064 (REWRITE_RULE [IN_UNIV] (Q.SPEC `UNIV` IN_INFINITE_NOT_FINITE)) THEN 7065 ASM_SIMP_TAC std_ss [FINITE_UNION, FDOM_FINITE, FINITE_INSERT] 7066 ) THEN 7067 7068 7069 Q.PAT_X_ASSUM `!s' fL'. P s' fL'` (fn thm => ( 7070 MP_TAC (Q.SPECL [`s`, `fL'`, `es`, `dse_const (dsv_const c)`, `X UNION 7071 (FDOM (h':('b, 'c) heap))`] thm))) THEN 7072 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 7073 CONJ_TAC THEN1 ( 7074 FULL_SIMP_TAC list_ss [FINITE_UNION, FDOM_FINITE, 7075 DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def, 7076 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7077 IN_INSERT, IN_UNION, DS_EXPRESSION_EVAL_VALUE_def] THEN 7078 Cases_on `DS_EXPRESSION_EVAL s es` THENL [ 7079 SIMP_TAC std_ss [ds_value_distinct], 7080 FULL_SIMP_TAC std_ss [ds_value_11, GET_DSV_VALUE_def] 7081 ] 7082 ) THEN 7083 7084 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 7085 GSYM LEFT_EXISTS_AND_THM] THEN 7086 STRIP_TAC THEN 7087 `?h''''. h'''' = ((FUNION h' h'') |+ 7088 (DS_EXPRESSION_EVAL_VALUE s e, 7089 (h' ' (DS_EXPRESSION_EVAL_VALUE s e)) |+ (h, dsv_const c)))` by METIS_TAC[] THEN 7090 7091 Q.EXISTS_TAC `h''''` THEN 7092 Q.EXISTS_TAC `h''::hL` THEN 7093 7094 ASM_SIMP_TAC list_ss [FDOM_FUPDATE, IN_INSERT, DS_EXPRESSION_EVAL_VALUE_def, 7095 HEAP_READ_ENTRY_THM, FAPPLY_FUPDATE_THM, ALL_DISJOINT_def] THEN 7096 7097 REPEAT STRIP_TAC THENL [ 7098 Q.PAT_X_ASSUM `EVERY IS_SOME Z` MP_TAC THEN 7099 SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, 7100 GSYM LEFT_FORALL_IMP_THM, HEAP_READ_ENTRY_THM, 7101 FDOM_FUPDATE, IN_INSERT, FAPPLY_FUPDATE_THM] THEN 7102 METIS_TAC[], 7103 7104 `DISJOINT (FDOM h'') (FDOM (FOLDR FUNION FEMPTY hL))` suffices_by (STRIP_TAC THEN 7105 POP_ASSUM MP_TAC THEN 7106 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 7107 Induct_on `hL` THENL [ 7108 SIMP_TAC list_ss [], 7109 FULL_SIMP_TAC list_ss [FUNION_DEF, DISJOINT_UNION_BOTH, DISJOINT_SYM] 7110 ] 7111 ) THEN 7112 FULL_SIMP_TAC list_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7113 FDOM_DOMSUB, IN_DELETE, IN_DIFF, IN_SING, IN_UNION, DS_EXPRESSION_EVAL_VALUE_def, 7114 IN_INSERT] THEN 7115 METIS_TAC[], 7116 7117 7118 ASM_SIMP_TAC std_ss [DOMSUB_FUPDATE, DOMSUB_FUNION] THEN 7119 `h'' \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) = h''` by ( 7120 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, IN_INSERT, IN_UNION, 7121 FDOM_DOMSUB, EXTENSION, IN_DELETE, DOMSUB_FAPPLY_THM, 7122 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7123 IN_DIFF] THEN 7124 METIS_TAC[] 7125 ) THEN 7126 ASM_REWRITE_TAC[] THEN 7127 7128 MATCH_MP_TAC FUNION___COMM THEN 7129 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7130 FDOM_DOMSUB, IN_DELETE, IN_INSERT, IN_UNION, IN_SING, IN_DIFF] THEN 7131 METIS_TAC[], 7132 7133 7134 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FDOM_FUPDATE, IN_INSERT, 7135 FAPPLY_FUPDATE_THM], 7136 7137 7138 `(MAP (HEAP_READ_ENTRY s h' e) fL) = 7139 (MAP (HEAP_READ_ENTRY s h'''' e) fL)` suffices_by (STRIP_TAC THEN 7140 7141 Q.PAT_X_ASSUM `h'''' = XXX` (MP_TAC o GSYM) THEN 7142 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] 7143 ) THEN 7144 ASM_SIMP_TAC std_ss [MAP_EQ_f] THEN 7145 REPEAT STRIP_TAC THEN 7146 `IS_SOME (HEAP_READ_ENTRY s h' e e')` by ( 7147 FULL_SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] 7148 ) THEN 7149 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 7150 `~(e' = h)` by METIS_TAC[] THEN 7151 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, FDOM_FUPDATE, 7152 DS_EXPRESSION_EVAL_VALUE_def, IN_INSERT, FAPPLY_FUPDATE_THM], 7153 7154 7155 Q.PAT_X_ASSUM `h''' IN FRANGE Y` MP_TAC THEN 7156 ASM_SIMP_TAC list_ss [FRANGE_DEF, GSPECIFICATION] THEN 7157 HO_MATCH_MP_TAC (prove (``(!x. P x ==> (Q x ==> Y)) ==> 7158 ((?x. (P x /\ Q x)) ==> Y)``, METIS_TAC[])) THEN 7159 SIMP_TAC std_ss [FDOM_FUPDATE, IN_INSERT] THEN 7160 HO_MATCH_MP_TAC (prove (``((!x. (P1 x ==> Q x)) /\ 7161 (!x. (~P1 x /\ P2 x) ==> Q x)) ==> 7162 (!x. (P1 x \/ P2 x) ==> Q x)``, METIS_TAC[])) THEN 7163 SIMP_TAC std_ss [FAPPLY_FUPDATE_THM, FUNION_DEF, IN_UNION] THEN 7164 SIMP_TAC std_ss [Once EQ_SYM_EQ] THEN 7165 FULL_SIMP_TAC std_ss [FRANGE_DEF, GSPECIFICATION, GSYM LEFT_FORALL_IMP_THM] THEN 7166 7167 CONJ_TAC THENL [ 7168 ASM_SIMP_TAC list_ss [FDOM_FUPDATE, EXTENSION, IN_INSERT] THEN 7169 METIS_TAC[], 7170 7171 METIS_TAC[] 7172 ], 7173 7174 7175 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, DISJOINT_DEF, 7176 NOT_IN_EMPTY, IN_INSERT, IN_DIFF, FUNION_DEF, IN_UNION, DS_EXPRESSION_EVAL_VALUE_def] THEN 7177 METIS_TAC[] 7178 ] 7179 ] 7180 ] 7181]); 7182 7183 7184 7185val BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE = store_thm ("BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE", 7186 ``!s h fL es e. BALANCED_SF_SEM___sf_tree_len s h fL 1 es e ==> 7187 (~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) /\ 7188 (FDOM h = {DS_EXPRESSION_EVAL_VALUE s e}))``, 7189 7190 REWRITE_TAC [prove (``1 = SUC 0``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def] THEN 7191 REPEAT STRIP_TAC THEN 7192 `FOLDR FUNION FEMPTY hL = FEMPTY` suffices_by (STRIP_TAC THEN 7193 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, NOT_IN_EMPTY, EXTENSION, 7194 FDOM_DOMSUB, SING_DEF, IN_SING, IN_DELETE, DS_EXPRESSION_EVAL_VALUE_def] THEN 7195 METIS_TAC[] 7196 ) THEN 7197 `EVERY (\h. h = FEMPTY) hL` suffices_by (STRIP_TAC THEN 7198 POP_ASSUM MP_TAC THEN 7199 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 7200 Induct_on `hL` THENL [ 7201 SIMP_TAC list_ss [], 7202 ASM_SIMP_TAC list_ss [FUNION_FEMPTY_1] 7203 ] 7204 ) THEN 7205 Q.PAT_X_ASSUM `EVERY X (ZIP (cL,hL))` MP_TAC THEN 7206 ASM_SIMP_TAC std_ss [EVERY_MEM, MEM_ZIP, GSYM LEFT_FORALL_IMP_THM] THEN 7207 METIS_TAC[MEM_EL] 7208) 7209 7210 7211 7212 7213val BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS = store_thm ("BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS", 7214``!s fL es e X. ((FINITE (X:'b set)) /\ INFINITE (UNIV:'b set) /\ 7215 (ALL_DISTINCT fL) /\ ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) /\ 7216 ~(DS_EXPRESSION_EQUAL s es e)) ==> 7217 7218(?h2:('b, 'c) heap hl:('b, 'c) heap. 7219 (BALANCED_SF_SEM___sf_tree_len s (FUNION h2 hl) fL 2 es e) /\ 7220 (FDOM h2 = {DS_EXPRESSION_EVAL_VALUE s e}) /\ 7221 ((FDOM hl = EMPTY) = (fL = [])) /\ 7222 (DISJOINT (FDOM hl) (FDOM h2)) /\ 7223 (DISJOINT (FDOM hl) X) /\ 7224 (!x. x IN FDOM hl ==> (FDOM (hl ' x) = LIST_TO_SET fL)) /\ 7225 (FDOM (h2 ' (DS_EXPRESSION_EVAL_VALUE s e)) = LIST_TO_SET fL) /\ 7226 7227 (!x. ((?f. MEM f fL /\ (HEAP_READ_ENTRY s h2 e f = SOME (dsv_const x))) = 7228 (x IN FDOM hl))) /\ 7229 (!x f. MEM f fL /\ (x IN FDOM hl) ==> (HEAP_READ_ENTRY s hl (dse_const (dsv_const x)) f = 7230 SOME (DS_EXPRESSION_EVAL s es))) /\ 7231 (!f. MEM f fL ==> ?x. x IN FDOM hl /\ 7232 (h2 ' (DS_EXPRESSION_EVAL_VALUE s e) ' f = dsv_const x)) /\ 7233 (!f1 f2. MEM f1 fL /\ MEM f2 fL ==> (((h2 ' (DS_EXPRESSION_EVAL_VALUE s e) ' f1) = 7234 (h2 ' (DS_EXPRESSION_EVAL_VALUE s e) ' f2)) = 7235 (f1 = f2)))) 7236``, 7237 7238 7239REPEAT STRIP_TAC THEN 7240MP_TAC (Q.SPECL [`s`, `fL`, `2`, `es`, `e`, `X`] BALANCED_SF_SEM___sf_tree_len___MODEL_EXISTS) THEN 7241ASM_SIMP_TAC std_ss [] THEN 7242REPEAT STRIP_TAC THEN 7243`?h2. h2 = DRESTRICT h {DS_EXPRESSION_EVAL_VALUE s e}` by METIS_TAC[] THEN 7244`?hl. hl = h \\ (DS_EXPRESSION_EVAL_VALUE s e)` by METIS_TAC[] THEN 7245Q.EXISTS_TAC `h2` THEN 7246Q.EXISTS_TAC `hl` THEN 7247REPEAT STRIP_TAC THENL [ 7248 `FUNION h2 hl = h` suffices_by METIS_TAC[] THEN 7249 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, 7250 DRESTRICT_DEF, IN_INTER, IN_UNION, FDOM_DOMSUB, IN_DELETE, IN_SING, 7251 DISJ_IMP_THM, DOMSUB_FAPPLY_THM] THEN 7252 METIS_TAC[], 7253 7254 7255 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7256 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def] THEN 7257 ASM_SIMP_TAC std_ss [EXTENSION, DRESTRICT_DEF, IN_INTER, IN_SING, 7258 DS_EXPRESSION_EVAL_VALUE_def] THEN 7259 METIS_TAC[], 7260 7261 7262 EQ_TAC THEN STRIP_TAC THENL [ 7263 CCONTR_TAC THEN 7264 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7265 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def] THEN 7266 FULL_SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 7267 Cases_on `fL` THEN FULL_SIMP_TAC std_ss [] THEN 7268 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 7269 REWRITE_TAC [prove (``(a \/ b) = (~a ==> b)``, METIS_TAC[])] THEN 7270 REPEAT STRIP_TAC THEN 7271 `?x. FDOM h'' = {x}` by METIS_TAC[BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7272 FULL_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, NOT_IN_EMPTY, FDOM_DOMSUB, IN_DELETE, IN_SING, 7273 FUNION_DEF, IN_UNION, DS_EXPRESSION_EVAL_VALUE_def] THEN 7274 METIS_TAC[], 7275 7276 7277 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7278 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def] THEN 7279 FULL_SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def, 7280 LENGTH_NIL, DS_EXPRESSION_EVAL_VALUE_def, 7281 EXTENSION, GSYM fmap_EQ_THM, FDOM_FEMPTY, NOT_IN_EMPTY] 7282 ], 7283 7284 7285 ASM_REWRITE_TAC[] THEN 7286 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7287 FDOM_DOMSUB, IN_DELETE, DRESTRICT_DEF, IN_SING], 7288 7289 7290 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7291 FDOM_DOMSUB, IN_DELETE, IN_DIFF, IN_SING], 7292 7293 Q.PAT_X_ASSUM `x IN FDOM hl` MP_TAC THEN 7294 FULL_SIMP_TAC std_ss [FRANGE_DEF, GSPECIFICATION, GSYM LEFT_FORALL_IMP_THM, 7295 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM], 7296 7297 7298 FULL_SIMP_TAC std_ss [FRANGE_DEF, GSPECIFICATION, GSYM LEFT_FORALL_IMP_THM, 7299 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM, DRESTRICT_DEF, IN_INTER, IN_SING] THEN 7300 `DS_EXPRESSION_EVAL_VALUE s e IN FDOM h` suffices_by (STRIP_TAC THEN 7301 ASM_SIMP_TAC std_ss [] 7302 ) THEN 7303 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7304 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def, 7305 DS_EXPRESSION_EVAL_VALUE_def] THEN 7306 METIS_TAC[], 7307 7308 7309 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7310 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7311 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_THM, FDOM_DOMSUB, IN_DELETE, DRESTRICT_DEF, 7312 IN_INTER, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, RIGHT_EXISTS_AND_THM, LEFT_EXISTS_AND_THM] THEN 7313 REPEAT STRIP_TAC THEN 7314 EQ_TAC THENL [ 7315 STRIP_TAC THEN 7316 `?n h'. n < LENGTH hL /\ (EL n hL = h') /\ (EL n fL = f) /\ (MEM h' hL)` by METIS_TAC[MEM_EL] THEN 7317 `BALANCED_SF_SEM___sf_tree_len s h' fL 1 es (dse_const (dsv_const x))` by METIS_TAC[] THEN 7318 `FDOM h' = {DS_EXPRESSION_EVAL_VALUE s (dse_const (dsv_const x))}` by METIS_TAC[ 7319 BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7320 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] THEN 7321 CONJ_TAC THEN1 ( 7322 METIS_TAC[IN_SING, SUBMAP_DEF] 7323 ) THEN 7324 `~((GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) IN FDOM (FOLDR FUNION FEMPTY hL))` by ( 7325 ASM_REWRITE_TAC[FDOM_DOMSUB, IN_DELETE, DS_EXPRESSION_EVAL_VALUE_def] 7326 ) THEN 7327 `x IN FDOM (FOLDR FUNION FEMPTY hL)` suffices_by METIS_TAC[] THEN 7328 7329 Q.PAT_X_ASSUM `FDOM h' = Y` MP_TAC THEN 7330 Q.PAT_X_ASSUM `MEM h' hL` MP_TAC THEN 7331 REPEAT (POP_ASSUM (fn thm => ALL_TAC)) THEN 7332 Induct_on `hL` THENL [ 7333 SIMP_TAC list_ss [], 7334 ASM_SIMP_TAC list_ss [FDOM_FUNION, IN_UNION, DISJ_IMP_THM, IN_SING] 7335 ], 7336 7337 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def, 7338 ds_value_11] THEN 7339 STRIP_TAC THEN 7340 `?h'. MEM h' hL /\ x IN FDOM h'` by METIS_TAC[] THEN 7341 `?n f. (n < LENGTH hL) /\ (EL n fL = f) /\ MEM f fL /\ (EL n hL = h')` by METIS_TAC[MEM_EL] THEN 7342 Q.EXISTS_TAC `f` THEN 7343 ASM_SIMP_TAC std_ss [] THEN 7344 `BALANCED_SF_SEM___sf_tree_len s h' fL 1 es (dse_const (h ' v ' f))` by METIS_TAC[] THEN 7345 `~(IS_DSV_NIL (DS_EXPRESSION_EVAL s (dse_const (h ' v ' f)))) /\ 7346 (FDOM h' = {DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' v ' f))})` by METIS_TAC[ 7347 BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7348 FULL_SIMP_TAC std_ss [IN_SING, DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, 7349 dsv_const_GET_DSV_VALUE] 7350 ], 7351 7352 7353 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7354 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7355 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_THM, FDOM_DOMSUB, IN_DELETE, DRESTRICT_DEF, 7356 IN_INTER, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, RIGHT_EXISTS_AND_THM, LEFT_EXISTS_AND_THM, 7357 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, DOMSUB_FAPPLY_THM, IS_DSV_NIL_def] THEN 7358 STRIP_TAC THEN 7359 Q.PAT_X_ASSUM `x IN FDOM hl` MP_TAC THEN 7360 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE, DS_EXPRESSION_EVAL_VALUE_def] THEN 7361 Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def, 7362 ds_value_11] THEN 7363 STRIP_TAC THEN 7364 `?h'. MEM h' hL /\ x IN FDOM h'` by METIS_TAC[] THEN 7365 `?n f. (n < LENGTH hL) /\ (EL n fL = f) /\ MEM f fL /\ (EL n hL = h')` by METIS_TAC[MEM_EL] THEN 7366 `BALANCED_SF_SEM___sf_tree_len s h' fL 1 es 7367 (dse_const (h ' v ' f'))` by METIS_TAC[] THEN 7368 `~(IS_DSV_NIL (DS_EXPRESSION_EVAL s (dse_const (h ' v ' f')))) /\ 7369 (FDOM h' = {DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' v ' f'))})` by METIS_TAC[ 7370 BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7371 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h' fL 1 es Y` MP_TAC THEN 7372 REWRITE_TAC [prove (``1 = SUC 0``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7373 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, 7374 IN_SING, DS_EXPRESSION_EVAL_VALUE_def, HEAP_READ_ENTRY_THM] THEN 7375 `(h ' v ' f') = dsv_const x` by ( 7376 Cases_on `h ' v ' f'` THEN 7377 FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] 7378 ) THEN 7379 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 7380 STRIP_TAC THEN 7381 `h ' x = h' ' x` by ( 7382 METIS_TAC[SUBMAP_DEF, IN_SING] 7383 ) THEN 7384 `?m. m < LENGTH fL /\ (EL m fL = f)` by METIS_TAC[MEM_EL] THEN 7385 METIS_TAC[], 7386 7387 7388 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7389 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7390 FULL_SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def] THEN 7391 STRIP_TAC THEN 7392 `?n. (n < LENGTH hL) /\ (EL n fL = f)` by METIS_TAC[MEM_EL] THEN 7393 `BALANCED_SF_SEM___sf_tree_len s (EL n hL) fL 1 es 7394 (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f))` by METIS_TAC[] THEN 7395 `(FDOM (EL n hL) = {DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f))}) /\ 7396 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f)))` by METIS_TAC[BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7397 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, NOT_IS_DSV_NIL_THM] THEN 7398 Q.PAT_X_ASSUM `Y = dsv_const c` ASSUME_TAC THEN 7399 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 7400 DRESTRICT_DEF, IN_INTER, IN_SING] THEN 7401 Q.EXISTS_TAC `c'` THEN 7402 Q.PAT_X_ASSUM `Y = h \\ c` (fn thm => REWRITE_TAC [GSYM thm]) THEN 7403 `?h'. (MEM h' hL) /\ (FDOM h' = {c'})` by METIS_TAC[MEM_EL] THEN 7404 NTAC 2 (POP_ASSUM MP_TAC) THEN 7405 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 7406 Induct_on `hL` THENL [ 7407 SIMP_TAC list_ss [], 7408 SIMP_TAC list_ss [FUNION_DEF, IN_UNION, DISJ_IMP_THM, IN_SING] THEN 7409 METIS_TAC[] 7410 ], 7411 7412 7413 Q.PAT_X_ASSUM `BALANCED_SF_SEM___sf_tree_len s h fL 2 es e` MP_TAC THEN 7414 REWRITE_TAC [prove (``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7415 FULL_SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EQUAL_def, DRESTRICT_DEF, 7416 IN_INTER, IN_SING, DS_EXPRESSION_EVAL_VALUE_def] THEN 7417 STRIP_TAC THEN 7418 ASM_SIMP_TAC std_ss [] THEN 7419 Cases_on `f1 = f2` THEN ASM_REWRITE_TAC[] THEN 7420 `?n1. (n1 < LENGTH hL) /\ (EL n1 fL = f1)` by METIS_TAC[MEM_EL] THEN 7421 `?n2. (n2 < LENGTH hL) /\ (EL n2 fL = f2)` by METIS_TAC[MEM_EL] THEN 7422 `~(n1 = n2)` by METIS_TAC[EL_ALL_DISTINCT_EQ] THEN 7423 `(BALANCED_SF_SEM___sf_tree_len s (EL n1 hL) fL 1 es 7424 (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' (EL n1 fL)))) /\ 7425 (BALANCED_SF_SEM___sf_tree_len s (EL n2 hL) fL 1 es 7426 (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' (EL n2 fL))))` by METIS_TAC[] THEN 7427 `(FDOM (EL n1 hL) = {DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f1))}) /\ 7428 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f1)))` by METIS_TAC[BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7429 `(FDOM (EL n2 hL) = {DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f2))}) /\ 7430 ~IS_DSV_NIL (DS_EXPRESSION_EVAL s (dse_const (h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e)) ' f2)))` by METIS_TAC[BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE] THEN 7431 `DISJOINT (FDOM (EL n1 hL)) (FDOM (EL n2 hL))` by ( 7432 FULL_SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP] THEN 7433 METIS_TAC[NOT_EMPTY_SING] 7434 ) THEN 7435 POP_ASSUM MP_TAC THEN 7436 7437 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, DS_EXPRESSION_EVAL_def, 7438 DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def, ds_value_11] THEN 7439 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, IN_SING, NOT_IN_EMPTY] 7440]); 7441 7442 7443 7444 7445 7446 7447val BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS_WITH_ELEMENT = store_thm ("BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS_WITH_ELEMENT", 7448``!s fL es e c X. ((FINITE (X:'b set)) /\ INFINITE (UNIV:'b set) /\ 7449 (ALL_DISTINCT fL) /\ ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) /\ 7450 ~(DS_EXPRESSION_EQUAL s es e) /\ ~(fL = []) /\ 7451 ~(DS_EXPRESSION_EQUAL s es (dse_const (dsv_const c))) /\ ~(c IN X)) ==> 7452 7453(?h:('b, 'c) heap. 7454 (BALANCED_SF_SEM___sf_tree_len s h fL 2 es e) /\ 7455 (DISJOINT (FDOM h DIFF {DS_EXPRESSION_EVAL_VALUE s e}) X) /\ 7456 (c IN FDOM h)) 7457``, 7458 7459 7460REPEAT STRIP_TAC THEN 7461MP_TAC (Q.SPECL [`s`, `fL`, `2`, `es`, `e`, `X`] BALANCED_SF_SEM___sf_tree_len___MODEL_EXISTS) THEN 7462ASM_SIMP_TAC std_ss [GSYM LEFT_FORALL_IMP_THM] THEN 7463GEN_TAC THEN 7464Cases_on `c IN FDOM h` THEN1 METIS_TAC[] THEN 7465 7466REWRITE_TAC[prove(``2 = SUC 1``, DECIDE_TAC)] THEN 7467SIMP_TAC std_ss [Once BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7468REWRITE_TAC[prove(``2 = SUC 1``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len_def] THEN 7469Cases_on `DS_EXPRESSION_EVAL s e` THEN FULL_SIMP_TAC std_ss [IS_DSV_NIL_def] THEN 7470SIMP_TAC list_ss [DS_EXPRESSION_EVAL_def, PF_SEM_def, GET_DSV_VALUE_def, 7471 DS_EXPRESSION_EVAL_VALUE_def, ds_value_11] THEN 7472REPEAT STRIP_TAC THEN 7473`?f fL'. fL = f::fL'` by ( 7474 Cases_on `fL` THEN FULL_SIMP_TAC list_ss [] 7475) THEN 7476`?h' hL'. hL = h'::hL'` by ( 7477 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] 7478) THEN 7479FULL_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM] THEN 7480 7481`?c'. GET_DSV_VALUE (h ' v ' f) = c'` by METIS_TAC[] THEN 7482Q.EXISTS_TAC `(h \\ c') |+ 7483 (v, h ' v |+ (f, dsv_const c)) |+ 7484 (c, h ' c')` THEN 7485 7486REPEAT STRIP_TAC THENL [ 7487 ALL_TAC, (*rotate 1*) 7488 7489 Q.PAT_X_ASSUM `DISJOINT Y X` MP_TAC THEN 7490 ASM_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_DIFF, 7491 GET_DSV_VALUE_def, IN_SING, FDOM_FUPDATE, IN_INSERT, FDOM_DOMSUB, IN_DELETE] THEN 7492 METIS_TAC[], 7493 7494 7495 SIMP_TAC std_ss [FDOM_FUPDATE, IN_INSERT] 7496] THEN 7497 7498Q.EXISTS_TAC `(FEMPTY |+ (c, h ' c'))::hL'` THEN 7499 7500`~(v = c)` by METIS_TAC[] THEN 7501`FDOM h' = {c'}` by ( 7502 `0 < SUC (LENGTH hL')` by DECIDE_TAC THEN 7503 RES_TAC THEN 7504 FULL_SIMP_TAC list_ss [] THEN 7505 METIS_TAC[BALANCED_SF_SEM___sf_tree_len_1___MODEL_SIZE, DS_EXPRESSION_EVAL_VALUE_def, 7506 DS_EXPRESSION_EVAL_def] 7507) THEN 7508`h' = DRESTRICT h {c'}` by ( 7509 POP_ASSUM MP_TAC THEN 7510 Q.PAT_X_ASSUM `h' SUBMAP h` MP_TAC THEN 7511 SIMP_TAC std_ss [SUBMAP_DEF, EXTENSION, GSYM fmap_EQ_THM, IN_SING, DRESTRICT_DEF, 7512 IN_INTER] THEN 7513 METIS_TAC[] 7514) THEN 7515 7516`~(v = c')` by ( 7517 Q.PAT_X_ASSUM `Y = h \\ v` MP_TAC THEN 7518 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, FDOM_FUNION, EXTENSION, 7519 IN_DELETE, IN_UNION, DRESTRICT_DEF, IN_INTER, IN_SING] THEN 7520 METIS_TAC[] 7521) THEN 7522`c' IN FDOM h` by METIS_TAC[SUBMAP_DEF, IN_SING] THEN 7523`~(c = c')` by METIS_TAC[] THEN 7524 7525REPEAT STRIP_TAC THENL [ 7526 SIMP_TAC std_ss [FDOM_FUPDATE, IN_INSERT], 7527 7528 Q.PAT_X_ASSUM `IS_SOME (HEAP_READ_ENTRY s h e f)` MP_TAC THEN 7529 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, GET_DSV_VALUE_def, 7530 IS_DSV_NIL_def, FDOM_FUPDATE, IN_INSERT, FAPPLY_FUPDATE_THM], 7531 7532 7533 SIMP_TAC std_ss [EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM] THEN 7534 REPEAT STRIP_TAC THEN 7535 `IS_SOME (HEAP_READ_ENTRY s h e y)` by METIS_TAC[] THEN 7536 POP_ASSUM MP_TAC THEN 7537 SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 7538 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_def, 7539 IS_DSV_NIL_def, FDOM_FUPDATE, IN_INSERT, FAPPLY_FUPDATE_THM], 7540 7541 7542 ASM_SIMP_TAC list_ss [], 7543 7544 7545 FULL_SIMP_TAC list_ss [ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 7546 FDOM_FUPDATE, FDOM_FEMPTY] THEN 7547 REPEAT STRIP_TAC THEN 7548 `y SUBMAP h` by METIS_TAC[] THEN 7549 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_SING] THEN 7550 METIS_TAC[SUBMAP_DEF], 7551 7552 7553 7554 `FOLDR FUNION FEMPTY hL' = DRESTRICT (h \\ v) (COMPL (FDOM h'))` by ( 7555 MATCH_MP_TAC DRESTRICT_EQ_FUNION THEN 7556 ASM_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, IN_SING, NOT_IN_EMPTY, 7557 IN_FDOM_FOLDR_UNION] THEN 7558 FULL_SIMP_TAC std_ss [ALL_DISJOINT_def, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 7559 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, IN_SING] THEN 7560 METIS_TAC[] 7561 ) THEN 7562 ASM_SIMP_TAC list_ss [] THEN 7563 SIMP_TAC std_ss [GSYM fmap_EQ_THM, DRESTRICT_DEF, EXTENSION, FUNION_DEF, 7564 FDOM_FUPDATE, IN_INSERT, FDOM_FEMPTY, NOT_IN_EMPTY, IN_SING, IN_INTER, 7565 IN_COMPL, IN_UNION, FDOM_DOMSUB, IN_DELETE, 7566 FAPPLY_FUPDATE_THM, DOMSUB_FAPPLY_THM] THEN 7567 METIS_TAC[], 7568 7569 7570 7571 ASM_SIMP_TAC list_ss [EVERY_MEM, DISJ_IMP_THM, FORALL_AND_THM] THEN 7572 CONJ_TAC THENL [ 7573 `0 < SUC (LENGTH hL')` by DECIDE_TAC THEN 7574 `BALANCED_SF_SEM___sf_tree_len s (EL 0 (h'::hL')) (f::fL') 1 es 7575 (dse_const (h ' v ' (EL 0 (f::fL'))))` by METIS_TAC[] THEN 7576 POP_ASSUM MP_TAC THEN 7577 REWRITE_TAC[prove (``1 = SUC 0``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 7578 ASM_SIMP_TAC list_ss [HEAP_READ_ENTRY_def, GET_DSV_VALUE_def, IS_DSV_NIL_def, 7579 DS_EXPRESSION_EVAL_def, FAPPLY_FUPDATE_THM, FDOM_FUPDATE, IN_INSERT, 7580 FDOM_FEMPTY, NOT_IN_EMPTY, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 7581 DOMSUB_FUPDATE, DOMSUB_FEMPTY] THEN 7582 Cases_on `h ' v ' f` THEN FULL_SIMP_TAC list_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 7583 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_SING] THEN 7584 REPEAT STRIP_TAC THENL [ 7585 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def], 7586 7587 Q.EXISTS_TAC `hL''` THEN 7588 FULL_SIMP_TAC std_ss [] THEN 7589 REPEAT STRIP_TAC THENL [ 7590 METIS_TAC[], 7591 METIS_TAC[], 7592 7593 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, DRESTRICT_DEF, FDOM_DOMSUB, 7594 IN_DELETE, FDOM_FEMPTY, IN_INTER, IN_SING, NOT_IN_EMPTY], 7595 7596 `h'' = FEMPTY` by METIS_TAC[MEM_EL] THEN 7597 ASM_SIMP_TAC std_ss [SUBMAP_DEF, FDOM_FEMPTY, NOT_IN_EMPTY] 7598 ] 7599 ], 7600 7601 7602 ASM_SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_FORALL_IMP_THM, EL_MAP, HEAP_READ_ENTRY_def, 7603 IS_DSV_NIL_def, GET_DSV_VALUE_def, FDOM_FUPDATE, IN_INSERT, FAPPLY_FUPDATE_THM] THEN 7604 REPEAT STRIP_TAC THEN 7605 `MEM (EL n fL') fL'` by METIS_TAC[MEM_EL] THEN 7606 `~((EL n fL') = f)` by METIS_TAC[] THEN 7607 `IS_SOME (HEAP_READ_ENTRY s h e (EL n fL'))` by METIS_TAC[] THEN 7608 Q.PAT_X_ASSUM `DS_EXPRESSION_EVAL s e = Y` ASSUME_TAC THEN 7609 FULL_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, GET_DSV_VALUE_def] THEN 7610 `SUC n < SUC (LENGTH hL')` by ASM_SIMP_TAC std_ss [] THEN 7611 RES_TAC THEN 7612 FULL_SIMP_TAC list_ss [] 7613 ] 7614]); 7615 7616 7617 7618 7619 7620val SF_SEM___sf_tree_len___MODEL_EXISTS = store_thm ("SF_SEM___sf_tree_len___MODEL_EXISTS", 7621 ``!s fL n es e X. ((FINITE (X:'b set)) /\ INFINITE (UNIV:'b set) /\ 7622 (ALL_DISTINCT fL) /\ 7623 7624 ((n = 0) \/ IS_DSV_NIL (DS_EXPRESSION_EVAL s e) ==> 7625 DS_EXPRESSION_EQUAL s es e)) ==> 7626 (?h. (SF_SEM___sf_tree_len s h fL n es e) /\ 7627 (DISJOINT (FDOM h DIFF ( 7628 if IS_DSV_NIL(DS_EXPRESSION_EVAL s e) then {} else 7629 {DS_EXPRESSION_EVAL_VALUE s e})) X))``, 7630 7631 REPEAT STRIP_TAC THEN 7632 MP_TAC (Q.SPECL [`s`, `fL`, `n`, `es`, `e`, `X`] BALANCED_SF_SEM___sf_tree_len___MODEL_EXISTS) THEN 7633 ASM_REWRITE_TAC[] THEN 7634 Cases_on `n` THENL [ 7635 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, FDOM_FEMPTY, EMPTY_DIFF, PF_SEM_def, 7636 DS_EXPRESSION_EQUAL_def, DISJOINT_EMPTY], 7637 7638 FULL_SIMP_TAC arith_ss [] THEN 7639 Cases_on `DS_EXPRESSION_EQUAL s es e` THENL [ 7640 STRIP_TAC THEN 7641 Q.EXISTS_TAC `FEMPTY` THEN 7642 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, FDOM_FEMPTY, EMPTY_DIFF, PF_SEM_def, 7643 DS_EXPRESSION_EQUAL_def, DISJOINT_EMPTY], 7644 7645 METIS_TAC[BALANCED_SF_SEM___sf_tree_len_THM] 7646 ] 7647 ]); 7648 7649 7650 7651 7652 7653 7654 7655val lemma_31_list = store_thm ("lemma_31_list", 7656 ``!s h sfL hs. ((LIST_SF_SEM s h sfL) /\ (FCARD hs = 1) /\ (hs SUBMAP h)) ==> 7657 (?sf' h'. (MEM sf' sfL) /\ 7658 (h' SUBMAP h) /\ (DISJOINT (FDOM hs) (FDOM h')) /\ 7659 (SF_SEM s (FUNION hs h') sf'))``, 7660 7661 Induct_on `sfL` THENL [ 7662 SIMP_TAC std_ss [LIST_SF_SEM_THM, SUBMAP_DEF, FDOM_FEMPTY, NOT_IN_EMPTY, FCARD_DEF] THEN 7663 REPEAT STRIP_TAC THEN 7664 `SING (FDOM hs)` by METIS_TAC[SING_IFF_CARD1, FDOM_FINITE] THEN 7665 FULL_SIMP_TAC std_ss [SING_DEF] THEN 7666 METIS_TAC[IN_SING], 7667 7668 REPEAT STRIP_TAC THEN 7669 Cases_on ` ?h''. 7670 h'' SUBMAP h' /\ DISJOINT (FDOM hs) (FDOM h'') /\ 7671 SF_SEM s (FUNION hs h'') h` THEN1 ( 7672 METIS_TAC[MEM] 7673 ) THEN 7674 `SING (FDOM hs)` by METIS_TAC[FCARD_DEF, SING_IFF_CARD1, FDOM_FINITE] THEN 7675 FULL_SIMP_TAC list_ss [LIST_SF_SEM_THM, SING_DEF] THEN 7676 `~(x IN FDOM h1)` by ( 7677 CCONTR_TAC THEN 7678 Q.PAT_X_ASSUM `!h''. P h''` MP_TAC THEN 7679 FULL_SIMP_TAC std_ss [] THEN 7680 Q.EXISTS_TAC `h1 \\ x` THEN 7681 FULL_SIMP_TAC std_ss [DISJOINT_DEF, FDOM_DOMSUB, EXTENSION, IN_INTER, NOT_IN_EMPTY, 7682 IN_SING, IN_DELETE, SUBMAP_DEF, FUNION_DEF, IN_UNION, DOMSUB_FAPPLY_THM] THEN 7683 `FUNION hs (h1 \\ x) = h1` 7684 suffices_by (STRIP_TAC THEN ASM_REWRITE_TAC []) THEN 7685 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, EXTENSION, FDOM_DOMSUB, 7686 IN_UNION, IN_DELETE, DOMSUB_FAPPLY_THM] THEN 7687 METIS_TAC[] 7688 ) THEN 7689 `hs SUBMAP h2` by ( 7690 Q.PAT_X_ASSUM `hs SUBMAP h'` MP_TAC THEN 7691 ASM_SIMP_TAC std_ss [SUBMAP_DEF, IN_UNION, IN_SING, 7692 FUNION_DEF] 7693 ) THEN 7694 `?sf' h'. 7695 MEM sf' sfL /\ h' SUBMAP h2 /\ DISJOINT (FDOM hs) (FDOM h') /\ 7696 SF_SEM s (FUNION hs h') sf'` by METIS_TAC[] THEN 7697 Q.EXISTS_TAC `sf'` THEN 7698 Q.EXISTS_TAC `h''` THEN 7699 ASM_SIMP_TAC std_ss [] THEN 7700 METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS, SUBMAP_REFL] 7701 ]); 7702 7703 7704 7705val LEMMA_31 = store_thm ("LEMMA_31", 7706 ``!s h sf hs. ((SF_SEM s h sf) /\ (FCARD hs = 1) /\ (hs SUBMAP h)) ==> 7707 (?sf' h' sf''. SF_IS_SIMPLE sf' /\ 7708 (SF_EXPRESSION_SET sf = SF_EXPRESSION_SET sf' UNION SF_EXPRESSION_SET sf'') /\ 7709 (SF_EQUIV sf (sf_star sf' sf'')) /\ 7710 (h' SUBMAP h) /\ (DISJOINT (FDOM hs) (FDOM h')) /\ 7711 (SF_SEM s (FUNION hs h') sf'))``, 7712 7713 SIMP_TAC std_ss [LIST_SF_SEM_FLAT_INTRO] THEN 7714 REPEAT STRIP_TAC THEN 7715 `?sf' h'. 7716 MEM sf' (DS_FLAT_SF sf) /\ h' SUBMAP h /\ DISJOINT (FDOM hs) (FDOM h') /\ 7717 SF_SEM s (FUNION hs h') sf'` by METIS_TAC[lemma_31_list] THEN 7718 Q.EXISTS_TAC `sf'` THEN 7719 Q.EXISTS_TAC `h'` THEN 7720 `(SF_IS_SIMPLE sf') /\ (DS_FLAT_SF sf' = [sf'])` by METIS_TAC[SF_IS_SIMPLE___MEM_DS_FLAT_SF] THEN 7721 ASM_SIMP_TAC std_ss [GSYM LIST_SF_SEM_FLAT_INTRO] THEN 7722 METIS_TAC[SIMPLE_SUB_FORMULA_TO_FRONT, SF_EQUIV_def]); 7723 7724 7725 7726 7727 7728 7729val LEMMA_5 = store_thm ("LEMMA_5", 7730 7731``!(s:'a ->'b ds_value) h fL e2 e3 pf sf pf' sf'. 7732(INFINITE (UNIV:'b set) /\ ALL_DISTINCT fL /\ ~(fL = []) /\ 7733(!h. ((PF_SEM s pf) /\ 7734 ?h1 h2. (h = FUNION h1 h2) /\ 7735 (DISJOINT (FDOM h1) (FDOM h2)) /\ 7736 (SF_SEM s h2 sf) /\ 7737 (BALANCED_SF_SEM___sf_tree_len s h1 fL 2 e3 e2)) ==> 7738 (DS_SEM s h (pf', sf'))) /\ 7739PF_SEM s pf /\ SF_SEM s h sf /\ ~(DS_EXPRESSION_EQUAL s e2 e3) /\ 7740~(DS_EXPRESSION_EQUAL s e2 dse_nil) /\ 7741(DS_POINTER_DANGLES s h e2)) ==> 7742((PF_SEM s pf') /\ (SF_SEM___EXTEND s h (sf_tree fL e3 e2) sf'))``, 7743 7744 7745 7746 7747REPEAT GEN_TAC THEN STRIP_TAC THEN 7748Cases_on `DS_EXPRESSION_EVAL s e2` THEN1 ( 7749 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, dse_nil_def] 7750) THEN 7751 7752Q.ABBREV_TAC `X = (e2 INSERT e3 INSERT (SF_EXPRESSION_SET sf') UNION 7753 (IMAGE (dse_const o dsv_const) (FDOM (h:('b, 'c) heap))) UNION 7754 (BIGUNION (IMAGE (\h':('c |-> 'b ds_value). IMAGE dse_const (FRANGE h')) (FRANGE (h:('b, 'c) heap)))))` THEN 7755 7756MP_TAC ( 7757 Q.SPECL [`s`, `fL`, `e3`, `e2`, 7758 `IMAGE (DS_EXPRESSION_EVAL_VALUE s) X`] BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS) THEN 7759 7760 7761MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 7762CONJ_TAC THEN1 ( 7763 `FINITE X` by ( 7764 Q.UNABBREV_TAC `X` THEN 7765 ASM_SIMP_TAC std_ss [FINITE_INSERT, FINITE_UNION, SF_EXPRESSION_SET___FINITE] THEN 7766 STRIP_TAC THENL [ 7767 MATCH_MP_TAC IMAGE_FINITE THEN 7768 SIMP_TAC std_ss [FDOM_FINITE], 7769 7770 7771 MATCH_MP_TAC FINITE_BIGUNION THEN 7772 SIMP_TAC std_ss [IN_IMAGE, GSYM LEFT_FORALL_IMP_THM] THEN 7773 METIS_TAC[FINITE_FRANGE, IMAGE_FINITE] 7774 ] 7775 ) THEN 7776 FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, IMAGE_FINITE, DS_EXPRESSION_EQUAL_def] 7777) THEN 7778STRIP_TAC THEN 7779Q.PAT_X_ASSUM `Y = dsv_const v` ASSUME_TAC THEN 7780FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, IS_DSV_NIL_def, GET_DSV_VALUE_def, 7781 DS_EXPRESSION_EVAL_VALUE_def] THEN 7782`!e. e IN X ==> ~(DS_EXPRESSION_EVAL_VALUE s e IN FDOM hl)` by ( 7783 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 7784 IN_IMAGE] THEN 7785 METIS_TAC[] 7786) THEN 7787 7788`?hl1 hl2 w. 7789 (FUNION hl1 hl2 = hl) /\ 7790 (FDOM hl1 = {w}) /\ 7791 (~(w = v)) /\ 7792 (hl1 SUBMAP hl) /\ 7793 (FCARD hl1 = 1)` by ( 7794 7795 `?x. x IN FDOM hl` by METIS_TAC[MEMBER_NOT_EMPTY] THEN 7796 7797 Q.EXISTS_TAC `FEMPTY |+ (x, hl ' x)` THEN 7798 Q.EXISTS_TAC `hl \\ x` THEN 7799 Q.EXISTS_TAC `x` THEN 7800 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FDOM_FUPDATE, IN_INSERT, FDOM_FEMPTY, NOT_IN_EMPTY, 7801 FAPPLY_FUPDATE_THM, FCARD_DEF, CARD_SING, GSYM fmap_EQ_THM, 7802 EXTENSION, FUNION_DEF, FAPPLY_FUPDATE_THM, IN_SING, IN_UNION, 7803 DOMSUB_FAPPLY_THM, FDOM_DOMSUB, IN_DELETE, DISJOINT_DEF, IN_INTER] THEN 7804 METIS_TAC[] 7805) THEN 7806 7807`DS_SEM s (FUNION h2 (FUNION hl h)) (pf', sf')` by ( 7808 Q.PAT_X_ASSUM `!h:('b, 'c) heap. P h` MATCH_MP_TAC THEN 7809 ASM_REWRITE_TAC[] THEN 7810 Q.EXISTS_TAC `FUNION h2 hl` THEN 7811 Q.EXISTS_TAC `h` THEN 7812 7813 ASM_REWRITE_TAC[FDOM_FUNION, DISJOINT_UNION_BOTH, FUNION___ASSOC] THEN 7814 Q.PAT_X_ASSUM `!e. e IN X ==> P e` MP_TAC THEN 7815 Q.UNABBREV_TAC `X` THEN 7816 7817 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, 7818 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, IN_SING, 7819 DS_EXPRESSION_EVAL_VALUE_def, IN_IMAGE, IN_INSERT, 7820 IN_UNION, DISJ_IMP_THM, FORALL_AND_THM, GSYM LEFT_FORALL_IMP_THM, 7821 DS_EXPRESSION_EVAL_def, DS_POINTER_DANGLES, IS_DSV_NIL_def] THEN 7822 METIS_TAC [] 7823) THEN 7824 7825`~(v IN FDOM hl)` by ( 7826 Q.PAT_X_ASSUM `!e. e IN X ==> P e` MP_TAC THEN 7827 Q.UNABBREV_TAC `X` THEN 7828 ASM_SIMP_TAC std_ss [IN_INSERT, DISJ_IMP_THM, FORALL_AND_THM, 7829 DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def] 7830) THEN 7831 7832FULL_SIMP_TAC std_ss [DS_SEM_def] THEN 7833MP_TAC (Q.SPECL [`s`, `(FUNION h2 (FUNION hl h))`, `sf'`, `hl1`] LEMMA_31) THEN 7834MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> (a ==> b) ==> c``, METIS_TAC[])) THEN 7835CONJ_TAC THEN1 ( 7836 ASM_REWRITE_TAC[] THEN 7837 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, IN_SING, COND_RATOR, COND_RAND, 7838 IN_INSERT, SUBMAP_DEF, DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def] THEN 7839 METIS_TAC[] 7840) THEN 7841ASM_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_SING] THEN 7842STRIP_TAC THEN 7843 7844`?h'''. h''' = DRESTRICT (FUNION h2 (FUNION hl h)) (COMPL (FDOM (FUNION hl1 h')))` by METIS_TAC[] THEN 7845`SF_SEM s h''' sf'''` by ( 7846 FULL_SIMP_TAC std_ss [SF_EQUIV_def, SF_SEM_def] THEN 7847 `h1 = (FUNION hl1 h')` by ( 7848 `SF_IS_PRECISE sf''` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 7849 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 7850 POP_ASSUM MATCH_MP_TAC THEN 7851 Q.EXISTS_TAC `s` THEN 7852 Q.EXISTS_TAC `FUNION h2 (FUNION hl h)` THEN 7853 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID] THEN 7854 Q.PAT_X_ASSUM `YYY = FUNION h1 h2'` (MP_TAC o GSYM) THEN 7855 Q.PAT_X_ASSUM `h' SUBMAP XXX` MP_TAC THEN 7856 Q.PAT_X_ASSUM `hl1 SUBMAP XXX` MP_TAC THEN 7857 SIMP_TAC std_ss [] THEN 7858 ASM_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, FDOM_FUPDATE, 7859 IN_INSERT, FDOM_FEMPTY, IN_SING, NOT_IN_EMPTY, GET_DSV_VALUE_def, 7860 FAPPLY_FUPDATE, DISJOINT_DEF, EXTENSION, IN_INTER, 7861 DISJ_IMP_THM, DS_EXPRESSION_EVAL_VALUE_def] THEN 7862 METIS_TAC[] 7863 ) THEN 7864 `h''' = h2'` suffices_by METIS_TAC[] THEN 7865 Q.PAT_X_ASSUM `DISJOINT (FDOM h1) (FDOM h2')` MP_TAC THEN 7866 ASM_REWRITE_TAC[] THEN 7867 7868 SIMP_TAC std_ss [GSYM fmap_EQ_THM, DRESTRICT_DEF, IN_INTER, IN_DIFF, FUNION_DEF, 7869 EXTENSION, IN_UNION, FDOM_FUPDATE, IN_INSERT, IN_SING, FDOM_FEMPTY, 7870 NOT_IN_EMPTY, FAPPLY_FUPDATE, DISJOINT_DEF, DISJ_IMP_THM, IN_COMPL] THEN 7871 METIS_TAC[] 7872) THEN 7873 7874Q.PAT_X_ASSUM `SF_SEM s H sf''` MP_TAC THEN 7875Cases_on `sf''` THENL [ 7876 FULL_SIMP_TAC std_ss [SF_IS_SIMPLE_def], 7877 7878 7879 ASM_SIMP_TAC std_ss [SF_SEM_def, FUNION_DEF, EXTENSION, IN_SING, IN_UNION] THEN 7880 REPEAT STRIP_TAC THEN 7881 `DS_EXPRESSION_EVAL_VALUE s d = w` by METIS_TAC[] THEN 7882 FULL_SIMP_TAC std_ss [SF_EXPRESSION_SET_def, SUBSET_DEF, IN_INSERT, 7883 NOT_IN_EMPTY, DISJ_IMP_THM, FORALL_AND_THM] THEN 7884 Q.UNABBREV_TAC `X` THEN 7885 `~(DS_EXPRESSION_EQUAL s (dse_const (dsv_const w)) d)` by METIS_TAC[IN_SING, SUBMAP_DEF, 7886 IN_INSERT, IN_UNION] THEN 7887 NTAC 2 (POP_ASSUM MP_TAC) THEN 7888 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_VALUE_def, 7889 DS_EXPRESSION_EVAL_def, DS_POINTS_TO_def] THEN 7890 Cases_on `DS_EXPRESSION_EVAL s d` THENL [ 7891 FULL_SIMP_TAC std_ss [IS_DSV_NIL_def], 7892 SIMP_TAC std_ss [GET_DSV_VALUE_def] 7893 ], 7894 7895 7896 7897 7898 STRIP_TAC THEN 7899 `w IN FDOM hl` by ( 7900 Q.PAT_X_ASSUM `YYY = hl` (MP_TAC o GSYM) THEN 7901 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_UNION, IN_SING] 7902 ) THEN 7903 `~(DS_EXPRESSION_EQUAL s d0 d)` by ( 7904 CCONTR_TAC THEN 7905 Q.PAT_X_ASSUM `SF_SEM s YYY (sf_tree l d d0)` MP_TAC THEN 7906 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_THM] THEN 7907 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, EXTENSION, FUNION_DEF, IN_UNION, IN_SING, 7908 NOT_IN_EMPTY, EXISTS_OR_THM] 7909 ) THEN 7910 `~(IS_DSV_NIL (DS_EXPRESSION_EVAL s d0))` by ( 7911 Q.PAT_X_ASSUM `SF_SEM s H (sf_tree l d d0)` MP_TAC THEN 7912 ASM_SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_len_def, SF_SEM___sf_tree_def, 7913 GSYM LEFT_FORALL_IMP_THM] THEN 7914 Cases_on `n` THENL [ 7915 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def], 7916 7917 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def] THEN 7918 METIS_TAC[] 7919 ] 7920 ) THEN 7921 `?hl'dom. hl'dom = \x. ?f. (x = GET_DSV_VALUE (h2 ' v ' f)) /\ (MEM f l)` by METIS_TAC[] THEN 7922 `?hl'. hl' = DRESTRICT hl hl'dom` by METIS_TAC[] THEN 7923 `v IN FDOM h' /\ (hl' SUBMAP hl) /\ (!x. MEM x l ==> MEM x fL) /\ 7924 (ALL_DISTINCT l) /\ 7925 (hl' = FUNION hl1 (DRESTRICT h' (FDOM hl))) /\ 7926 SF_SEM s (FUNION h2 hl') (sf_tree l e3 e2)` by ( 7927 ASM_SIMP_TAC std_ss [] THEN 7928 7929 `~(DS_EXPRESSION_EVAL_VALUE s d IN FDOM hl) /\ 7930 ~(DS_EXPRESSION_EVAL_VALUE s d0 IN FDOM hl)` by ( 7931 `d IN X /\ d0 IN X` by ( 7932 Q.UNABBREV_TAC `X` THEN 7933 FULL_SIMP_TAC std_ss [SF_EXPRESSION_SET_def, SUBSET_DEF, IN_INSERT, NOT_IN_EMPTY, 7934 IN_UNION] 7935 ) THEN 7936 METIS_TAC[] 7937 ) THEN 7938 7939 `!e f x. ((x IN FDOM hl) /\ (x IN FDOM (FUNION hl1 h')) /\ MEM f l /\ DS_POINTS_TO s (FUNION hl1 h') e [(f, dse_const (dsv_const x))]) ==> (DS_EXPRESSION_EVAL s e = dsv_const v)` by ( 7940 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, 7941 DS_EXPRESSION_EVAL_def, NOT_IS_DSV_NIL_THM, IN_SING, IN_UNION] THEN 7942 REPEAT STRIP_TAC THEN 7943 Q.PAT_X_ASSUM `DS_EXPRESSION_EVAL s e = dsv_const c` ASSUME_TAC THEN 7944 FULL_SIMP_TAC std_ss [ds_value_11, GET_DSV_VALUE_def] THEN 7945 7946 `c IN FDOM h2 \/ (~(c IN (FDOM h2)) /\ (c IN FDOM hl)) \/ 7947 (~(c IN (FDOM h2)) /\ ~(c IN FDOM hl) /\ (c IN FDOM h'))` by ( 7948 Cases_on `c IN FDOM h2` THEN ASM_REWRITE_TAC[] THEN 7949 Cases_on `c IN FDOM hl` THEN ASM_REWRITE_TAC[] THEN 7950 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION, SUBMAP_DEF] THEN 7951 METIS_TAC[IN_SING] 7952 ) THENL [ 7953 POP_ASSUM MP_TAC THEN 7954 ASM_SIMP_TAC std_ss [IN_SING], 7955 7956 `(FUNION hl1 h' ' c) = hl ' c` by ( 7957 FULL_SIMP_TAC std_ss [FUNION_DEF, SUBMAP_DEF, IN_SING] THEN 7958 Cases_on `c = w` THEN ASM_REWRITE_TAC[] THEN 7959 `c IN FDOM h'` by METIS_TAC[IN_UNION, IN_SING] THEN 7960 METIS_TAC[IN_UNION] 7961 ) THEN 7962 FULL_SIMP_TAC std_ss [] THEN 7963 7964 Q.PAT_X_ASSUM `f IN FDOM (hl ' c)` MP_TAC THEN 7965 ASM_SIMP_TAC std_ss [] THEN 7966 STRIP_TAC THEN 7967 `HEAP_READ_ENTRY s hl (dse_const (dsv_const c)) f = 7968 SOME (DS_EXPRESSION_EVAL s e3)` by METIS_TAC[] THEN 7969 POP_ASSUM MP_TAC THEN 7970 SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 7971 IS_DSV_NIL_def] THEN 7972 ASM_SIMP_TAC std_ss [] THEN 7973 `e3 IN X` by ( 7974 Q.UNABBREV_TAC `X` THEN 7975 SIMP_TAC list_ss [IN_INSERT] 7976 ) THEN 7977 METIS_TAC[GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def], 7978 7979 7980 `c IN FDOM h` by ( 7981 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF] THEN 7982 METIS_TAC[IN_UNION] 7983 ) THEN 7984 `(FUNION hl1 h' ' c) = h ' c` by ( 7985 `~(c = w)` by METIS_TAC[IN_SING, SUBMAP_DEF] THEN 7986 FULL_SIMP_TAC std_ss [FUNION_DEF, SUBMAP_DEF, IN_SING] 7987 ) THEN 7988 FULL_SIMP_TAC std_ss [] THEN 7989 `dse_const (dsv_const x) IN X` by ( 7990 Q.UNABBREV_TAC `X` THEN 7991 ASM_SIMP_TAC std_ss [IN_INSERT, IN_UNION, 7992 IN_BIGUNION, IN_IMAGE, FRANGE_DEF, GSYM RIGHT_EXISTS_AND_THM, 7993 GSYM LEFT_EXISTS_AND_THM, GSPECIFICATION] THEN 7994 METIS_TAC[] 7995 ) THEN 7996 `~(DS_EXPRESSION_EVAL_VALUE s (dse_const (dsv_const x)) IN FDOM hl)` by METIS_TAC[] THEN 7997 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def] 7998 ] 7999 ) THEN 8000 `!x. (x IN FDOM hl /\ x IN FDOM (FUNION hl1 h')) ==> (v IN FDOM h' /\ ?f. MEM f l /\ (h2 ' v ' f = dsv_const x))` by ( 8001 GEN_TAC THEN STRIP_TAC THEN 8002 MP_TAC (Q.SPECL [`s`, `FUNION hl1 h'`, `l`, `d`, `d0`, `dse_const (dsv_const x)`] LEMMA_26a) THEN 8003 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 8004 CONJ_TAC THEN1 ( 8005 POP_ASSUM MP_TAC THEN 8006 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, 8007 GET_DSV_VALUE_def, IS_DSV_NIL_def, DS_POINTS_TO_def, FUNION_DEF, IN_UNION, 8008 IN_SING, DS_EXPRESSION_EQUAL_def] THEN 8009 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 8010 METIS_TAC[GET_DSV_VALUE_def] 8011 ) THEN 8012 STRIP_TAC THEN 8013 `DS_EXPRESSION_EVAL s e'' = dsv_const v` by ( 8014 Q.PAT_X_ASSUM `!e f x. P e f x` MATCH_MP_TAC THEN 8015 Q.EXISTS_TAC `f` THEN 8016 Q.EXISTS_TAC `x` THEN 8017 ASM_REWRITE_TAC[] THEN 8018 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION, IN_SING] 8019 ) THEN 8020 Q.PAT_X_ASSUM `DS_POINTS_TO s H e'' Y` MP_TAC THEN 8021 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, IS_DSV_NIL_def, FUNION_DEF, 8022 IN_UNION, IN_SING, DS_EXPRESSION_EVAL_def] THEN 8023 STRIP_TAC THEN 8024 Q.EXISTS_TAC `f` THEN 8025 ASM_SIMP_TAC std_ss [] THEN 8026 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, GET_DSV_VALUE_def, IN_SING] 8027 ) THEN 8028 `v IN FDOM h'` by ( 8029 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 8030 METIS_TAC[IN_SING] 8031 ) THEN 8032 `(h' ' v = h2 ' v)` by ( 8033 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, GET_DSV_VALUE_def, IN_SING] 8034 ) THEN 8035 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 8036 8037 `!x. MEM x l ==> MEM x fL` by ( 8038 REPEAT STRIP_TAC THEN 8039 `?e. DS_POINTS_TO s (FUNION hl1 h') e2 [(x, e)]` by ( 8040 MATCH_MP_TAC LEMMA_26b THEN 8041 Q.EXISTS_TAC `l` THEN 8042 Q.EXISTS_TAC `d` THEN 8043 Q.EXISTS_TAC `d0` THEN 8044 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, IS_DSV_NIL_def, 8045 DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def, FUNION_DEF, IN_UNION, 8046 IN_SING, ds_value_11] THEN 8047 `DS_POINTER_DANGLES s (FUNION hl1 h') d` by METIS_TAC[LEMMA_3_1_1] THEN 8048 POP_ASSUM MP_TAC THEN 8049 Cases_on `DS_EXPRESSION_EVAL s d` THENL [ 8050 SIMP_TAC std_ss [ds_value_distinct], 8051 8052 ASM_SIMP_TAC std_ss [ds_value_11, IS_DSV_NIL_def, GET_DSV_VALUE_def, FUNION_DEF, IN_UNION, 8053 IN_SING, DS_POINTER_DANGLES] THEN 8054 METIS_TAC[] 8055 ] 8056 ) THEN 8057 POP_ASSUM MP_TAC THEN 8058 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, IS_DSV_NIL_def, FUNION_DEF, IN_UNION, 8059 IN_SING] 8060 ) THEN 8061 `ALL_DISTINCT l` by ( 8062 SIMP_TAC std_ss [EL_ALL_DISTINCT_EQ] THEN 8063 CCONTR_TAC THEN 8064 FULL_SIMP_TAC std_ss [] THEN 8065 Cases_on `n1 = n2` THEN1 METIS_TAC[] THEN 8066 FULL_SIMP_TAC std_ss [] THEN 8067 MP_TAC (Q.SPECL [`s`, `FUNION hl1 h'`, `l`, `d`, `d0`, `e2`, `n1`, `n2`] LEMMA_26d) THEN 8068 ASM_SIMP_TAC list_ss [IS_DSV_NIL_def, DS_EXPRESSION_EVAL_VALUE_def, 8069 GET_DSV_VALUE_def, FUNION_DEF, DS_EXPRESSION_EQUAL_def, IN_UNION, 8070 DS_POINTS_TO_def, IN_SING] THEN 8071 CONJ_TAC THENL [ 8072 CCONTR_TAC THEN 8073 `DS_POINTER_DANGLES s (FUNION hl1 h') d` by METIS_TAC[LEMMA_3_1_1] THEN 8074 POP_ASSUM MP_TAC THEN 8075 POP_ASSUM MP_TAC THEN 8076 ASM_SIMP_TAC std_ss [DS_POINTER_DANGLES, GET_DSV_VALUE_def, 8077 IS_DSV_NIL_def, FUNION_DEF, IN_UNION], 8078 8079 REPEAT GEN_TAC THEN 8080 `MEM (EL n1 l) fL /\ MEM (EL n2 l) fL` by METIS_TAC[MEM_EL] THEN 8081 ASM_SIMP_TAC std_ss [MEM_EL] THEN 8082 MATCH_MP_TAC (prove (``(~a ==> b) ==> (a \/ b)``, METIS_TAC[])) THEN 8083 SIMP_TAC std_ss [] THEN 8084 `GET_DSV_VALUE (h2 ' v ' (EL n2 l)) IN FDOM hl` suffices_by (STRIP_TAC THEN 8085 METIS_TAC[] 8086 ) THEN 8087 Q.PAT_X_ASSUM `!x. P x = x IN (FDOM hl)` (fn thm => REWRITE_TAC [GSYM thm]) THEN 8088 Q.EXISTS_TAC `EL n2 l` THEN 8089 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, GET_DSV_VALUE_def, IN_SING, IS_DSV_NIL_def] THEN 8090 `?x. (h2 ' v ' (EL n2 l) = dsv_const x)` by METIS_TAC[] THEN 8091 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_def] 8092 ] 8093 ) THEN 8094 8095 REPEAT STRIP_TAC THENL [ 8096 SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, IN_INTER], 8097 METIS_TAC[], 8098 ASM_REWRITE_TAC[], 8099 8100 8101 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, DRESTRICT_DEF, 8102 IN_SING, GET_DSV_VALUE_def, IN_UNION, IN_INTER, DISJ_IMP_THM, EXTENSION, 8103 prove (``!x. x IN (\x. P x) = P x``, SIMP_TAC std_ss [IN_DEF]), 8104 GSYM RIGHT_EXISTS_AND_THM] THEN 8105 MATCH_MP_TAC (prove (``(a /\ (a ==> b)) ==> (a /\ b)``, METIS_TAC[])) THEN 8106 CONJ_TAC THENL [ 8107 GEN_TAC THEN 8108 Cases_on `~(x IN FDOM hl)` THEN1 ( 8109 METIS_TAC[FUNION_DEF, IN_UNION, IN_SING] 8110 ) THEN 8111 Cases_on `x = w` THEN1 ( 8112 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 8113 METIS_TAC[GET_DSV_VALUE_def, IN_SING] 8114 ) THEN 8115 FULL_SIMP_TAC std_ss [] THEN 8116 EQ_TAC THENL [ 8117 STRIP_TAC THEN 8118 `?c''. c'' IN FDOM hl /\ (h2 ' v ' f = dsv_const c'')` by METIS_TAC[] THEN 8119 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def] THEN 8120 MP_TAC ( 8121 Q.SPECL [`s`, `FUNION hl1 h'`, `l`, `d`, `d0`, `dse_const ((h2:('b, 'c) heap) ' v ' f)`, `e2`, `f`] LEMMA_26c) THEN 8122 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EQUAL_def, 8123 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, IS_DSV_NIL_def, FDOM_FUNION, 8124 IN_UNION, IN_SING, DS_POINTS_TO_def, FUNION_DEF] THEN 8125 METIS_TAC[GET_DSV_VALUE_def], 8126 8127 STRIP_TAC THEN 8128 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] THEN 8129 `?f. MEM f l /\ (h2 ' v ' f = dsv_const x)` by METIS_TAC[] THEN 8130 METIS_TAC[GET_DSV_VALUE_def] 8131 ], 8132 8133 8134 SIMP_TAC std_ss [] THEN 8135 STRIP_TAC THEN 8136 GEN_TAC THEN 8137 Cases_on `x = w` THENL [ 8138 ASM_SIMP_TAC std_ss [] THEN 8139 `hl1 ' w = hl ' w` by ( 8140 FULL_SIMP_TAC std_ss [SUBMAP_DEF, IN_SING] 8141 ) THEN 8142 ASM_SIMP_TAC std_ss [], 8143 8144 ASM_SIMP_TAC std_ss [] THEN 8145 STRIP_TAC THEN 8146 `h' ' x = hl ' x` by ( 8147 FULL_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_SING] THEN 8148 METIS_TAC[GET_DSV_VALUE_def] 8149 ) THEN 8150 ASM_SIMP_TAC std_ss [] 8151 ] 8152 ], 8153 8154 8155 8156 SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 8157 Q.EXISTS_TAC `SUC (SUC 0)` THEN 8158 REWRITE_TAC [SF_SEM___sf_tree_len_def] THEN 8159 ASM_SIMP_TAC list_ss [PF_SEM_def, IS_DSV_NIL_def, GET_DSV_VALUE_def, EVERY_MEM, 8160 MEM_MAP, GSYM LEFT_FORALL_IMP_THM, DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, 8161 FDOM_FUNION, IN_UNION, IN_SING] THEN 8162 `!h. HEAP_READ_ENTRY s (FUNION h2 h) e2 = 8163 HEAP_READ_ENTRY s h2 e2` by ( 8164 ASM_SIMP_TAC std_ss [FUN_EQ_THM, HEAP_READ_ENTRY_def, 8165 GET_DSV_VALUE_def, IN_SING, IS_DSV_NIL_def, FUNION_DEF, 8166 IN_UNION] 8167 ) THEN 8168 ASM_SIMP_TAC std_ss [] THEN 8169 Q.EXISTS_TAC `MAP (\f. DRESTRICT hl {GET_DSV_VALUE (THE (HEAP_READ_ENTRY s h2 e2 f))}) l` THEN 8170 ASM_SIMP_TAC list_ss [] THEN 8171 REPEAT CONJ_TAC THENL [ 8172 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_THM, IS_DSV_NIL_def, GET_DSV_VALUE_def, IN_SING], 8173 8174 SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP, DRESTRICT_DEF, 8175 DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_SING] THEN 8176 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, IS_DSV_NIL_def, IN_SING, GET_DSV_VALUE_def] THEN 8177 REPEAT GEN_TAC THEN STRIP_TAC THEN 8178 `(MEM (EL n1 l) fL) /\ (MEM (EL n2 l) fL)` by METIS_TAC[MEM_EL] THEN 8179 `?x1. (x1 IN FDOM hl) /\ (h2 ' v ' (EL n1 l) = dsv_const x1)` by METIS_TAC[] THEN 8180 `?x2. (x2 IN FDOM hl) /\ (h2 ' v ' (EL n2 l) = dsv_const x2)` by METIS_TAC[] THEN 8181 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_def] THEN 8182 Tactical.REVERSE EQ_TAC THEN1 METIS_TAC[ds_value_11] THEN 8183 STRIP_TAC THEN 8184 `EL n1 l = EL n2 l` suffices_by (STRIP_TAC THEN 8185 METIS_TAC[EL_ALL_DISTINCT_EQ] 8186 ) THEN 8187 Cases_on `n1 = n2` THEN1 ASM_REWRITE_TAC[] THEN 8188 MP_TAC (Q.SPECL [`s`, `FUNION hl1 h'`, `l`, `d`, `d0`, `e2`, `n1`, `n2`] LEMMA_26d) THEN 8189 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_VALUE_def, IS_DSV_NIL_def, 8190 GET_DSV_VALUE_def, FDOM_FUNION, IN_UNION, IN_SING] THEN 8191 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 8192 CONJ_TAC THEN1 ( 8193 CCONTR_TAC THEN 8194 `DS_POINTER_DANGLES s (FUNION hl1 h') d` by METIS_TAC[LEMMA_3_1_1] THEN 8195 NTAC 2 (POP_ASSUM MP_TAC) THEN 8196 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, GET_DSV_VALUE_def, IS_DSV_NIL_def, 8197 FUNION_DEF, IN_UNION] 8198 ) THEN 8199 ASM_SIMP_TAC list_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, FUNION_DEF, IN_SING, 8200 IS_DSV_NIL_def, IN_UNION] THEN 8201 STRIP_TAC THENL [ 8202 METIS_TAC[GET_DSV_VALUE_def], 8203 METIS_TAC[] 8204 ], 8205 8206 8207 8208 `h2 \\ v = FEMPTY` by ( 8209 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, IN_SING, 8210 FDOM_FEMPTY, NOT_IN_EMPTY] 8211 ) THEN 8212 `!Y. (DRESTRICT hl Y) \\ v = DRESTRICT hl Y` by ( 8213 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, DRESTRICT_DEF, 8214 FDOM_DOMSUB, IN_INTER, IN_DELETE, DOMSUB_FAPPLY_NEQ] THEN 8215 METIS_TAC[] 8216 ) THEN 8217 ASM_SIMP_TAC std_ss [DOMSUB_FUNION, HEAP_READ_ENTRY_def, IS_DSV_NIL_def, GET_DSV_VALUE_def, 8218 IN_SING, FUNION_FEMPTY_1] THEN 8219 8220 Q.PAT_X_ASSUM `!x. MEM x l ==> MEM x fL` MP_TAC THEN 8221 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8222 Induct_on `l` THENL [ 8223 SIMP_TAC list_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, DRESTRICT_DEF, 8224 EXTENSION, NOT_IN_EMPTY, IN_INTER, FUNION_FEMPTY_1] THEN 8225 SIMP_TAC std_ss [IN_DEF], 8226 8227 8228 SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM] THEN 8229 REPEAT STRIP_TAC THEN 8230 `DRESTRICT hl 8231 (\x. ?f. (x = GET_DSV_VALUE ((h2:('b, 'c) heap) ' v ' f)) /\ ((f = h) \/ MEM f l)) = 8232 FUNION (DRESTRICT hl {GET_DSV_VALUE (h2 ' v ' h)}) 8233 (DRESTRICT hl (\x. ?f. (x = GET_DSV_VALUE (h2 ' v ' f)) /\ MEM f l))` by ( 8234 SIMP_TAC std_ss [DRESTRICT_FUNION] THEN 8235 AP_TERM_TAC THEN 8236 SIMP_TAC std_ss [EXTENSION, IN_UNION, IN_SING] THEN 8237 SIMP_TAC std_ss [IN_DEF] THEN 8238 METIS_TAC[] 8239 ) THEN 8240 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1] 8241 ], 8242 8243 8244 SIMP_TAC list_ss [MEM_ZIP, GSYM LEFT_FORALL_IMP_THM, EL_MAP] THEN 8245 GEN_TAC THEN STRIP_TAC THEN 8246 `MEM (EL n l) l /\ MEM (EL n l) fL` by METIS_TAC[MEM_EL] THEN 8247 `?x. x IN (FDOM hl) /\ (h2 ' v ' (EL n l) = dsv_const x)` by METIS_TAC[] THEN 8248 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, GET_DSV_VALUE_def, IN_SING, 8249 IS_DSV_NIL_def, DS_EXPRESSION_EVAL_def, 8250 DRESTRICT_DEF, IN_INTER] THEN 8251 `~(dsv_const x = DS_EXPRESSION_EVAL s e3)` by ( 8252 `e3 IN X` by ( 8253 Q.UNABBREV_TAC `X` THEN 8254 SIMP_TAC std_ss [IN_INSERT] 8255 ) THEN 8256 METIS_TAC[GET_DSV_VALUE_def] 8257 ) THEN 8258 ASM_SIMP_TAC std_ss [] THEN 8259 Q.EXISTS_TAC `MAP (\x. FEMPTY) l` THEN 8260 SIMP_TAC list_ss [EL_ALL_DISJOINT_EQ, EL_MAP, FDOM_FEMPTY, DISJOINT_EMPTY, 8261 MEM_ZIP, GSYM LEFT_FORALL_IMP_THM] THEN 8262 CONJ_TAC THENL [ 8263 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8264 `DRESTRICT hl {x} \\ x = FEMPTY` by ( 8265 SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FDOM_DOMSUB, 8266 IN_DELETE, DRESTRICT_DEF, IN_INTER, IN_SING, FDOM_FEMPTY, NOT_IN_EMPTY] 8267 ) THEN 8268 ASM_SIMP_TAC std_ss [] THEN 8269 Induct_on `l` THENL [ 8270 SIMP_TAC list_ss [], 8271 ASM_SIMP_TAC list_ss [FUNION_FEMPTY_1] 8272 ], 8273 8274 8275 REPEAT STRIP_TAC THEN 8276 `MEM (EL n' l) fL` by METIS_TAC[MEM_EL] THEN 8277 `(HEAP_READ_ENTRY s hl (dse_const (dsv_const x)) (EL n' l) = 8278 SOME (DS_EXPRESSION_EVAL s e3))` by METIS_TAC[] THEN 8279 POP_ASSUM MP_TAC THEN 8280 SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 8281 ASM_SIMP_TAC std_ss [HEAP_READ_ENTRY_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 8282 DRESTRICT_DEF, IN_INTER, IN_SING] 8283 ] 8284 ] 8285 ] 8286 ) THEN 8287 8288 8289 `DISJOINT (FDOM hl) (FDOM h)` by ( 8290 Q.PAT_X_ASSUM `DISJOINT (FDOM hl) (IMAGE f X)` MP_TAC THEN 8291 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 8292 IN_IMAGE] THEN 8293 REPEAT STRIP_TAC THEN 8294 CCONTR_TAC THEN 8295 FULL_SIMP_TAC std_ss [] THEN 8296 `dse_const (dsv_const x) IN X` by ( 8297 Q.UNABBREV_TAC `X` THEN 8298 ASM_SIMP_TAC std_ss [IN_INSERT, IN_UNION, IN_IMAGE] THEN 8299 METIS_TAC[] 8300 ) THEN 8301 `~(x = DS_EXPRESSION_EVAL_VALUE s (dse_const (dsv_const x)))` by METIS_TAC[] THEN 8302 POP_ASSUM MP_TAC THEN 8303 ASM_REWRITE_TAC[DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def] 8304 ) THEN 8305 8306 `DISJOINT (FDOM hl) (FDOM h''')` by ( 8307 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 8308 GEN_TAC THEN 8309 Cases_on `x IN FDOM hl` THEN ASM_REWRITE_TAC[] THEN 8310 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_COMPL, FUNION_DEF, 8311 IN_UNION, IN_SING] THEN 8312 CCONTR_TAC THEN FULL_SIMP_TAC std_ss [] THEN 8313 MP_TAC (Q.SPECL [`s`, `h'''`, `sf'''`, `x`] SF_EXPRESSION_SET___FDOM_HEAP) THEN 8314 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, FUNION_DEF, IN_INTER, IN_UNION, IN_SING, IN_COMPL] THEN 8315 CONJ_TAC THENL [ 8316 STRIP_TAC THEN 8317 Cases_on `e IN SF_EXPRESSION_SET sf'''` THEN ASM_REWRITE_TAC[] THEN 8318 `e IN X` by ( 8319 Q.UNABBREV_TAC `X` THEN 8320 ASM_SIMP_TAC std_ss [IN_UNION, IN_INSERT] 8321 ) THEN 8322 `~(DS_EXPRESSION_EVAL_VALUE s e IN FDOM hl)` by METIS_TAC[] THEN 8323 POP_ASSUM MP_TAC THEN 8324 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 8325 METIS_TAC[GET_DSV_VALUE_def], 8326 8327 8328 REPEAT STRIP_TAC THEN 8329 Cases_on `x' = w` THEN ASM_REWRITE_TAC[] THEN 8330 Cases_on `x' IN FDOM h'` THEN ASM_REWRITE_TAC[] THEN 8331 `~(x' = v)` by METIS_TAC[] THEN ASM_REWRITE_TAC[] THEN 8332 Cases_on `x' IN FDOM hl` THEN ASM_REWRITE_TAC[] THENL [ 8333 ASM_SIMP_TAC list_ss [] THEN 8334 Cases_on `MEM f fL` THEN ASM_REWRITE_TAC[] THEN 8335 `HEAP_READ_ENTRY s hl (dse_const (dsv_const x')) f = 8336 SOME (DS_EXPRESSION_EVAL s e3)` by METIS_TAC[] THEN 8337 POP_ASSUM MP_TAC THEN 8338 SIMP_TAC std_ss [HEAP_READ_ENTRY_THM] THEN 8339 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 8340 `e3 IN X` by ( 8341 Q.UNABBREV_TAC `X` THEN 8342 ASM_SIMP_TAC std_ss [IN_UNION, IN_INSERT] 8343 ) THEN 8344 METIS_TAC[GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def], 8345 8346 8347 Cases_on `x' IN FDOM h` THEN ASM_REWRITE_TAC[] THEN 8348 Cases_on `f IN (FDOM (h ' x'))` THEN ASM_REWRITE_TAC[] THEN 8349 `dse_const (h ' x' ' f) IN X` by ( 8350 Q.UNABBREV_TAC `X` THEN 8351 ASM_SIMP_TAC std_ss [IN_UNION, IN_INSERT, IN_BIGUNION, IN_IMAGE, FRANGE_DEF, 8352 GSPECIFICATION, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 8353 METIS_TAC[] 8354 ) THEN 8355 CCONTR_TAC THEN 8356 `~(DS_EXPRESSION_EVAL_VALUE s (dse_const (h ' x' ' f)) IN FDOM hl)` by METIS_TAC[] THEN 8357 POP_ASSUM MP_TAC THEN 8358 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def] THEN 8359 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def] 8360 ] 8361 ] 8362 ) THEN 8363 8364 `h''' SUBMAP h` by ( 8365 SIMP_TAC std_ss [SUBMAP_DEF] THEN 8366 GEN_TAC THEN STRIP_TAC THEN 8367 `~(x IN FDOM hl)` by ( 8368 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 8369 PROVE_TAC[] 8370 ) THEN 8371 Q.PAT_X_ASSUM `x IN FDOM h'''` MP_TAC THEN 8372 ASM_SIMP_TAC std_ss [SUBMAP_DEF, DRESTRICT_DEF, IN_INTER, 8373 IN_DIFF, FUNION_DEF, IN_UNION, IN_SING, IN_COMPL] THEN 8374 METIS_TAC[] 8375 ) THEN 8376 8377 `!x. MEM x fL ==> MEM x l` by ( 8378 REPEAT STRIP_TAC THEN 8379 CCONTR_TAC THEN 8380 `?y. y IN FDOM hl /\ (h2 ' v ' x = dsv_const y)` by METIS_TAC[] THEN 8381 `~(y IN (FDOM h'''))` by ( 8382 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 8383 METIS_TAC[] 8384 ) THEN 8385 `y IN FDOM (FUNION hl1 (DRESTRICT h' (FDOM hl)))` by ( 8386 POP_ASSUM MP_TAC THEN 8387 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_UNION, DRESTRICT_DEF, IN_INTER, IN_COMPL] 8388 ) THEN 8389 Q.PAT_X_ASSUM `~(y IN FDOM h''')` MP_TAC THEN 8390 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_COMPL, FUNION_DEF, IN_UNION, 8391 IN_SING] THEN 8392 CCONTR_TAC THEN ( 8393 Q.PAT_X_ASSUM `y IN FDOM Y` MP_TAC THEN 8394 FULL_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, 8395 prove (``!x f. x IN (\x. f x) = f x``, SIMP_TAC std_ss [IN_DEF])] THEN 8396 METIS_TAC[GET_DSV_VALUE_def] 8397 ) 8398 ) THEN 8399 `PERM l fL` by METIS_TAC[PERM_ALL_DISTINCT] THEN 8400 `!s h es e. SF_SEM___sf_tree s h l es e = 8401 SF_SEM___sf_tree s h fL es e` by ( 8402 SIMP_TAC std_ss [SF_SEM___sf_tree_def] THEN 8403 METIS_TAC[SF_SEM___sf_tree_len_PERM_THM] 8404 ) THEN 8405 8406 `(FUNION h2 hl) SUBMAP (FUNION hl1 h')` by ( 8407 SIMP_TAC std_ss [SUBMAP_DEF, IMP_CONJ_THM, FORALL_AND_THM] THEN 8408 MATCH_MP_TAC (prove (``(a ==> b) /\ a ==> (a /\ b)``, METIS_TAC[])) THEN 8409 CONJ_TAC THEN1 ( 8410 REPEAT STRIP_TAC THEN 8411 `x IN FDOM (FUNION hl1 h')` by PROVE_TAC[] THEN 8412 Q.PAT_X_ASSUM `h' SUBMAP YYY` MP_TAC THEN 8413 ASM_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_SING, IN_UNION] THEN 8414 STRIP_TAC THEN 8415 Q.PAT_X_ASSUM `x IN FDOM (FUNION h2 hl)` MP_TAC THEN 8416 Cases_on `x = v` THEN ( 8417 ASM_SIMP_TAC std_ss [IN_SING, IN_UNION, FUNION_DEF, DISJ_IMP_THM] 8418 ) THEN 8419 STRIP_TAC THEN 8420 Cases_on `x = w` THEN1 METIS_TAC[SUBMAP_DEF, IN_SING] THEN 8421 8422 Q.PAT_X_ASSUM `x IN FDOM (FUNION hl1 h')` MP_TAC THEN 8423 SIMP_TAC std_ss [FUNION_DEF, IN_UNION, IN_SING] THEN 8424 ASM_SIMP_TAC std_ss [IN_SING] 8425 ) THEN 8426 8427 ASM_SIMP_TAC std_ss [FUNION_DEF, IN_UNION, IN_SING, DISJ_IMP_THM] THEN 8428 REPEAT STRIP_TAC THEN 8429 CCONTR_TAC THEN 8430 FULL_SIMP_TAC std_ss [] THEN 8431 `~(x IN FDOM h''')` by ( 8432 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 8433 METIS_TAC[] 8434 ) THEN 8435 POP_ASSUM MP_TAC THEN 8436 ASM_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_COMPL, FUNION_DEF, IN_UNION, IN_SING] 8437 ) THEN 8438 8439 `?h''. h'' = DRESTRICT h (COMPL (FDOM h'''))` by METIS_TAC[] THEN 8440 `FUNION hl1 h' = FUNION (FUNION h2 hl) h''` by ( 8441 SIMP_TAC std_ss [GSYM fmap_EQ_THM] THEN 8442 MATCH_MP_TAC (prove (``(a ==> b) /\ a ==> (a /\ b)``, METIS_TAC[])) THEN 8443 CONJ_TAC THEN1 ( 8444 Q.PAT_X_ASSUM `h' SUBMAP YYY` MP_TAC THEN 8445 ASM_SIMP_TAC std_ss [IN_UNION, FUNION_DEF, IN_SING, DRESTRICT_DEF, 8446 IN_INTER, IN_COMPL, SUBMAP_DEF] THEN 8447 STRIP_TAC THEN STRIP_TAC THEN GEN_TAC THEN 8448 Cases_on `x = v` THEN1 ( 8449 ASM_SIMP_TAC std_ss [] 8450 ) THEN 8451 ASM_SIMP_TAC std_ss [] THEN 8452 Cases_on `x = w` THEN1 ( 8453 ASM_SIMP_TAC std_ss [] THEN 8454 METIS_TAC[IN_SING, SUBMAP_DEF] 8455 ) THEN 8456 ASM_SIMP_TAC std_ss [] THEN 8457 Cases_on `x IN FDOM hl` THEN1 ( 8458 ASM_SIMP_TAC std_ss [] 8459 ) THEN 8460 ASM_SIMP_TAC std_ss [] THEN 8461 Cases_on `x IN FDOM h` THEN1 ( 8462 ASM_SIMP_TAC std_ss [] 8463 ) THEN 8464 METIS_TAC[] 8465 ) THEN 8466 8467 8468 8469 Q.PAT_X_ASSUM `FUNION h2 hl SUBMAP YYY` MP_TAC THEN 8470 ASM_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, EXTENSION, IN_SING, 8471 DRESTRICT_DEF, IN_INTER, IN_COMPL, IMP_CONJ_THM, FORALL_AND_THM, DISJ_IMP_THM] THEN 8472 REPEAT STRIP_TAC THEN 8473 Cases_on `x = v` THEN1 ( 8474 ASM_SIMP_TAC std_ss [] 8475 ) THEN 8476 Cases_on `x = w` THEN1 ( 8477 ASM_SIMP_TAC std_ss [] 8478 ) THEN 8479 ASM_SIMP_TAC std_ss [] THEN 8480 Cases_on `x IN FDOM h'` THEN1 ( 8481 Q.PAT_X_ASSUM `h' SUBMAP YYY` MP_TAC THEN 8482 ASM_SIMP_TAC std_ss [SUBMAP_DEF, FUNION_DEF, IN_UNION, IN_SING] THEN 8483 METIS_TAC[] 8484 ) THEN 8485 `~(x IN FDOM hl)` by METIS_TAC[] THEN 8486 ASM_SIMP_TAC std_ss [] 8487 ) THEN 8488 8489 8490 FULL_SIMP_TAC std_ss [SF_SEM___EXTEND_def, SF_SEM_def, SF_EQUIV_def] THEN 8491 REPEAT STRIP_TAC THEN 8492 MP_TAC (Q.SPECL [`s`, `FUNION h2 hl`, `h''`, `fL`, `d`, `d0`, `e3`, `e2`] SUBTREE_EXCHANGEABLE_THM) THEN 8493 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 8494 CONJ_TAC THEN1 ( 8495 FULL_SIMP_TAC std_ss [SF_SEM_def] THEN 8496 REPEAT STRIP_TAC THENL [ 8497 SIMP_TAC std_ss [SF_SEM___sf_tree_def] THEN 8498 METIS_TAC[BALANCED_SF_SEM___sf_tree_len_THM], 8499 8500 Q.PAT_X_ASSUM `DISJOINT (FDOM hl) (FDOM h)` MP_TAC THEN 8501 Q.PAT_X_ASSUM `~(v IN FDOM h)` MP_TAC THEN 8502 ASM_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, FUNION_DEF, 8503 DRESTRICT_DEF, IN_UNION, IN_SING] THEN 8504 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8505 METIS_TAC[] 8506 ] 8507 ) THEN 8508 8509 SIMP_TAC std_ss [GSYM LEFT_EXISTS_IMP_THM] THEN 8510 Q.EXISTS_TAC `h''''` THEN 8511 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 8512 CONJ_TAC THEN1 ( 8513 `DS_POINTER_DANGLES s h'''' d` suffices_by (STRIP_TAC THEN 8514 ASM_SIMP_TAC std_ss [SF_SEM_def] THEN 8515 Q.PAT_X_ASSUM `DISJOINT (FDOM h) (FDOM h'''')` MP_TAC THEN 8516 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8517 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, FUNION_DEF, 8518 DRESTRICT_DEF, IN_UNION] THEN 8519 METIS_TAC[] 8520 ) THEN 8521 8522 Cases_on `DS_EXPRESSION_EQUAL s d e3` THEN1 ( 8523 `DS_POINTER_DANGLES s h'''' e3` by METIS_TAC[LEMMA_3_1_1, SF_SEM_def] THEN 8524 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def] 8525 ) THEN 8526 SIMP_TAC std_ss [DS_POINTER_DANGLES] THEN 8527 Cases_on `DS_EXPRESSION_EVAL s d` THEN ASM_SIMP_TAC std_ss [IS_DSV_NIL_def, GET_DSV_VALUE_def] THEN 8528 `v' IN FDOM h` suffices_by (STRIP_TAC THEN 8529 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 8530 METIS_TAC[] 8531 ) THEN 8532 8533 CCONTR_TAC THEN 8534 Q.PAT_X_ASSUM `!h:('b, 'c) heap. (P h ==> Q h)` MP_TAC THEN 8535 SIMP_TAC std_ss [GSYM LEFT_FORALL_IMP_THM, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 8536 GSYM LEFT_EXISTS_IMP_THM] THEN 8537 8538 `?hx. 8539 BALANCED_SF_SEM___sf_tree_len s hx fL 2 e3 e2 /\ 8540 (DISJOINT (FDOM hx) (FDOM h)) /\ 8541 (v' IN FDOM hx)` by ( 8542 8543 MP_TAC (Q.SPECL [`s`, `fL`, `e3`, `e2`, `v'`, `FDOM (h:('b, 'c) heap)`] 8544 BALANCED_SF_SEM___sf_tree_len_2___MODEL_EXISTS_WITH_ELEMENT) THEN 8545 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 8546 CONJ_TAC THEN1 ( 8547 FULL_SIMP_TAC std_ss [IS_DSV_NIL_def, FDOM_FINITE, DS_EXPRESSION_EQUAL_def, 8548 DS_EXPRESSION_EVAL_def] 8549 ) THEN 8550 STRIP_TAC THEN 8551 Q.EXISTS_TAC `h'''''` THEN 8552 Q.PAT_X_ASSUM `DISJOINT Y (FDOM h)` MP_TAC THEN 8553 ASM_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 8554 IN_DIFF, IN_SING, DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def] THEN 8555 METIS_TAC[] 8556 ) THEN 8557 8558 8559 Q.EXISTS_TAC `hx` THEN 8560 Q.EXISTS_TAC `h` THEN 8561 ASM_SIMP_TAC std_ss [] THEN 8562 REPEAT STRIP_TAC THEN 8563 CCONTR_TAC THEN 8564 FULL_SIMP_TAC std_ss [] THEN 8565 8566 `~(v' IN FDOM h1')` by ( 8567 `DS_POINTER_DANGLES s h1' d` by METIS_TAC[LEMMA_3_1_1, SF_SEM_def] THEN 8568 POP_ASSUM MP_TAC THEN 8569 ASM_SIMP_TAC std_ss [DS_POINTER_DANGLES, GET_DSV_VALUE_def, IS_DSV_NIL_def] 8570 ) THEN 8571 `v' IN FDOM h2''` by ( 8572 `v' IN FDOM (FUNION hx h)` by ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] THEN 8573 POP_ASSUM MP_TAC THEN 8574 ASM_SIMP_TAC std_ss [] THEN 8575 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] 8576 ) THEN 8577 `h2'' = h'''` by ( 8578 `SF_IS_PRECISE sf'''` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 8579 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 8580 POP_ASSUM MATCH_MP_TAC THEN 8581 Q.EXISTS_TAC `s` THEN 8582 Q.EXISTS_TAC `FUNION hx h` THEN 8583 REPEAT STRIP_TAC THENL [ 8584 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID], 8585 METIS_TAC[SUBMAP___FUNION___ID, SUBMAP_TRANS], 8586 ASM_SIMP_TAC std_ss [], 8587 ASM_SIMP_TAC std_ss [] 8588 ] 8589 ) THEN 8590 METIS_TAC[SUBMAP_DEF] 8591 ) THEN 8592 8593 STRIP_TAC THEN 8594 Q.EXISTS_TAC `FUNION h'''' h''` THEN 8595 Q.EXISTS_TAC `h'''` THEN 8596 8597 Q.PAT_X_ASSUM `h''' = YYY` (K ALL_TAC) THEN 8598 `DISJOINT (FDOM h'') (FDOM h''') /\ (h = (FUNION h'' h'''))` by ( 8599 Q.PAT_X_ASSUM `h''' SUBMAP h` MP_TAC THEN 8600 ONCE_ASM_REWRITE_TAC[] THEN 8601 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8602 SIMP_TAC std_ss [SUBMAP_DEF, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 8603 DRESTRICT_DEF, IN_COMPL, GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION] THEN 8604 METIS_TAC[] 8605 ) THEN 8606 REPEAT STRIP_TAC THENL [ 8607 NTAC 2 (POP_ASSUM MP_TAC) THEN 8608 Q.PAT_X_ASSUM `DISJOINT (FDOM h) (FDOM h'''')` MP_TAC THEN 8609 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 8610 SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY] THEN 8611 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FUNION_DEF, IN_UNION, EXTENSION] THEN 8612 METIS_TAC[], 8613 8614 Q.PAT_X_ASSUM `DISJOINT (FDOM h) (FDOM h'''')` MP_TAC THEN 8615 Q.PAT_X_ASSUM `h = YYY` (fn thm => (REWRITE_TAC [thm])) THEN 8616 SIMP_TAC std_ss [FDOM_FUNION, DISJOINT_UNION_BOTH, DISJOINT_SYM] THEN 8617 ASM_SIMP_TAC std_ss [], 8618 8619 METIS_TAC[SF_SEM_def], 8620 8621 ASM_REWRITE_TAC[] 8622 ], 8623 8624 FULL_SIMP_TAC std_ss [SF_IS_SIMPLE_def] 8625]); 8626 8627 8628 8629 8630 8631 8632 8633 8634 8635 8636 8637 8638 8639 8640 8641 8642 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662val HEAP_DISTINCT_def = Define 8663 `HEAP_DISTINCT s h c d = 8664 (!e. MEM e c ==> ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) /\ 8665 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h)) /\ 8666 ALL_DISTINCT (MAP (\e. DS_EXPRESSION_EVAL_VALUE s e) c) /\ 8667 8668 8669 (!e1 e2. MEM (e1,e2) d ==> 8670 DS_EXPRESSION_EQUAL s e1 e2 \/ 8671 (~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1)) /\ 8672 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM h))) /\ 8673 8674 ALL_DISTINCT (MAP (\(e1,e2). DS_EXPRESSION_EVAL_VALUE s e1) 8675 (FILTER (\(e1,e2). ~(DS_EXPRESSION_EQUAL s e1 e2)) d)) /\ 8676 8677 (!e1 e2 e3. MEM e1 c /\ MEM (e2,e3) d ==> 8678 (DS_EXPRESSION_EQUAL s e2 e3 \/ 8679 ~(DS_EXPRESSION_EQUAL s e1 e2)))` 8680 8681 8682 8683 8684val HEAP_DISTINCT___IND_DEF = store_thm ("HEAP_DISTINCT___IND_DEF", 8685`` (!s h. HEAP_DISTINCT s h [] [] = T) /\ 8686 (!s h e c. HEAP_DISTINCT s h (e::c) d = (HEAP_DISTINCT s h c d /\ 8687 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e)) /\ 8688 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e) IN FDOM h) /\ 8689 (!e'. MEM e' c ==> (~(DS_EXPRESSION_EQUAL s e e'))) /\ 8690 (!e1 e2. MEM (e1,e2) d ==> ( 8691 DS_EXPRESSION_EQUAL s e1 e2 \/ 8692 ~(DS_EXPRESSION_EQUAL s e e1))))) /\ 8693 8694 (!s h e1 e2 c. HEAP_DISTINCT s h c ((e1,e2)::d) = (HEAP_DISTINCT s h c d /\ 8695 ((DS_EXPRESSION_EQUAL s e1 e2) \/ 8696 8697 ( 8698 ~(IS_DSV_NIL (DS_EXPRESSION_EVAL s e1)) /\ 8699 ~(GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1) IN FDOM h) /\ 8700 (!e1' e2'. MEM (e1', e2') d ==> 8701 ((DS_EXPRESSION_EQUAL s e1' e2') \/ 8702 (~(DS_EXPRESSION_EQUAL s e1 e1')))) /\ 8703 8704 (!e'. MEM e' c ==> (~(DS_EXPRESSION_EQUAL s e1 e')))))))``, 8705 8706 8707REPEAT CONJ_TAC THENL [ 8708 SIMP_TAC list_ss [HEAP_DISTINCT_def], 8709 8710 SIMP_TAC list_ss [HEAP_DISTINCT_def, MEM_MAP, DISJ_IMP_THM, FORALL_AND_THM, 8711 LEFT_AND_OVER_OR, RIGHT_AND_OVER_OR, DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EQUAL_def] THEN 8712 REPEAT STRIP_TAC THEN 8713 STRIP_EQ_BOOL_TAC THEN 8714 METIS_TAC[GET_DSV_VALUE_11], 8715 8716 8717 SIMP_TAC list_ss [HEAP_DISTINCT_def, MEM_MAP, DISJ_IMP_THM, FORALL_AND_THM, 8718 LEFT_AND_OVER_OR, RIGHT_AND_OVER_OR, DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EQUAL_def] THEN 8719 REPEAT STRIP_TAC THEN 8720 Cases_on `DS_EXPRESSION_EVAL s e1 = DS_EXPRESSION_EVAL s e2` THENL [ 8721 ASM_SIMP_TAC std_ss [] THEN 8722 EQ_TAC THEN STRIP_TAC THEN ( 8723 ASM_SIMP_TAC std_ss [] THEN 8724 ASM_REWRITE_TAC[] 8725 ), 8726 8727 ASM_SIMP_TAC list_ss [MEM_MAP, MEM_FILTER] THEN 8728 pairLib.GEN_BETA_TAC THEN 8729 EQ_TAC THEN STRIP_TAC THENL [ 8730 ASM_SIMP_TAC std_ss [] THEN 8731 REPEAT STRIP_TAC THEN 8732 RES_TAC THENL [ 8733 ASM_SIMP_TAC std_ss [], 8734 8735 8736 Q.PAT_X_ASSUM `!y :('e, 'd) ds_expression # ('e, 'd) ds_expression. P y` 8737 (fn thm => MP_TAC (Q.SPECL [`(e1', e2')`] thm)) THEN 8738 ASM_SIMP_TAC std_ss [DISJ_IMP_THM, GET_DSV_VALUE_11] 8739 ], 8740 8741 8742 ASM_SIMP_TAC std_ss [] THEN 8743 Cases_on `y` THEN 8744 SIMP_TAC std_ss [] THEN 8745 METIS_TAC[GET_DSV_VALUE_11] 8746 ] 8747 ] 8748]) 8749 8750 8751val HEAP_DISTINCT___FUNION = store_thm ("HEAP_DISTINCT___FUNION", 8752``!s h1 h2 e c d. 8753 HEAP_DISTINCT s (FUNION h1 h2) c d = 8754 HEAP_DISTINCT s h1 c d /\ HEAP_DISTINCT s h2 c d``, 8755 8756SIMP_TAC std_ss [HEAP_DISTINCT_def, FDOM_FUNION, IN_UNION, DS_POINTER_DANGLES] THEN 8757METIS_TAC[]); 8758 8759 8760val HEAP_DISTINCT___PERM = store_thm ("HEAP_DISTINCT___PERM", 8761``!s h c1 c2 d1 d2. (PERM c1 c2 /\ PERM d1 d2) ==> 8762 (HEAP_DISTINCT s h c1 d1 = HEAP_DISTINCT s h c2 d2)``, 8763 8764 8765SIMP_TAC std_ss [HEAP_DISTINCT_def] THEN 8766REPEAT STRIP_TAC THEN 8767`!x. MEM x c2 = MEM x c1` by METIS_TAC[PERM_MEM_EQ] THEN 8768`!x. MEM x d2 = MEM x d1` by METIS_TAC[PERM_MEM_EQ] THEN 8769ASM_SIMP_TAC std_ss [] THEN 8770STRIP_EQ_BOOL_TAC THEN 8771BINOP_TAC THENL [ 8772 MATCH_MP_TAC ALL_DISTINCT___PERM THEN 8773 MATCH_MP_TAC PERM_MAP THEN 8774 ASM_REWRITE_TAC[], 8775 8776 MATCH_MP_TAC ALL_DISTINCT___PERM THEN 8777 MATCH_MP_TAC PERM_MAP THEN 8778 MATCH_MP_TAC PERM_FILTER THEN 8779 ASM_REWRITE_TAC[] 8780]) 8781 8782 8783 8784 8785val HEAP_DISTINCT___dse_nil = store_thm ("HEAP_DISTINCT___dse_nil", 8786 ``!s h c d x. MEM x c /\ (HEAP_DISTINCT s h c d) ==> 8787 ~(DS_EXPRESSION_EQUAL s x dse_nil)``, 8788 8789SIMP_TAC std_ss [HEAP_DISTINCT_def, DS_EXPRESSION_EQUAL_def, dse_nil_def, DS_EXPRESSION_EVAL_def] THEN 8790REPEAT STRIP_TAC THEN 8791RES_TAC THEN 8792METIS_TAC[IS_DSV_NIL_def]); 8793 8794 8795 8796 8797val HEAP_DISTINCT___NOT_ALL_DISTINCT = store_thm ("HEAP_DISTINCT___NOT_ALL_DISTINCT", 8798 ``!s h c d n1 n2. ((n1 < LENGTH c) /\ (n2 < LENGTH c) /\ ~(n1 = n2) /\ (EL n1 c = EL n2 c)) ==> 8799 ~(HEAP_DISTINCT s h c d)``, 8800 8801SIMP_TAC list_ss [HEAP_DISTINCT_def, EL_ALL_DISTINCT_EQ] THEN 8802REPEAT STRIP_TAC THEN 8803DISJ2_TAC THEN DISJ1_TAC THEN 8804Q.EXISTS_TAC `n1` THEN 8805Q.EXISTS_TAC `n2` THEN 8806ASM_SIMP_TAC std_ss [EL_MAP]) 8807 8808 8809 8810val HEAP_DISTINCT___NOT_ALL_DISTINCT2 = store_thm ("HEAP_DISTINCT___NOT_ALL_DISTINCT2", 8811 ``!s h c d n1 n2. ((n1 < LENGTH d) /\ (n2 < LENGTH d) /\ ~(n1 = n2) /\ (EL n1 d = EL n2 d) /\ 8812 (HEAP_DISTINCT s h c d)) ==> DS_EXPRESSION_EQUAL s (FST (EL n1 d)) (SND (EL n1 d))``, 8813 8814SIMP_TAC list_ss [HEAP_DISTINCT_def, EL_ALL_DISTINCT_EQ] THEN 8815REPEAT STRIP_TAC THEN 8816CCONTR_TAC THEN 8817MP_TAC (Q.ISPECL [`n1:num`, `n2:num`, `(\(e1:('b, 'a) ds_expression,e2). ~DS_EXPRESSION_EQUAL s e1 e2)`, `d:(('b, 'a) ds_expression # ('b, 'a) ds_expression) list`] EL_DISJOINT_FILTER) THEN 8818ASM_SIMP_TAC std_ss [] THEN 8819pairLib.GEN_BETA_TAC THEN 8820ASM_REWRITE_TAC[] THEN 8821CCONTR_TAC THEN 8822FULL_SIMP_TAC std_ss [EL_MAP] THEN 8823Q.PAT_X_ASSUM `!n1 (n2:num). P n1 n2` (fn thm => MP_TAC (Q.SPECL [`n1'`, `n2'`] thm)) THEN 8824pairLib.GEN_BETA_TAC THEN 8825ASM_REWRITE_TAC[]) 8826 8827 8828 8829val HEAP_DISTINCT___EQUAL = store_thm ("HEAP_DISTINCT___EQUAL", 8830 ``!s h c d e. HEAP_DISTINCT s h c ((e,e)::d) = 8831 HEAP_DISTINCT s h c d``, 8832 8833 SIMP_TAC std_ss [HEAP_DISTINCT___IND_DEF, DS_EXPRESSION_EQUAL_def]) 8834 8835 8836val HEAP_DISTINCT___UNEQUAL = store_thm ("HEAP_DISTINCT___UNEQUAL", 8837 ``!s h c d e1 e2. ~(DS_EXPRESSION_EQUAL s e1 e2) ==> 8838 8839 (HEAP_DISTINCT s h c ((e1,e2)::d) = 8840 HEAP_DISTINCT s h (e1::c) d)``, 8841 8842 SIMP_TAC std_ss [HEAP_DISTINCT___IND_DEF] THEN 8843 METIS_TAC[]) 8844 8845 8846 8847val LIST_DS_ENTAILS_def = Define 8848 `LIST_DS_ENTAILS c l1 l2 = 8849 !s h. (HEAP_DISTINCT s h (FST c) (SND c) /\ LIST_DS_SEM s h l1) ==> LIST_DS_SEM s h l2` 8850 8851 8852 8853val LIST_DS_ENTAILS___PERM = store_thm ( 8854"LIST_DS_ENTAILS___PERM", 8855``!c1 c2 pf sf pf' sf' c12 c22 pf2 sf2 pf2' sf2'. 8856 8857((PERM c1 c12) /\ (PERM c2 c22) /\ (PERM pf pf2) /\ (PERM sf sf2) /\ (PERM pf' pf2') /\ (PERM sf' sf2')) ==> 8858 8859(LIST_DS_ENTAILS (c1,c2) (pf, sf) (pf', sf') = 8860LIST_DS_ENTAILS (c12,c22) (pf2, sf2) (pf2', sf2'))``, 8861 8862SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_def] THEN 8863REPEAT STRIP_TAC THEN 8864`(!s h. (LIST_SF_SEM s h sf = LIST_SF_SEM s h sf2)) /\ 8865 (!s h. (LIST_SF_SEM s h sf' = LIST_SF_SEM s h sf2'))` by ( 8866 ASM_SIMP_TAC std_ss [LIST_SF_SEM_PERM] 8867) THEN 8868`(!s. (LIST_PF_SEM s pf = LIST_PF_SEM s pf2)) /\ 8869 (!s. (LIST_PF_SEM s pf' = LIST_PF_SEM s pf2'))` by ( 8870 ASM_SIMP_TAC std_ss [LIST_PF_SEM_PERM] 8871) THEN 8872`!s (h:('a, 'c) heap). HEAP_DISTINCT s h c1 c2 = HEAP_DISTINCT s h c12 c22` by 8873 ASM_SIMP_TAC std_ss [HEAP_DISTINCT___PERM] THEN 8874ASM_SIMP_TAC std_ss []); 8875 8876 8877 8878 8879(*Normalization Rules*) 8880 8881val INFERENCE_INCONSISTENT = store_thm ("INFERENCE_INCONSISTENT", 8882``!e c1 c2 pfL sfL pfL' sfL'. LIST_DS_ENTAILS (c1,c2) ((pf_unequal e e)::pfL, sfL) (sfL', pfL')``, 8883SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, 8884 DS_EXPRESSION_EQUAL_def]); 8885 8886 8887 8888 8889val INFERENCE_SUBSTITUTION = store_thm ("INFERENCE_SUBSTITUTION", 8890``!e c1 c2 v pfL sfL pfL' sfL'. 8891 LIST_DS_ENTAILS (MAP (DS_VAR_SUBST v e) c1, MAP (\x. (DS_VAR_SUBST v e (FST x), DS_VAR_SUBST v e (SND x))) c2) (MAP (PF_SUBST v e) pfL, MAP (SF_SUBST v e) sfL) (MAP (PF_SUBST v e) pfL', MAP (SF_SUBST v e) sfL') = 8892 LIST_DS_ENTAILS (c1,c2) ((pf_equal (dse_var v) e)::pfL, sfL) (pfL', sfL')``, 8893 8894SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_def, 8895 DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 8896 LIST_PF_SUBST_SEM, LIST_SF_SUBST_SEM, LIST_PF_SEM_THM, 8897 PF_SEM_def, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 8898 DS_POINTER_DANGLES, DS_VAR_SUBST_SEM, DS_EXPRESSION_EVAL_VALUE_def, 8899 MAP_MAP_o, combinTheory.o_DEF, HEAP_DISTINCT_def, 8900 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, FILTER_MAP] THEN 8901SIMP_TAC std_ss [PAIR_BETA_THM] THEN 8902SIMP_TAC std_ss [GSYM pairTheory.PFORALL_THM, GSYM pairTheory.PEXISTS_THM] THEN 8903REPEAT GEN_TAC THEN 8904EQ_TAC THEN STRIP_TAC THENL [ 8905 REPEAT GEN_TAC THEN STRIP_TAC THEN 8906 Q.PAT_X_ASSUM `!s h. P s h ==> Q1 s h /\ Q2 s h` (fn thm => (MP_TAC (Q.SPECL [`s`, `h`] thm))) THEN 8907 `(\x. (if x = v then DS_EXPRESSION_EVAL s e else s x)) = s` by ( 8908 ASM_SIMP_TAC std_ss [FUN_EQ_THM, COND_RATOR, COND_RAND] 8909 ) THEN 8910 ASM_SIMP_TAC std_ss [], 8911 8912 8913 REPEAT GEN_TAC THEN STRIP_TAC THEN 8914 Q.PAT_X_ASSUM `!s h. P s h ==> (LIST_PF_SEM s pfL' /\ Z)` (fn thm => (MP_TAC (Q.SPECL [`\x. (if x = v then DS_EXPRESSION_EVAL s e else s x)`, `h`] thm))) THEN 8915 ASM_SIMP_TAC std_ss [] THEN 8916 Cases_on `e` THENL [ 8917 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def], 8918 SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, COND_RATOR, COND_RAND] 8919 ] 8920]); 8921 8922 8923 8924val INFERENCE_REFLEXIVE_L = store_thm ("INFERENCE_REFLEXIVE_L", 8925``!e c1 c2 pfL sfL pfL' sfL'. 8926 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 8927 LIST_DS_ENTAILS (c1,c2) ((pf_equal e e)::pfL, sfL) (pfL', sfL')``, 8928SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, 8929 DS_EXPRESSION_EQUAL_def, PF_SEM_def]); 8930 8931 8932 8933 8934val INFERENCE_NIL_NOT_LVAL___points_to = store_thm ("INFERENCE_NIL_NOT_LVAL___points_to", 8935``!e c1 c2 a pfL sfL pfL' sfL'. 8936 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e dse_nil)::pfL, (sf_points_to e a)::sfL) (pfL', sfL') = 8937 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e a)::sfL) (pfL', sfL')``, 8938 8939SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, 8940 DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 8941 IS_DSV_NIL_THM, dse_nil_def, SF_SEM_def, PF_SEM_def] THEN 8942METIS_TAC[]); 8943 8944 8945 8946val INFERENCE_NIL_NOT_LVAL___tree = store_thm ("INFERENCE_NIL_NOT_LVAL___tree", 8947``!e1 e2 fL c1 c2 pfL sfL pfL' sfL'. 8948 MEM_UNEQ_PF_LIST e1 e2 pfL ==> 8949 8950 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e2 dse_nil)::pfL, (sf_tree fL e1 e2)::sfL) (pfL', sfL') = 8951 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_tree fL e1 e2)::sfL) (pfL', sfL'))``, 8952 8953 8954SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, 8955 DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 8956 IS_DSV_NIL_THM, dse_nil_def, SF_SEM_def, PF_SEM_def, 8957 SF_SEM___sf_tree_def] THEN 8958REPEAT STRIP_TAC THEN 8959REPEAT STRIP_EQ_FORALL_TAC THEN 8960STRIP_EQ_BOOL_TAC THEN 8961SIMP_TAC std_ss [] THEN 8962STRIP_EQ_BOOL_TAC THEN 8963FULL_SIMP_TAC std_ss [] THEN 8964`~(DS_EXPRESSION_EQUAL s e1 e2)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 8965Cases_on `n` THENL [ 8966 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def], 8967 8968 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_len_def, PF_SEM_def, DS_EXPRESSION_EQUAL_def, 8969 IS_DSV_NIL_THM] 8970]) 8971 8972 8973 8974val INFERENCE_NIL_NOT_LVAL___list = store_thm ("INFERENCE_NIL_NOT_LVAL___list", 8975``!e1 e2 f c1 c2 pfL sfL pfL' sfL'. 8976 MEM_UNEQ_PF_LIST e2 e1 pfL ==> 8977 8978 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 dse_nil)::pfL, (sf_ls f e1 e2)::sfL) (pfL', sfL') = 8979 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', sfL'))``, 8980 8981SIMP_TAC std_ss [sf_ls_def] THEN 8982METIS_TAC[INFERENCE_NIL_NOT_LVAL___tree]); 8983 8984 8985 8986 8987 8988val INFERENCE_PARTIAL___points_to___points_to = store_thm ("INFERENCE_PARTIAL___points_to___points_to", 8989``!e1 e2 a1 a2 c1 c2 pfL sfL pfL' sfL'. 8990 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e2)::pfL, (sf_points_to e1 a1)::(sf_points_to e2 a2)::sfL) (pfL', sfL') = 8991 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e1 a1)::(sf_points_to e2 a2)::sfL) (pfL', sfL')``, 8992 8993SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, 8994 DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 8995 IS_DSV_NIL_THM, dse_nil_def, FDOM_DOMSUB, IN_DELETE] THEN 8996METIS_TAC[GET_DSV_VALUE_11]) 8997 8998 8999 9000val INFERENCE_PARTIAL___points_to___tree = store_thm ("INFERENCE_PARTIAL___points_to___tree", 9001``!e1 e2 e3 e4 fL c1 c2 pfL sfL pfL' sfL'. 9002 MEM_UNEQ_PF_LIST e3 e4 pfL ==> 9003 ( 9004 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e3)::pfL, (sf_points_to e1 e2)::(sf_tree fL e4 e3)::sfL) (pfL', sfL') = 9005 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e1 e2)::(sf_tree fL e4 e3)::sfL) (pfL', sfL'))``, 9006 9007SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, DS_EXPRESSION_EQUAL_def] THEN 9008REPEAT STRIP_TAC THEN 9009REPEAT STRIP_EQ_FORALL_TAC THEN 9010STRIP_EQ_BOOL_TAC THEN 9011SIMP_TAC std_ss [] THEN 9012STRIP_EQ_BOOL_TAC THEN 9013`~(DS_EXPRESSION_EQUAL s e3 e4)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 9014FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, DS_EXPRESSION_EQUAL_def, LET_THM] THEN 9015FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, FDOM_DOMSUB, IN_DELETE] THEN 9016METIS_TAC[]) 9017 9018 9019 9020val INFERENCE_PARTIAL___tree___tree = store_thm ("INFERENCE_PARTIAL___tree___tree", 9021``!e1 e2 e3 e4 fL fL' c1 c2 pfL sfL pfL' sfL'. 9022 (MEM_UNEQ_PF_LIST e1 e2 pfL /\ MEM_UNEQ_PF_LIST e3 e4 pfL) ==> 9023 9024 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e3)::pfL, (sf_tree fL e2 e1)::(sf_tree fL' e4 e3)::sfL) (pfL', sfL') = 9025 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_tree fL e2 e1)::(sf_tree fL' e4 e3)::sfL) (pfL', sfL'))``, 9026 9027SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, DS_EXPRESSION_EQUAL_def] THEN 9028REPEAT STRIP_TAC THEN 9029REPEAT STRIP_EQ_FORALL_TAC THEN 9030STRIP_EQ_BOOL_TAC THEN 9031SIMP_TAC std_ss [] THEN 9032STRIP_EQ_BOOL_TAC THEN 9033`~(DS_EXPRESSION_EQUAL s e1 e2)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 9034`~(DS_EXPRESSION_EQUAL s e3 e4)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 9035 9036FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM, MAP_MAP_o] THEN 9037`!(s :'b -> 'a ds_value) (h:('a,'c) heap) pfL sfL f (fL:'c list). 9038 LIST_DS_SEM s h (pfL, (MAP f fL) ++ sfL) = 9039 LIST_DS_SEM s h (pfL, sfL ++ (MAP f fL))` by ( 9040 REPEAT GEN_TAC THEN 9041 MATCH_MP_TAC LIST_DS_SEM_PERM THEN 9042 SIMP_TAC std_ss [PERM_REFL, PERM_APPEND] 9043) THEN 9044FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 9045FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, FDOM_DOMSUB, IN_DELETE] THEN 9046METIS_TAC[]) 9047 9048 9049 9050val INFERENCE_PARTIAL___precondition___points_to = store_thm ("INFERENCE_PARTIAL___precondition___points_to", 9051``!e1 e2 e3 c1 c2 pfL sfL pfL' sfL'. 9052 MEM e3 c1 ==> 9053 9054 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e3)::pfL, (sf_points_to e1 e2)::sfL) (pfL', sfL') = 9055 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e1 e2)::sfL) (pfL', sfL'))``, 9056 9057SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, 9058 DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, DS_EXPRESSION_EVAL_def, 9059 IS_DSV_NIL_THM, dse_nil_def, FDOM_DOMSUB, IN_DELETE] THEN 9060REPEAT STRIP_TAC THEN 9061REPEAT STRIP_EQ_FORALL_TAC THEN 9062STRIP_EQ_BOOL_TAC THEN 9063ASM_SIMP_TAC std_ss [] THEN 9064STRIP_EQ_BOOL_TAC THEN 9065METIS_TAC[HEAP_DISTINCT_def] 9066); 9067 9068 9069val INFERENCE_PARTIAL___precondition___tree = store_thm ("INFERENCE_PARTIAL___precondition___tree", 9070``!es e e' fL c1 c2 pfL sfL pfL' sfL'. 9071 (MEM e' c1 /\ MEM_UNEQ_PF_LIST e es pfL) ==> 9072 9073 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e e')::pfL, (sf_tree fL es e)::sfL) (pfL', sfL') = 9074 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_tree fL es e)::sfL) (pfL', sfL'))``, 9075 9076 9077SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, DS_EXPRESSION_EQUAL_def] THEN 9078REPEAT STRIP_TAC THEN 9079REPEAT STRIP_EQ_FORALL_TAC THEN 9080STRIP_EQ_BOOL_TAC THEN 9081ASM_SIMP_TAC std_ss [] THEN 9082STRIP_EQ_BOOL_TAC THEN 9083FULL_SIMP_TAC std_ss [LIST_DS_SEM_THM] THEN 9084`~((GET_DSV_VALUE (DS_EXPRESSION_EVAL s e')) IN FDOM h)` by METIS_TAC[HEAP_DISTINCT_def] THEN 9085POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN 9086Q.PAT_X_ASSUM `SF_SEM s h1 Y` MP_TAC THEN 9087`~(DS_EXPRESSION_EQUAL s e es)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 9088ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_THM, DS_EXPRESSION_EQUAL_def, LET_THM, 9089SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, FDOM_FUNION, IN_UNION] THEN 9090METIS_TAC[]) 9091 9092 9093 9094 9095 9096 9097val INFERENCE_EXCLUDED_MIDDLE = store_thm ("INFERENCE_EXCLUDED_MIDDLE", 9098``!e1:('b, 'a) ds_expression e2 c1 c2 pfL sfL pfL' sfL'. 9099 (LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e2)::pfL, sfL) (pfL', sfL') /\ 9100 LIST_DS_ENTAILS (c1,c2) ((pf_equal e1 e2)::pfL, sfL) (pfL', sfL')) 9101 = 9102 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL')``, 9103 9104 9105SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, PF_SEM_def] THEN 9106METIS_TAC[]); 9107 9108 9109 9110 9111 9112 9113val INFERENCE_EMP_TREE_L = store_thm ("INFERENCE_EMP_TREE_L", 9114``!e fL c1 c2 pfL sfL pfL' sfL'. 9115 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9116 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_tree fL e e)::sfL) (pfL', sfL')``, 9117 9118SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM] THEN 9119ONCE_REWRITE_TAC [SF_SEM___sf_tree_THM] THEN 9120SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, 9121 DISJOINT_EMPTY, FDOM_FEMPTY, FUNION_FEMPTY_1]) 9122 9123 9124 9125val INFERENCE_EMP_BIN_TREE_L = store_thm ("INFERENCE_EMP_BIN_TREE_L", 9126``!f1 f2 c1 c2 pfL sfL pfL' sfL'. 9127 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9128 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_bin_tree (f1,f2) dse_nil)::sfL) (pfL', sfL')``, 9129 9130SIMP_TAC std_ss [sf_bin_tree_def] THEN 9131METIS_TAC[INFERENCE_EMP_TREE_L]) 9132 9133 9134 9135val INFERENCE_EMP_LIST_L = store_thm ("INFERENCE_EMP_LIST_L", 9136``!f e c1 c2 pfL sfL pfL' sfL'. 9137 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9138 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e e)::sfL) (pfL', sfL')``, 9139 9140SIMP_TAC std_ss [sf_ls_def] THEN 9141METIS_TAC[INFERENCE_EMP_TREE_L]) 9142 9143 9144 9145 9146 9147 9148 9149(*Subtraction Rules*) 9150 9151 9152val INFERENCE_AXIOM = store_thm ("INFERENCE_AXIOM", 9153``!pfL c1 c2. LIST_DS_ENTAILS (c1,c2) (pfL, []) ([], [])``, 9154SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, LIST_SF_SEM_THM]); 9155 9156 9157 9158val INFERENCE_REFLEXIVE_R = store_thm ("INFERENCE_REFLEXIVE_R", 9159``!e c1 c2 pfL sfL pfL' sfL'. 9160 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9161 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) ((pf_equal e e)::pfL', sfL')``, 9162SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, 9163 DS_EXPRESSION_EQUAL_def]); 9164 9165 9166 9167val INFERENCE_HYPOTHESIS = store_thm ("INFERENCE_HYPOTHESIS", 9168``!pf c1 c2 pfL sfL pfL' sfL'. 9169 LIST_DS_ENTAILS c (pf::pfL, sfL) (pfL', sfL') = 9170 LIST_DS_ENTAILS c (pf::pfL, sfL) (pf::pfL', sfL')``, 9171SIMP_TAC std_ss [LIST_DS_ENTAILS_def, 9172 LIST_DS_SEM_def, LIST_PF_SEM_THM] THEN 9173METIS_TAC[]); 9174 9175 9176 9177 9178val INFERENCE_EMP_TREE_R = store_thm ("INFERENCE_EMP_TREE_R", 9179``!e fL c1 c2 pfL sfL pfL' sfL'. 9180 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9181 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', (sf_tree fL e e)::sfL')``, 9182 9183SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM] THEN 9184ONCE_REWRITE_TAC [SF_SEM___sf_tree_THM] THEN 9185SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, 9186 DISJOINT_EMPTY, FDOM_FEMPTY, FUNION_FEMPTY_1]) 9187 9188 9189 9190val INFERENCE_EMP_BIN_TREE_R = store_thm ("INFERENCE_EMP_BIN_TREE_R", 9191``!f1 f2 c1 c2 pfL sfL pfL' sfL'. 9192 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9193 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', (sf_bin_tree (f1,f2) dse_nil)::sfL')``, 9194 9195SIMP_TAC std_ss [sf_bin_tree_def] THEN 9196METIS_TAC[INFERENCE_EMP_TREE_R]) 9197 9198 9199 9200val INFERENCE_EMP_LIST_R = store_thm ("INFERENCE_EMP_LIST_R", 9201``!f e c1 c2 pfL sfL pfL' sfL'. 9202 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9203 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', (sf_ls f e e)::sfL')``, 9204 9205SIMP_TAC std_ss [sf_ls_def] THEN 9206METIS_TAC[INFERENCE_EMP_TREE_R]); 9207 9208 9209 9210 9211 9212val INFERENCE_STAR_INTRODUCTION___IMPL = store_thm ("INFERENCE_STAR_INTRODUCTION___IMPL", 9213``!sf c1 c2 pfL sfL pfL' sfL'. 9214 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') ==> 9215 LIST_DS_ENTAILS (c1,c2) (pfL, sf::sfL) (pfL', sf::sfL')``, 9216 9217SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_def, 9218 LIST_SF_SEM_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 9219REPEAT STRIP_TAC THEN 9220Q.EXISTS_TAC `h1` THEN 9221Q.EXISTS_TAC `h2` THEN 9222ASM_SIMP_TAC std_ss [] THEN 9223Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9224FULL_SIMP_TAC std_ss [HEAP_DISTINCT___FUNION]); 9225 9226 9227 9228 9229val INFERENCE_STAR_INTRODUCTION___points_to = store_thm ("INFERENCE_STAR_INTRODUCTION___points_to", 9230``!e a1 a2 c1 c2 pfL sfL pfL' sfL'. 9231 ((!x. MEM x a2 ==> MEM x a1) /\ 9232 ALL_DISTINCT (MAP FST a1)) ==> 9233 ( 9234 LIST_DS_ENTAILS (e::c1, c2) (pfL, sfL) (pfL', sfL') = 9235 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e a1)::sfL) (pfL', (sf_points_to e a2)::sfL'))``, 9236 9237SIMP_TAC list_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL, DISJ_IMP_THM, FORALL_AND_THM] THEN 9238REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 9239 REPEAT GEN_TAC THEN STRIP_TAC THEN 9240 CONJ_TAC THENL [ 9241 METIS_TAC[DS_POINTS_TO___SUBLIST], 9242 9243 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9244 `?c'. (DS_EXPRESSION_EVAL s e = dsv_const c') /\ 9245 (c' IN FDOM h)` by ( 9246 FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, NOT_IS_DSV_NIL_THM, ds_value_11] THEN 9247 METIS_TAC[GET_DSV_VALUE_def] 9248 ) THEN 9249 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_POINTER_DANGLES, FDOM_DOMSUB, IN_DELETE, 9250 DS_EXPRESSION_EQUAL_def, dse_nil_def, DS_EXPRESSION_EVAL_def, ds_value_distinct, 9251 MEM_MAP, IS_DSV_NIL_def, HEAP_DISTINCT___IND_DEF, DS_EXPRESSION_EVAL_VALUE_def] THEN 9252 REPEAT STRIP_TAC THENL [ 9253 FULL_SIMP_TAC std_ss [HEAP_DISTINCT_def, FDOM_DOMSUB, IN_DELETE, DS_POINTER_DANGLES] THEN 9254 METIS_TAC[], 9255 9256 FULL_SIMP_TAC std_ss [HEAP_DISTINCT_def, DS_POINTS_TO_def] THEN 9257 METIS_TAC[], 9258 9259 Cases_on `DS_EXPRESSION_EVAL s e1 = DS_EXPRESSION_EVAL s e2` THEN ASM_REWRITE_TAC[] THEN 9260 FULL_SIMP_TAC std_ss [HEAP_DISTINCT_def, DS_POINTS_TO_def, DS_EXPRESSION_EQUAL_def] THEN 9261 METIS_TAC[] 9262 ] 9263 ], 9264 9265 9266 SIMP_TAC std_ss [HEAP_DISTINCT___IND_DEF] THEN 9267 REPEAT STRIP_TAC THEN 9268 `?c'. (DS_EXPRESSION_EVAL s e = dsv_const c')` by ( 9269 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 9270 ) THEN 9271 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def, 9272 IS_DSV_NIL_def] THEN 9273 `?he. (FDOM he = {c'}) /\ DS_POINTS_TO s he e a1` by ( 9274 ASM_SIMP_TAC std_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, 9275 IS_DSV_NIL_def, EVERY_MEM] THEN 9276 Q.PAT_X_ASSUM `ALL_DISTINCT (MAP FST a1)` MP_TAC THEN 9277 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9278 Induct_on `a1` THENL [ 9279 SIMP_TAC list_ss [] THEN 9280 Q.EXISTS_TAC `FEMPTY |+ (c', FEMPTY)` THEN 9281 SIMP_TAC std_ss [FDOM_FUPDATE, FDOM_FEMPTY, IN_INSERT], 9282 9283 9284 FULL_SIMP_TAC list_ss [DISJ_IMP_THM, FORALL_AND_THM, EVERY_MEM, MEM_MAP, 9285 GSYM LEFT_FORALL_IMP_THM] THEN 9286 REPEAT STRIP_TAC THEN 9287 FULL_SIMP_TAC std_ss [] THEN 9288 pairLib.GEN_BETA_TAC THEN 9289 Q.EXISTS_TAC `FEMPTY |+ (c', (he ' c') |+ (FST h, DS_EXPRESSION_EVAL s (SND h)))` THEN 9290 ASM_SIMP_TAC std_ss [FDOM_FUPDATE, FDOM_FEMPTY, IN_SING, FAPPLY_FUPDATE_THM, IN_INSERT] THEN 9291 GEN_TAC THEN STRIP_TAC THEN 9292 Cases_on `e'` THEN 9293 RES_TAC THEN 9294 FULL_SIMP_TAC std_ss [COND_RATOR, COND_RAND] THEN 9295 METIS_TAC[pairTheory.FST] 9296 ] 9297 ) THEN 9298 Q.PAT_X_ASSUM `!s h. P s h ==> (DS_POINTS_TO s h e a2 /\ Y)` (fn thm => MP_TAC (Q.SPECL [`s`, `FUNION he h`] thm)) THEN 9299 ASM_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_POINTER_DANGLES, FDOM_FUNION, IN_UNION, IN_SING] THEN 9300 `(he \\ c' = FEMPTY) /\ (h \\ c' = h)` by ( 9301 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FDOM_DOMSUB, IN_DELETE, IN_SING, FDOM_FEMPTY, 9302 NOT_IN_EMPTY, DOMSUB_FAPPLY_THM] THEN 9303 METIS_TAC[] 9304 ) THEN 9305 `!x. DS_POINTS_TO s (FUNION he h) e x = DS_POINTS_TO s he e x` by ( 9306 ASM_SIMP_TAC std_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, FUNION_DEF, IN_UNION, IN_SING] 9307 ) THEN 9308 `HEAP_DISTINCT s (FUNION he h) c1 c2` by ( 9309 FULL_SIMP_TAC std_ss [HEAP_DISTINCT___FUNION, HEAP_DISTINCT_def, IN_SING, DS_EXPRESSION_EQUAL_def] THEN 9310 METIS_TAC[GET_DSV_VALUE_def, NOT_IS_DSV_NIL_THM] 9311 ) THEN 9312 ASM_SIMP_TAC std_ss [DOMSUB_FUNION, FUNION_FEMPTY_1] 9313]); 9314 9315 9316 9317val INFERENCE_STAR_INTRODUCTION___tree = store_thm ("INFERENCE_STAR_INTRODUCTION___tree", 9318``!e es fL fL' c1 c2 pfL sfL pfL' sfL'. 9319 (PERM fL fL') ==> 9320 ( 9321 LIST_DS_ENTAILS (c1, (e,es)::c2) (pfL, sfL) (pfL', sfL') = 9322 LIST_DS_ENTAILS (c1, c2) (pfL, (sf_tree fL es e)::sfL) (pfL', (sf_tree fL' es e)::sfL'))``, 9323 9324SIMP_TAC list_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_THM, DISJ_IMP_THM, FORALL_AND_THM] THEN 9325REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ 9326 REPEAT GEN_TAC THEN STRIP_TAC THEN 9327 Q.EXISTS_TAC `h1` THEN 9328 Q.EXISTS_TAC `h2` THEN 9329 ASM_SIMP_TAC std_ss [] THEN 9330 CONJ_TAC THENL [ 9331 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9332 ASM_SIMP_TAC std_ss [] THEN 9333 FULL_SIMP_TAC list_ss [HEAP_DISTINCT___IND_DEF, HEAP_DISTINCT___FUNION] THEN 9334 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN ASM_REWRITE_TAC[] THEN 9335 FULL_SIMP_TAC list_ss [SF_SEM___sf_tree_THM, LET_THM, SF_SEM___sf_points_to_THM, 9336 DS_POINTS_TO_def, HEAP_DISTINCT_def, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 9337 DS_EXPRESSION_EQUAL_def] THEN 9338 METIS_TAC[], 9339 9340 FULL_SIMP_TAC std_ss [SF_SEM_def, SF_SEM___sf_tree_def] THEN 9341 METIS_TAC[SF_SEM___sf_tree_len_PERM_THM] 9342 ], 9343 9344 9345 SIMP_TAC std_ss [HEAP_DISTINCT___IND_DEF] THEN 9346 REPEAT GEN_TAC THEN 9347 Cases_on `DS_EXPRESSION_EQUAL s e es` THEN ASM_REWRITE_TAC[] THEN1 ( 9348 STRIP_TAC THEN 9349 Q.PAT_X_ASSUM `!s h. P s h` (fn thm => MP_TAC (Q.SPECL [`s`, `h`] thm)) THEN 9350 ASM_SIMP_TAC std_ss [SF_SEM___sf_tree_THM, FDOM_FEMPTY, DISJOINT_EMPTY, 9351 FUNION_FEMPTY_1] 9352 ) THEN 9353 STRIP_TAC THEN 9354 9355 `?c'. (DS_EXPRESSION_EVAL s e = dsv_const c')` by ( 9356 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 9357 ) THEN 9358 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def, IS_DSV_NIL_def] THEN 9359 `?he. (FDOM he = {c'}) /\ SF_SEM s he (sf_tree fL es e)` by ( 9360 Q.EXISTS_TAC `FEMPTY |+ (c', FUN_FMAP (\x. DS_EXPRESSION_EVAL s es) (LIST_TO_SET fL))` THEN 9361 SIMP_TAC std_ss [FDOM_FUPDATE, FDOM_FEMPTY, 9362 SF_SEM_def, SF_SEM___sf_tree_def] THEN 9363 Q.EXISTS_TAC `SUC 0` THEN 9364 REWRITE_TAC[SF_SEM___sf_tree_len_def] THEN 9365 FULL_SIMP_TAC list_ss [PF_SEM_def, GET_DSV_VALUE_def, FDOM_FUPDATE, IN_INSERT, DS_EXPRESSION_EQUAL_def, IS_DSV_NIL_def] THEN 9366 Q.EXISTS_TAC `MAP (\x. FEMPTY) fL` THEN 9367 ASM_SIMP_TAC list_ss [DOMSUB_FUPDATE, EVERY_MEM, MEM_MAP, GSYM LEFT_FORALL_IMP_THM, 9368 HEAP_READ_ENTRY_def, GET_DSV_VALUE_def, FDOM_FUPDATE, IN_INSERT, FAPPLY_FUPDATE_THM, 9369 FUN_FMAP_DEF, FINITE_LIST_TO_SET, DOMSUB_FEMPTY, MAP_MAP_o, combinTheory.o_DEF, 9370 FDOM_FEMPTY, EL_ALL_DISJOINT_EQ, EL_MAP, DISJOINT_EMPTY, MEM_ZIP, 9371 DS_EXPRESSION_EVAL_def, EL_IS_EL, IS_DSV_NIL_def] THEN 9372 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9373 Induct_on `fL` THENL [ 9374 SIMP_TAC list_ss [], 9375 ASM_SIMP_TAC list_ss [FUNION_FEMPTY_1] 9376 ] 9377 ) THEN 9378 9379 FULL_SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, GSYM LEFT_FORALL_IMP_THM, 9380 MEM_MAP, IS_DSV_NIL_def] THEN 9381 Q.PAT_X_ASSUM `!s h1 h2. P s h1 h2` (fn thm => MP_TAC (Q.SPECL [`s`, `he`, `h`] thm)) THEN 9382 9383 `HEAP_DISTINCT s he c1 c2` by ( 9384 FULL_SIMP_TAC std_ss [HEAP_DISTINCT_def, IN_SING, DS_EXPRESSION_EQUAL_def] THEN 9385 METIS_TAC[NOT_IS_DSV_NIL_THM, GET_DSV_VALUE_def] 9386 ) THEN 9387 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION, IN_SING, 9388 DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, HEAP_DISTINCT___FUNION] THEN 9389 STRIP_TAC THEN 9390 9391 `h1' = he` by ( 9392 `SF_IS_PRECISE (sf_tree fL es e)` by REWRITE_TAC[SF_IS_PRECISE_THM] THEN 9393 FULL_SIMP_TAC std_ss [SF_IS_PRECISE_def] THEN 9394 POP_ASSUM MATCH_MP_TAC THEN 9395 Q.EXISTS_TAC `s` THEN 9396 Q.EXISTS_TAC `FUNION he h` THEN 9397 REWRITE_TAC[SUBMAP___FUNION___ID] THEN 9398 ASM_SIMP_TAC std_ss [SUBMAP___FUNION___ID] THEN 9399 FULL_SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 9400 METIS_TAC[SF_SEM___sf_tree_len_PERM_THM] 9401 ) THEN 9402 `DISJOINT (FDOM he) (FDOM h) /\ 9403 DISJOINT (FDOM he) (FDOM h2')` by ( 9404 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, IN_SING] THEN 9405 METIS_TAC[] 9406 ) THEN 9407 Q.PAT_X_ASSUM `FUNION h2 h = Y` MP_TAC THEN 9408 ASM_SIMP_TAC std_ss [FUNION_EQ] 9409]) 9410 9411 9412 9413 9414val INFERENCE_STAR_INTRODUCTION___list = store_thm ("INFERENCE_STAR_INTRODUCTION___list", 9415``!e1 e2 f c1 c2 pfL sfL pfL' sfL'. 9416 LIST_DS_ENTAILS (c1, (e1,e2)::c2) (pfL, sfL) (pfL', sfL') = 9417 LIST_DS_ENTAILS (c1, c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', (sf_ls f e1 e2)::sfL')``, 9418 9419SIMP_TAC std_ss [sf_ls_def] THEN 9420REPEAT GEN_TAC THEN 9421MATCH_MP_TAC INFERENCE_STAR_INTRODUCTION___tree THEN 9422SIMP_TAC std_ss [PERM_REFL]) 9423 9424 9425val INFERENCE_STAR_INTRODUCTION___bin_tree = store_thm ("INFERENCE_STAR_INTRODUCTION___bin_tree", 9426``!e f1 f2 f1' f2' c1 c2 pfL sfL pfL' sfL'. 9427 (((f1 = f1') /\ (f2 = f2')) \/ ((f1 = f2') /\ (f2 = f1'))) ==> 9428 9429 (LIST_DS_ENTAILS (c1, (e,dse_nil)::c2) (pfL, sfL) (pfL', sfL') = 9430 LIST_DS_ENTAILS (c1, c2) (pfL, (sf_bin_tree (f1,f2) e)::sfL) (pfL', (sf_bin_tree (f1',f2') e)::sfL'))``, 9431 9432SIMP_TAC std_ss [sf_bin_tree_def] THEN 9433REPEAT STRIP_TAC THEN ( 9434 MATCH_MP_TAC INFERENCE_STAR_INTRODUCTION___tree THEN 9435 ASM_SIMP_TAC std_ss [PERM_REFL, PERM_SWAP_AT_FRONT] 9436)); 9437 9438 9439val LIST_DS_ENTAILS___ELIM_PRECONDITION_1 = store_thm ("LIST_DS_ENTAILS___ELIM_PRECONDITION_1", 9440``!c11 c12 c2 pfL pfL' sfL sfL'. 9441 LIST_DS_ENTAILS ((c11++c12), c2) (pfL, sfL) (pfL', sfL') = 9442 LIST_DS_ENTAILS (c12,c2) (pfL,(MAP (\e. sf_points_to e []) c11)++sfL) (pfL',(MAP (\e. sf_points_to e []) c11)++ sfL')``, 9443 9444Induct_on `c11` THENL [ 9445 SIMP_TAC list_ss [], 9446 9447 SIMP_TAC list_ss [] THEN 9448 ASM_SIMP_TAC list_ss [GSYM INFERENCE_STAR_INTRODUCTION___points_to] THEN 9449 POP_ASSUM (ASSUME_TAC o GSYM) THEN 9450 ASM_SIMP_TAC std_ss [] THEN 9451 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9452 REPEAT GEN_TAC THEN 9453 REPEAT STRIP_EQ_FORALL_TAC THEN 9454 STRIP_EQ_BOOL_TAC THEN 9455 SIMP_TAC std_ss [] THEN 9456 STRIP_EQ_BOOL_TAC THEN 9457 MATCH_MP_TAC HEAP_DISTINCT___PERM THEN 9458 SIMP_TAC list_ss [PERM_CONS_EQ_APPEND, PERM_REFL] THEN 9459 Q.EXISTS_TAC `c11` THEN 9460 Q.EXISTS_TAC `c12` THEN 9461 SIMP_TAC std_ss [PERM_REFL] 9462]); 9463 9464 9465val LIST_DS_ENTAILS___ELIM_PRECONDITION_2 = store_thm ("LIST_DS_ENTAILS___ELIM_PRECONDITION_2", 9466``!c21 c22 c1 pfL pfL' sfL sfL'. 9467 LIST_DS_ENTAILS (c1, (c21++c22)) (pfL, sfL) (pfL', sfL') = 9468 LIST_DS_ENTAILS (c1, c22) (pfL,(MAP (\(e1,e2). sf_tree [] e2 e1) c21)++sfL) (pfL',(MAP (\(e1,e2). sf_tree [] e2 e1) c21)++sfL')``, 9469 9470Induct_on `c21` THENL [ 9471 SIMP_TAC list_ss [], 9472 9473 Cases_on `h` THEN 9474 SIMP_TAC list_ss [] THEN 9475 ASM_SIMP_TAC list_ss [GSYM INFERENCE_STAR_INTRODUCTION___tree, PERM_REFL] THEN 9476 POP_ASSUM (ASSUME_TAC o GSYM) THEN 9477 ASM_SIMP_TAC std_ss [] THEN 9478 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9479 REPEAT GEN_TAC THEN 9480 REPEAT STRIP_EQ_FORALL_TAC THEN 9481 STRIP_EQ_BOOL_TAC THEN 9482 SIMP_TAC std_ss [] THEN 9483 STRIP_EQ_BOOL_TAC THEN 9484 MATCH_MP_TAC HEAP_DISTINCT___PERM THEN 9485 SIMP_TAC list_ss [PERM_CONS_EQ_APPEND, PERM_REFL] THEN 9486 Q.EXISTS_TAC `c21` THEN 9487 Q.EXISTS_TAC `c22` THEN 9488 SIMP_TAC std_ss [PERM_REFL] 9489]); 9490 9491 9492 9493val LIST_DS_ENTAILS___ELIM_PRECONDITION_COMPLETE = store_thm ("LIST_DS_ENTAILS___ELIM_PRECONDITION_COMPLETE", 9494``!c1 c2. ?sfL2. !pfL pfL' sfL sfL'. 9495 LIST_DS_ENTAILS (c1,c2) (pfL, sfL) (pfL', sfL') = 9496 LIST_DS_ENTAILS ([],[]) (pfL, sfL++sfL2) (pfL',sfL'++sfL2)``, 9497 9498REPEAT GEN_TAC THEN 9499ASSUME_TAC (Q.SPECL [`c1`, `[]`] LIST_DS_ENTAILS___ELIM_PRECONDITION_1) THEN 9500ASSUME_TAC (Q.SPECL [`c2`, `[]`] LIST_DS_ENTAILS___ELIM_PRECONDITION_2) THEN 9501FULL_SIMP_TAC list_ss [] THEN 9502REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9503 9504Q.ABBREV_TAC `sfL2 = MAP (\(e1,e2). sf_tree [] e2 e1) c2 ++ MAP (\e. sf_points_to e []) c1` THEN 9505Q.EXISTS_TAC `sfL2` THEN 9506REPEAT GEN_TAC THEN 9507MATCH_MP_TAC LIST_DS_ENTAILS___PERM THEN 9508SIMP_TAC std_ss [PERM_REFL, PERM_APPEND]); 9509 9510 9511 9512 9513 9514 9515 9516 9517 9518val INFERENCE_NON_EMPTY_TREE = store_thm ("INFERENCE_NON_EMPTY_TREE", 9519``!e es c1 c2 eL fL a pfL sfL pfL' sfL'. 9520 ((LENGTH eL = LENGTH fL) /\ ALL_DISTINCT fL /\ 9521 (!n. n < LENGTH eL ==> MEM (EL n fL, EL n eL) a)) ==> 9522 9523 ((LIST_DS_ENTAILS (c1,c2) ((pf_unequal e es)::pfL, (sf_points_to e a)::sfL) (pfL', 9524 (sf_points_to e a)::((MAP (\e. sf_tree fL es e) eL)++sfL'))) = 9525 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e es)::pfL, (sf_points_to e a)::sfL) (pfL', (sf_tree fL es e)::sfL'))``, 9526 9527 9528SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9529SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 9530REPEAT STRIP_TAC THEN 9531REPEAT STRIP_EQ_FORALL_TAC THEN 9532STRIP_EQ_BOOL_TAC THEN 9533FULL_SIMP_TAC std_ss [MAP_MAP_o, combinTheory.o_DEF] THEN 9534`?c. DS_EXPRESSION_EVAL s e = dsv_const c` by ( 9535 FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, NOT_IS_DSV_NIL_THM, 9536 ds_value_11] 9537) THEN 9538FULL_SIMP_TAC list_ss [GET_DSV_VALUE_def, DS_EXPRESSION_EVAL_VALUE_def] THEN 9539SIMP_TAC std_ss [LIST_DS_SEM_THM, GSYM RIGHT_EXISTS_AND_THM] THEN 9540REPEAT STRIP_EQ_EXISTS_TAC THEN 9541STRIP_EQ_BOOL_TAC THEN 9542 9543MATCH_MP_TAC (prove (``(a /\ (b1 = b2)) ==> (b1 = (a /\ b2))``, METIS_TAC[])) THEN 9544 9545Q_TAC MP_FREE_VAR_TAC `fL` THEN 9546Q.SPEC_TAC (`eL`, `eL`) THEN 9547Q.SPEC_TAC (`h1`, `h1`) THEN 9548REWRITE_TAC[AND_IMP_INTRO, GSYM CONJ_ASSOC] THEN 9549`?fL'. sf_tree fL = sf_tree fL'` by METIS_TAC[] THEN 9550FULL_SIMP_TAC std_ss [] THEN POP_ASSUM (K ALL_TAC) THEN 9551Induct_on `fL` THENL [ 9552 FULL_SIMP_TAC list_ss [LENGTH_NIL, DS_POINTS_TO_def, IS_DSV_NIL_def, GET_DSV_VALUE_def], 9553 9554 Cases_on `eL` THEN SIMP_TAC list_ss [] THEN 9555 SIMP_TAC list_ss [FORALL_LESS_SUC, LIST_DS_SEM_THM] THEN 9556 REPEAT STRIP_TAC THENL [ 9557 FULL_SIMP_TAC std_ss [IMP_CONJ_THM, FORALL_AND_THM] THEN 9558 Q.PAT_X_ASSUM `!eL. P1 eL /\ P2 eL ==> P eL` (MP_TAC o (Q.SPECL [`t`])) THEN 9559 ASM_REWRITE_TAC[] THEN 9560 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, EVERY_MEM, MEM_MAP, GET_DSV_VALUE_def, GSYM LEFT_FORALL_IMP_THM, IS_DSV_NIL_def, MEM_ZIP, DS_EXPRESSION_EVAL_def] THEN 9561 RES_TAC THEN 9562 FULL_SIMP_TAC std_ss [], 9563 9564 9565 REPEAT STRIP_EQ_EXISTS_TAC THEN 9566 STRIP_EQ_BOOL_TAC THEN 9567 BINOP_TAC THENL [ 9568 METIS_TAC[], 9569 9570 9571 `DS_EXPRESSION_EQUAL s h' (dse_const (h ' c ' h''))` by ( 9572 FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, GET_DSV_VALUE_def, EVERY_MEM, 9573 DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def] THEN 9574 RES_TAC THEN 9575 FULL_SIMP_TAC std_ss [] 9576 ) THEN 9577 SIMP_TAC std_ss [SF_SEM___sf_tree_def, SF_SEM_def] THEN 9578 METIS_TAC[SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM, DS_EXPRESSION_EQUAL_def] 9579 ] 9580 ] 9581]); 9582 9583 9584 9585 9586 9587 9588 9589 9590 9591val INFERENCE_NON_EMPTY_LS = store_thm ("INFERENCE_NON_EMPTY_LS", 9592``!e1 e2 e3 f a c1 c2 pfL sfL pfL' sfL'. 9593 (MEM (f, e2) a) ==> 9594 9595 ((LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e3)::pfL, (sf_points_to e1 a)::sfL) (pfL', (sf_points_to e1 a)::(sf_ls f e2 e3)::sfL')) = 9596 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e3)::pfL, (sf_points_to e1 a)::sfL) (pfL', (sf_ls f e1 e3)::sfL'))``, 9597 9598 9599SIMP_TAC std_ss [sf_ls_def] THEN 9600REPEAT STRIP_TAC THEN 9601MP_TAC ( 9602 Q.SPECL [`e1`, `e3`, `c1`, `c2`, `[e2]`, `[f]`, `a`, `pfL`, `sfL`, `pfL'`, `sfL'`] INFERENCE_NON_EMPTY_TREE 9603) THEN 9604ASM_SIMP_TAC list_ss [prove (``n < 1 = (n = 0)``, DECIDE_TAC)]); 9605 9606 9607 9608 9609val INFERENCE_NON_EMPTY_BIN_TREE = store_thm ("INFERENCE_NON_EMPTY_BIN_TREE", 9610``!e e1 e2 f1 f2 a c1 c2 pfL sfL pfL' sfL'. 9611 ((MEM (f1, e1) a) /\ (MEM (f2, e2) a) /\ ~(f1 = f2)) ==> 9612 ((LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e a)::sfL) (pfL', (sf_points_to e a)::(sf_bin_tree (f1,f2) e1)::(sf_bin_tree (f1,f2) e2)::sfL')) = 9613 (LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to e a)::sfL) (pfL', (sf_bin_tree (f1,f2) e)::sfL')))``, 9614 9615 9616SIMP_TAC std_ss [sf_bin_tree_def] THEN 9617REPEAT STRIP_TAC THEN 9618MP_TAC ( 9619 Q.SPECL [`e`, `dse_nil`, `c1`, `c2`, `[e1;e2]`, `[f1;f2]`, `a`, `pfL`, `sfL`, `pfL'`, `sfL'`] INFERENCE_NON_EMPTY_TREE 9620) THEN 9621ASM_SIMP_TAC list_ss [prove (``n < 2 = ((n = 0) \/ (n = 1))``, DECIDE_TAC), 9622 DISJ_IMP_THM] THEN 9623SIMP_TAC std_ss [INFERENCE_NIL_NOT_LVAL___points_to]); 9624 9625 9626 9627 9628val INFERENCE_UNROLL_COLLAPSE_LS___IMPL___EMPTY = prove ( 9629``!e1:('b, 'a) ds_expression e2 f pfL sfL pfL' sfL'. 9630 (INFINITE (UNIV:'b set) /\ 9631 (LIST_DS_ENTAILS ([], []) ((pf_equal e1 e2)::pfL, sfL) (pfL', sfL') /\ 9632 (!x. LIST_DS_ENTAILS ([], []) ((pf_unequal e1 e2)::(pf_unequal (dse_const x) e2)::pfL, 9633 (sf_points_to e1 [(f, dse_const x)])::(sf_points_to (dse_const x) [(f, e2)])::sfL) (pfL', sfL')))) ==> 9634 9635 LIST_DS_ENTAILS ([], []) (pfL, (sf_ls f e1 e2)::sfL) (pfL', sfL')``, 9636 9637 9638 SIMP_TAC std_ss [LIST_DS_ENTAILS_def, HEAP_DISTINCT___IND_DEF] THEN 9639 REPEAT STRIP_TAC THEN 9640 Cases_on `DS_EXPRESSION_EQUAL s e1 e2` THEN1 ( 9641 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL] 9642 ) THEN 9643 9644 Q.PAT_X_ASSUM `LIST_DS_SEM s h X` MP_TAC THEN 9645 SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_SF_SEM_THM] THEN 9646 SIMP_TAC std_ss [LIST_PF_SEM_def, LIST_SF_SEM_def] THEN 9647 Q.ABBREV_TAC `pf = (FOLDR pf_and pf_true pfL)` THEN 9648 Q.ABBREV_TAC `pf' = (FOLDR pf_and pf_true pfL')` THEN 9649 Q.ABBREV_TAC `sf = (FOLDR sf_star sf_emp sfL)` THEN 9650 Q.ABBREV_TAC `sf' = (FOLDR sf_star sf_emp sfL')` THEN 9651 STRIP_TAC THEN 9652 MP_TAC (Q.SPECL [`s`, `h2`, `[f]`, `e1`, `e2`, `pf`, `sf`, `pf'`, `sf'`] LEMMA_5) THEN 9653 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 9654 CONJ_TAC THEN1 ( 9655 ASM_SIMP_TAC list_ss [ALL_DISTINCT] THEN 9656 `~(DS_POINTER_DANGLES s h1 e1)` by ( 9657 Q.PAT_X_ASSUM `SF_SEM s h1 Y` MP_TAC THEN 9658 ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_THM, LET_THM] THEN 9659 SIMP_TAC std_ss [SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, DS_POINTER_DANGLES] 9660 ) THEN 9661 REPEAT CONJ_TAC THENL [ 9662 SIMP_TAC std_ss [BALANCED_SF_SEM___sf_ls_len] THEN 9663 REWRITE_TAC [prove (``2 = SUC (SUC 0)``, DECIDE_TAC), SF_SEM___sf_ls_len_def] THEN 9664 SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EVAL_def, LET_THM, NOT_IS_DSV_NIL_THM, IN_DELETE, 9665 FDOM_DOMSUB] THEN 9666 REPEAT STRIP_TAC THEN 9667 Q.PAT_X_ASSUM `~(GET_DSV_VALUE X = GET_DSV_VALUE Y)` ASSUME_TAC THEN 9668 Q.PAT_X_ASSUM `Y = dsv_const c'` ASSUME_TAC THEN 9669 Q.PAT_X_ASSUM `Y = dsv_const c` ASSUME_TAC THEN 9670 FULL_SIMP_TAC std_ss [GET_DSV_VALUE_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 9671 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM] THEN 9672 9673 `LIST_DS_SEM s h' (pfL', sfL')` suffices_by (STRIP_TAC THEN 9674 POP_ASSUM MP_TAC THEN 9675 ASM_SIMP_TAC std_ss [DS_SEM_def, LIST_DS_SEM_def, LIST_PF_SEM_def, LIST_SF_SEM_def] 9676 ) THEN 9677 Q.PAT_X_ASSUM `!x s h. P x s h` MATCH_MP_TAC THEN 9678 Q.EXISTS_TAC `dsv_const c'` THEN 9679 9680 ASM_SIMP_TAC list_ss [LIST_DS_SEM_THM, PF_SEM_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 9681 GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, 9682 SF_SEM_def, DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def, 9683 DS_POINTS_TO_def, IS_DSV_NIL_def] THEN 9684 Q.EXISTS_TAC `DRESTRICT h1' {c}` THEN 9685 Q.EXISTS_TAC `DRESTRICT h1' {c'}` THEN 9686 Q.EXISTS_TAC `h2'` THEN 9687 FULL_SIMP_TAC std_ss [DRESTRICT_DEF, IN_INTER, IN_SING, EXTENSION, DISJOINT_DEF, NOT_IN_EMPTY, 9688 FUNION_DEF, IN_UNION] THEN 9689 REPEAT STRIP_TAC THENL [ 9690 REWRITE_TAC[FUNION___ASSOC] THEN 9691 AP_THM_TAC THEN AP_TERM_TAC THEN 9692 Q.PAT_X_ASSUM `h1' \\ c \\ c' = FEMPTY` MP_TAC THEN 9693 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, FUNION_DEF, 9694 DRESTRICT_DEF, IN_UNION, IN_INTER, IN_SING, FDOM_DOMSUB, IN_DELETE, 9695 FDOM_DOMSUB, FDOM_FEMPTY, NOT_IN_EMPTY, DOMSUB_FAPPLY_THM, GET_DSV_VALUE_def] THEN 9696 METIS_TAC[], 9697 9698 METIS_TAC[], 9699 ASM_SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_SF_SEM_def, LIST_PF_SEM_def], 9700 METIS_TAC[], 9701 METIS_TAC[] 9702 ], 9703 9704 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DS_EXPRESSION_EQUAL_def, dse_nil_def, 9705 DS_EXPRESSION_EVAL_def, IS_DSV_NIL_THM], 9706 9707 9708 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 9709 METIS_TAC[] 9710 ] 9711 ) THEN 9712 9713 ASM_SIMP_TAC std_ss [GSYM sf_ls_def, SF_SEM___EXTEND_def] THEN 9714 METIS_TAC[DISJOINT_SYM, FUNION___COMM] 9715); 9716 9717 9718 9719 9720val INFERENCE_UNROLL_COLLAPSE_LS = store_thm ("INFERENCE_UNROLL_COLLAPSE_LS", 9721``!e1:('b, 'a) ds_expression e2 c1 c2 f pfL sfL pfL' sfL'. 9722 INFINITE (UNIV:'b set) ==> 9723 9724 (( 9725 (LIST_DS_ENTAILS (c1,c2) ((pf_equal e1 e2)::pfL, sfL) (pfL', sfL') /\ 9726 (!x. LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e2)::(pf_unequal (dse_const x) e2)::pfL, 9727 (sf_points_to e1 [(f, dse_const x)])::(sf_points_to (dse_const x) [(f, e2)])::sfL) (pfL', sfL')))) = 9728 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', sfL'))``, 9729 9730 9731REPEAT STRIP_TAC THEN 9732EQ_TAC THENL [ 9733 REPEAT STRIP_TAC THEN 9734 ASSUME_TAC (Q.ISPECL [`c1:('b, 'a) ds_expression list`, `c2:(('b, 'a) ds_expression # ('b, 'a) ds_expression) list`] LIST_DS_ENTAILS___ELIM_PRECONDITION_COMPLETE) THEN 9735 FULL_SIMP_TAC std_ss [] THEN 9736 FULL_SIMP_TAC list_ss [] THEN 9737 MATCH_MP_TAC INFERENCE_UNROLL_COLLAPSE_LS___IMPL___EMPTY THEN 9738 ASM_SIMP_TAC std_ss [], 9739 9740 9741 REPEAT STRIP_TAC THENL [ 9742 FULL_SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9743 REPEAT STRIP_TAC THEN 9744 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9745 FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL], 9746 9747 FULL_SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9748 REPEAT STRIP_TAC THEN 9749 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9750 FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL, LET_THM, DS_POINTS_TO_def, 9751 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, FDOM_DOMSUB, IN_DELETE] THEN 9752 Q.PAT_X_ASSUM `~(GET_DSV_VALUE x = GET_DSV_VALUE Y)` ASSUME_TAC THEN 9753 `?c c'. (x = dsv_const c) /\ (DS_EXPRESSION_EVAL s e1 = dsv_const c')` by ( 9754 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 9755 ) THEN 9756 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def, FDOM_DOMSUB, 9757 IN_DELETE, IS_DSV_NIL_def, LIST_DS_SEM_THM, DOMSUB_FAPPLY_THM, DS_EXPRESSION_EQUAL_def, 9758 DS_EXPRESSION_EVAL_def] THEN 9759 Q.PAT_X_ASSUM `dsv_const c = Y` (ASSUME_TAC o GSYM) THEN 9760 9761 Q.EXISTS_TAC `DRESTRICT h {c}` THEN 9762 Q.EXISTS_TAC `h \\ c' \\ c` THEN 9763 FULL_SIMP_TAC std_ss [SF_SEM___sf_ls_THM, DS_EXPRESSION_EQUAL_def, 9764 DS_EXPRESSION_EVAL_def, DOMSUB_FAPPLY_THM, DS_EXPRESSION_EQUAL_def, LET_THM] THEN 9765 SIMP_TAC std_ss [SF_SEM___sf_points_to_THM] THEN 9766 SIMP_TAC std_ss [SF_SEM___sf_ls_THM] THEN 9767 ASM_SIMP_TAC list_ss [DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def, 9768 DS_EXPRESSION_EVAL_VALUE_def, DRESTRICT_DEF, IN_INTER, IN_SING, GET_DSV_VALUE_def, 9769 DS_POINTS_TO_def, IS_DSV_NIL_def] THEN 9770 9771 ASM_SIMP_TAC std_ss [GSYM fmap_EQ_THM, EXTENSION, IN_UNION, FUNION_DEF, DRESTRICT_DEF, 9772 IN_INTER, IN_SING, FDOM_DOMSUB, DOMSUB_FAPPLY_THM, IN_DELETE, FDOM_FEMPTY, 9773 NOT_IN_EMPTY, DISJOINT_DEF] THEN 9774 METIS_TAC[] 9775 ] 9776]); 9777 9778 9779 9780val INFERENCE_UNROLL_COLLAPSE_BIN_TREE___IMPL___EMPTY = prove ( 9781``!e:('b, 'a) ds_expression f1 f2 pfL sfL pfL' sfL'. 9782 (INFINITE (UNIV:'b set) /\ (~(f1 = f2)) /\ 9783 (LIST_DS_ENTAILS ([],[]) ((pf_equal e dse_nil)::pfL, sfL) (pfL', sfL') /\ 9784 (!x1 x2. LIST_DS_ENTAILS ([],[]) ((pf_unequal e dse_nil)::(pf_unequal (dse_const x1) dse_nil)::(pf_unequal (dse_const x2) dse_nil)::pfL, 9785 (sf_points_to e [(f1, dse_const x1);(f2, dse_const x2)])::(sf_points_to (dse_const x1) [(f1, dse_nil);(f2, dse_nil)])::(sf_points_to (dse_const x2) [(f1, dse_nil);(f2, dse_nil)])::sfL) (pfL', sfL')))) ==> 9786 9787 LIST_DS_ENTAILS ([],[]) (pfL, (sf_bin_tree (f1,f2) e)::sfL) (pfL', sfL')``, 9788 9789 9790 SIMP_TAC std_ss [LIST_DS_ENTAILS_def, HEAP_DISTINCT___IND_DEF] THEN 9791 REPEAT STRIP_TAC THEN 9792 Cases_on `DS_EXPRESSION_EQUAL s e dse_nil` THEN1 ( 9793 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL] 9794 ) THEN 9795 9796 Q.PAT_X_ASSUM `LIST_DS_SEM s h X` MP_TAC THEN 9797 SIMP_TAC std_ss [LIST_DS_SEM_def, LIST_SF_SEM_THM] THEN 9798 SIMP_TAC std_ss [LIST_PF_SEM_def, LIST_SF_SEM_def] THEN 9799 Q.ABBREV_TAC `pf = (FOLDR pf_and pf_true pfL)` THEN 9800 Q.ABBREV_TAC `pf' = (FOLDR pf_and pf_true pfL')` THEN 9801 Q.ABBREV_TAC `sf = (FOLDR sf_star sf_emp sfL)` THEN 9802 Q.ABBREV_TAC `sf' = (FOLDR sf_star sf_emp sfL')` THEN 9803 STRIP_TAC THEN 9804 MP_TAC (Q.SPECL [`s`, `h2`, `[f1;f2]`, `e`, `dse_nil`, `pf`, `sf`, `pf'`, `sf'`] LEMMA_5) THEN 9805 MATCH_MP_TAC (prove (``(a /\ (b ==> c)) ==> ((a ==> b) ==> c)``, METIS_TAC[])) THEN 9806 CONJ_TAC THEN1 ( 9807 ASM_SIMP_TAC list_ss [ALL_DISTINCT] THEN 9808 `~(DS_POINTER_DANGLES s h1 e)` by ( 9809 Q.PAT_X_ASSUM `SF_SEM s h1 Y` MP_TAC THEN 9810 ASM_SIMP_TAC std_ss [SF_SEM___sf_bin_tree_THM, LET_THM] THEN 9811 SIMP_TAC std_ss [SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, DS_POINTER_DANGLES] 9812 ) THEN 9813 REPEAT CONJ_TAC THENL [ 9814 REWRITE_TAC [prove (``2 = SUC (SUC 0)``, DECIDE_TAC), BALANCED_SF_SEM___sf_tree_len___EXTENDED_DEF] THEN 9815 SIMP_TAC list_ss [PF_SEM_def, DS_EXPRESSION_EVAL_def, LET_THM, NOT_IS_DSV_NIL_THM, IN_DELETE, 9816 FDOM_DOMSUB, GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, DISJ_IMP_THM, 9817 FORALL_AND_THM, GSYM LEFT_FORALL_IMP_THM] THEN 9818 REPEAT GEN_TAC THEN 9819 Tactical.REVERSE (Cases_on `?hl1 hl2. hL = [hl1; hl2]`) THEN1 ( 9820 Cases_on `hL` THEN FULL_SIMP_TAC list_ss [] THEN 9821 Cases_on `t` THEN FULL_SIMP_TAC list_ss [LENGTH_NIL] 9822 ) THEN 9823 FULL_SIMP_TAC std_ss [] THEN 9824 Cases_on `DS_EXPRESSION_EVAL s e = dsv_const c` THEN ASM_REWRITE_TAC[] THEN 9825 FULL_SIMP_TAC list_ss [prove (``(n < 2 = ((n = 0) \/ (n = 1)))``, DECIDE_TAC), 9826 DISJ_IMP_THM, FORALL_AND_THM, GET_DSV_VALUE_def, HEAP_READ_ENTRY_THM 9827 ] THEN 9828 REPEAT STRIP_TAC THEN 9829 `LIST_DS_SEM s (FUNION h1' h2') (pfL', sfL')` suffices_by (STRIP_TAC THEN 9830 POP_ASSUM MP_TAC THEN 9831 ASM_SIMP_TAC std_ss [DS_SEM_def, LIST_DS_SEM_def, LIST_PF_SEM_def, LIST_SF_SEM_def] 9832 ) THEN 9833 Q.PAT_X_ASSUM `!x1 x2 s h. P x1 x2 s h` MATCH_MP_TAC THEN 9834 Q.EXISTS_TAC `dsv_const c'` THEN 9835 Q.EXISTS_TAC `dsv_const c''` THEN 9836 9837 Q.PAT_X_ASSUM `Y = dsv_const c'` ASSUME_TAC THEN 9838 Q.PAT_X_ASSUM `Y = dsv_const c''` ASSUME_TAC THEN 9839 FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL, PF_SEM_def, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, 9840 dse_nil_def, ds_value_distinct, DS_POINTS_TO_def, GET_DSV_VALUE_def, 9841 FUNION_DEF, IS_DSV_NIL_def, IN_UNION, FDOM_DOMSUB, IN_DELETE, ALL_DISJOINT_def, 9842 DS_POINTER_DANGLES] THEN 9843 `(c' IN FDOM h1') /\ (c'' IN FDOM h1')` by METIS_TAC[SUBMAP_DEF] THEN 9844 `~(c' = c'')` by ( 9845 FULL_SIMP_TAC std_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 9846 METIS_TAC[] 9847 ) THEN 9848 `~(c' = c)` by ( 9849 `c' IN FDOM (FUNION hl1 (FUNION hl2 FEMPTY))` by ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] THEN 9850 POP_ASSUM MP_TAC THEN 9851 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 9852 ) THEN 9853 `~(c'' = c)` by ( 9854 `c'' IN FDOM (FUNION hl1 (FUNION hl2 FEMPTY))` by ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] THEN 9855 POP_ASSUM MP_TAC THEN 9856 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 9857 ) THEN 9858 `(h1' ' c' = hl1 ' c') /\ (h1' ' c'' = hl2 ' c'')` by METIS_TAC[SUBMAP_DEF] THEN 9859 9860 `?hl1' hl2'. hL' = [hl1'; hl2']` by ( 9861 Q.PAT_X_ASSUM `LENGTH hL' = 2` MP_TAC THEN 9862 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9863 Cases_on `hL'` THEN SIMP_TAC list_ss [] THEN 9864 Cases_on `t` THEN SIMP_TAC list_ss [LENGTH_NIL] 9865 ) THEN 9866 `?hl1'' hl2''. hL'' = [hl1''; hl2'']` by ( 9867 Q.PAT_X_ASSUM `LENGTH hL'' = 2` MP_TAC THEN 9868 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9869 Cases_on `hL''` THEN SIMP_TAC list_ss [] THEN 9870 Cases_on `t` THEN SIMP_TAC list_ss [LENGTH_NIL] 9871 ) THEN 9872 FULL_SIMP_TAC list_ss [DOMSUB_FAPPLY_THM, FUNION_DEF, prove (``(n < 2 = ((n = 0) \/ (n = 1)))``, DECIDE_TAC), DISJ_IMP_THM, FORALL_AND_THM] THEN 9873 REPEAT (Q.PAT_X_ASSUM `FUNION FEMPTY Z = Y` (ASSUME_TAC o GSYM)) THEN 9874 FULL_SIMP_TAC std_ss [FUNION_FEMPTY_1, GET_DSV_VALUE_def, ds_value_11] THEN 9875 REPEAT (Q.PAT_X_ASSUM `FEMPTY = Y` (ASSUME_TAC o GSYM)) THEN 9876 FULL_SIMP_TAC std_ss [ LIST_DS_SEM_def, LIST_SF_SEM_def, LIST_PF_SEM_def, 9877 FUNION_FEMPTY_2] THEN 9878 9879 `(FUNION h1' h2' \\ c \\ c' \\ c'') = h2'` suffices_by (STRIP_TAC THEN 9880 METIS_TAC[] 9881 ) THEN 9882 ASM_SIMP_TAC std_ss [DOMSUB_FUNION] THEN 9883 `((h1' \\ c \\ c' \\ c'') = FEMPTY) /\ ((h2' \\ c \\ c' \\ c'') = h2')` suffices_by (STRIP_TAC THEN 9884 ASM_SIMP_TAC std_ss [] THEN 9885 METIS_TAC[FUNION_FEMPTY_1] 9886 ) THEN 9887 SIMP_TAC std_ss [GSYM FDOM_F_FEMPTY1] THEN 9888 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, IN_DELETE, EXTENSION, IN_DELETE, 9889 DOMSUB_FAPPLY_THM] THEN 9890 FULL_SIMP_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY, FUNION_FEMPTY_2, 9891 ds_value_11] THEN 9892 Tactical.REVERSE CONJ_TAC THEN1 METIS_TAC[] THEN 9893 GEN_TAC THEN 9894 Cases_on `a IN FDOM h1'` THEN ASM_SIMP_TAC std_ss [] THEN 9895 Cases_on `a = c` THEN ASM_SIMP_TAC std_ss [] THEN 9896 `a IN FDOM (FUNION hl1 hl2)` by ( 9897 ASM_SIMP_TAC std_ss [FDOM_DOMSUB, IN_DELETE] 9898 ) THEN 9899 POP_ASSUM MP_TAC THEN 9900 9901 `FDOM hl1 = {c'}` by ( 9902 Q.PAT_X_ASSUM `c' IN (FDOM hl1)` MP_TAC THEN 9903 Q.PAT_X_ASSUM `hl1 \\ c' = FEMPTY` MP_TAC THEN 9904 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9905 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, EXTENSION, NOT_IN_EMPTY, 9906 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM, IN_SING] THEN 9907 METIS_TAC[] 9908 ) THEN 9909 `FDOM hl2 = {c''}` by ( 9910 Q.PAT_X_ASSUM `c'' IN (FDOM hl2)` MP_TAC THEN 9911 Q.PAT_X_ASSUM `hl2 \\ c'' = FEMPTY` MP_TAC THEN 9912 REPEAT (POP_ASSUM (K ALL_TAC)) THEN 9913 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_FEMPTY, EXTENSION, NOT_IN_EMPTY, 9914 FDOM_DOMSUB, IN_DELETE, DOMSUB_FAPPLY_THM, IN_SING] THEN 9915 METIS_TAC[] 9916 ) THEN 9917 Q.PAT_X_ASSUM `FUNION hl1 hl2 = Y` (K ALL_TAC) THEN 9918 ASM_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION, IN_SING], 9919 9920 9921 FULL_SIMP_TAC std_ss [DS_POINTER_DANGLES, DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER] THEN 9922 METIS_TAC[] 9923 ] 9924 ) THEN 9925 9926 ASM_SIMP_TAC std_ss [GSYM sf_bin_tree_def, SF_SEM___EXTEND_def] THEN 9927 METIS_TAC[DISJOINT_SYM, FUNION___COMM] 9928); 9929 9930 9931 9932 9933val INFERENCE_UNROLL_COLLAPSE_BIN_TREE = store_thm ("INFERENCE_UNROLL_COLLAPSE_BIN_TREE", 9934``!e:('b, 'a) ds_expression f1 f2 c1 c2 pfL sfL pfL' sfL'. 9935 (INFINITE (UNIV:'b set) /\ (~(f1 = f2))) ==> 9936 9937 9938 ((LIST_DS_ENTAILS (c1,c2) ((pf_equal e dse_nil)::pfL, sfL) (pfL', sfL') /\ 9939 (!x1 x2. LIST_DS_ENTAILS (c1,c2) ((pf_unequal e dse_nil)::(pf_unequal (dse_const x1) dse_nil)::(pf_unequal (dse_const x2) dse_nil)::pfL, 9940 (sf_points_to e [(f1, dse_const x1);(f2, dse_const x2)])::(sf_points_to (dse_const x1) [(f1, dse_nil);(f2, dse_nil)])::(sf_points_to (dse_const x2) [(f1, dse_nil);(f2, dse_nil)])::sfL) (pfL', sfL'))) = 9941 9942 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_bin_tree (f1,f2) e)::sfL) (pfL', sfL'))``, 9943 9944 9945REPEAT STRIP_TAC THEN 9946EQ_TAC THENL [ 9947 REPEAT STRIP_TAC THEN 9948 ASSUME_TAC (Q.ISPECL [`c1:('b, 'a) ds_expression list`, `c2:(('b, 'a) ds_expression # ('b, 'a) ds_expression) list`] LIST_DS_ENTAILS___ELIM_PRECONDITION_COMPLETE) THEN 9949 FULL_SIMP_TAC std_ss [] THEN 9950 FULL_SIMP_TAC list_ss [] THEN 9951 MATCH_MP_TAC INFERENCE_UNROLL_COLLAPSE_BIN_TREE___IMPL___EMPTY THEN 9952 ASM_SIMP_TAC std_ss [], 9953 9954 9955 REPEAT STRIP_TAC THENL [ 9956 FULL_SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9957 REPEAT STRIP_TAC THEN 9958 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9959 FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL], 9960 9961 FULL_SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 9962 REPEAT STRIP_TAC THEN 9963 Q.PAT_X_ASSUM `!s h. P s h` MATCH_MP_TAC THEN 9964 FULL_SIMP_TAC list_ss [LIST_DS_SEM_EVAL, LET_THM, DS_POINTS_TO_def, 9965 DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, FDOM_DOMSUB, IN_DELETE] THEN 9966 Q.PAT_X_ASSUM `~(GET_DSV_VALUE x = GET_DSV_VALUE Y)` ASSUME_TAC THEN 9967 `?c c' c''. (DS_EXPRESSION_EVAL s e = dsv_const c) /\ 9968 (x1 = dsv_const c') /\ 9969 (x2 = dsv_const c'')` by ( 9970 FULL_SIMP_TAC std_ss [NOT_IS_DSV_NIL_THM, ds_value_11] 9971 ) THEN 9972 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, GET_DSV_VALUE_def, FDOM_DOMSUB, 9973 IN_DELETE, IS_DSV_NIL_def, LIST_DS_SEM_THM, DOMSUB_FAPPLY_THM, DS_EXPRESSION_EQUAL_def, 9974 DS_EXPRESSION_EVAL_def] THEN 9975 Q.PAT_X_ASSUM `~(c'' = c)` ASSUME_TAC THEN 9976 Q.PAT_X_ASSUM `~(c' = c)` ASSUME_TAC THEN 9977 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_def, dse_nil_def] THEN 9978 Q.PAT_X_ASSUM `dsv_nil = Y` (ASSUME_TAC o GSYM) THEN 9979 FULL_SIMP_TAC std_ss [] THEN 9980 Q.PAT_X_ASSUM `dsv_nil = Y` (ASSUME_TAC o GSYM) THEN 9981 Q.PAT_X_ASSUM `dsv_const z = Y` (ASSUME_TAC o GSYM) THEN 9982 Q.PAT_X_ASSUM `dsv_const z = Y` (ASSUME_TAC o GSYM) THEN 9983 FULL_SIMP_TAC std_ss [GSYM LEFT_EXISTS_AND_THM, GSYM RIGHT_EXISTS_AND_THM, FDOM_FUNION, 9984 DISJOINT_UNION_BOTH] THEN 9985 9986 Q.EXISTS_TAC `DRESTRICT h {c'}` THEN 9987 Q.EXISTS_TAC `DRESTRICT h {c''}` THEN 9988 Q.EXISTS_TAC `h \\ c \\ c' \\ c''` THEN 9989 ASM_SIMP_TAC list_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, FDOM_DOMSUB, IN_DELETE, 9990 IN_INTER, DRESTRICT_DEF, IN_SING, SF_SEM___sf_bin_tree_THM, 9991 DS_EXPRESSION_EVAL_VALUE_def, DS_EXPRESSION_EVAL_def, GET_DSV_VALUE_def, 9992 DS_EXPRESSION_EQUAL_def, dse_nil_def, SF_SEM___sf_points_to_THM, LET_THM, 9993 DS_POINTS_TO_def, IS_DSV_NIL_def] THEN 9994 `(DRESTRICT h {c'} \\ c' = FEMPTY) /\ 9995 (DRESTRICT h {c''} \\ c'' = FEMPTY)` by ( 9996 SIMP_TAC std_ss [GSYM fmap_EQ_THM, DRESTRICT_DEF, FDOM_DOMSUB, EXTENSION, IN_DELETE, 9997 IN_INTER, IN_SING, FDOM_FEMPTY, NOT_IN_EMPTY] 9998 ) THEN 9999 ASM_SIMP_TAC std_ss [] THEN 10000 ASM_SIMP_TAC std_ss [SF_SEM___STAR_THM, FUNION_EQ_FEMPTY, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 10001 SIMP_TAC std_ss [SF_SEM___sf_bin_tree_THM, DS_EXPRESSION_EQUAL_def, DS_EXPRESSION_EVAL_def, dse_nil_def] THEN 10002 CONJ_TAC THENL [ 10003 SIMP_TAC std_ss [GSYM fmap_EQ_THM, FDOM_DOMSUB, EXTENSION, IN_DELETE, FUNION_DEF, 10004 DRESTRICT_DEF, IN_SING, IN_INTER, IN_UNION, DOMSUB_FAPPLY_THM] THEN 10005 METIS_TAC[], 10006 10007 METIS_TAC[] 10008 ] 10009 ] 10010]); 10011 10012 10013 10014 10015 10016(* own inference *) 10017val INFERENCE_INCONSISTENT___NIL_POINTS_TO = store_thm ("INFERENCE_INCONSISTENT___NIL_POINTS_TO", 10018``!a c1 c2 pfL sfL pfL' sfL'. 10019 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_points_to dse_nil a)::sfL) (pfL', sfL')``, 10020 10021REPEAT GEN_TAC THEN 10022ONCE_REWRITE_TAC [GSYM INFERENCE_NIL_NOT_LVAL___points_to] THEN 10023SIMP_TAC std_ss [INFERENCE_INCONSISTENT]) 10024 10025 10026val INFERENCE_INCONSISTENT___precondition_POINTS_TO = store_thm ("INFERENCE_INCONSISTENT___precondition_POINTS_TO", 10027``!e a c1 c2 pfL sfL pfL' sfL'. 10028 MEM e c1 ==> 10029 (LIST_DS_ENTAILS (c1, c2) (pfL, (sf_points_to e a)::sfL) (pfL', sfL'))``, 10030 10031SIMP_TAC std_ss [LIST_DS_ENTAILS_def, HEAP_DISTINCT_def] THEN 10032REPEAT STRIP_TAC THEN 10033RES_TAC THEN 10034FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, DS_POINTS_TO_def]); 10035 10036 10037val INFERENCE_INCONSISTENT___precondition_BIN_TREE = store_thm ("INFERENCE_INCONSISTENT___precondition_BIN_TREE", 10038``!e f1 f2 c1 c2 pfL sfL pfL' sfL'. 10039 MEM e c1 ==> 10040 (LIST_DS_ENTAILS (c1,c2) (pfL, (sf_bin_tree (f1, f2) e)::sfL) (pfL', sfL'))``, 10041 10042SIMP_TAC std_ss [LIST_DS_ENTAILS_def, HEAP_DISTINCT_def] THEN 10043REPEAT STRIP_TAC THEN 10044RES_TAC THEN 10045FULL_SIMP_TAC std_ss [LIST_DS_SEM_THM, sf_bin_tree_def, SF_SEM___sf_tree_THM] THEN 10046Cases_on `DS_EXPRESSION_EQUAL s e dse_nil` THENL [ 10047 FULL_SIMP_TAC std_ss [FUNION_FEMPTY_1, DS_EXPRESSION_EQUAL_def, dse_nil_def, 10048 DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def], 10049 10050 FULL_SIMP_TAC list_ss [LET_THM, SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, 10051 DS_EXPRESSION_EVAL_def] THEN 10052 Q.PAT_X_ASSUM `h = FUNION h1 h2` ASSUME_TAC THEN 10053 FULL_SIMP_TAC std_ss [FUNION_DEF, IN_UNION] 10054]) 10055 10056 10057 10058val INFERENCE___NIL_LIST = store_thm ("INFERENCE___NIL_LIST", 10059``!c1 c2 e f pfL sfL pfL' sfL'. 10060 LIST_DS_ENTAILS (c1,c2) ((pf_equal e dse_nil)::pfL, sfL) (pfL', sfL') = 10061 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f dse_nil e)::sfL) (pfL', sfL')``, 10062 10063SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL] THEN 10064REPEAT GEN_TAC THEN 10065HO_MATCH_MP_TAC (prove (``(!s h. (P s h = Q s h)) ==> ((!s h. P s h) = (!s h. Q s h))``, METIS_TAC[])) THEN 10066REPEAT GEN_TAC THEN 10067Cases_on `DS_EXPRESSION_EQUAL s e dse_nil` THENL [ 10068 `DS_EXPRESSION_EQUAL s dse_nil e` by METIS_TAC[DS_EXPRESSION_EQUAL_def] THEN 10069 ASM_SIMP_TAC std_ss [LIST_DS_SEM_EVAL], 10070 10071 `~(DS_EXPRESSION_EQUAL s dse_nil e)` by METIS_TAC[DS_EXPRESSION_EQUAL_def] THEN 10072 ASM_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, DS_POINTS_TO_def, dse_nil_def, 10073 DS_EXPRESSION_EVAL_def, IS_DSV_NIL_def, LET_THM] 10074]) 10075 10076 10077 10078val INFERENCE___precondition_LIST = store_thm ("INFERENCE___precondition_LIST", 10079``!c1 c2 e' e f pfL sfL pfL' sfL'. 10080 MEM e' c1 ==> 10081 10082 (LIST_DS_ENTAILS (c1, c2) ((pf_equal e e')::pfL, sfL) (pfL', sfL') = 10083 LIST_DS_ENTAILS (c1, c2) (pfL, (sf_ls f e' e)::sfL) (pfL', sfL'))``, 10084 10085SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL] THEN 10086REPEAT STRIP_TAC THEN 10087REPEAT STRIP_EQ_FORALL_TAC THEN 10088STRIP_EQ_BOOL_TAC THEN 10089SIMP_TAC list_ss [LIST_DS_SEM_THM, SF_SEM___sf_ls_THM] THEN 10090STRIP_EQ_BOOL_TAC THEN 10091Cases_on `DS_EXPRESSION_EQUAL s e e'` THEN1 ( 10092 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] 10093) THEN 10094FULL_SIMP_TAC list_ss [LET_THM, DS_EXPRESSION_EQUAL_def, SF_SEM___sf_points_to_THM, DS_POINTS_TO_def, 10095 DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EVAL_VALUE_def, HEAP_DISTINCT_def] THEN 10096RES_TAC THEN 10097REPEAT GEN_TAC THEN 10098Cases_on `h = FUNION h1 h2` THEN ASM_REWRITE_TAC[] THEN 10099FULL_SIMP_TAC std_ss [FDOM_FUNION, IN_UNION] 10100); 10101 10102 10103val INFERENCE___precondition_STRENGTHEN = store_thm ("INFERENCE___precondition_STRENGTHEN", 10104``!c1 c2 e1 e2 pfL sfL pfL' sfL'. 10105 (LIST_DS_ENTAILS (e1::c1, c2) ((pf_unequal e1 e2)::pfL, sfL) (pfL', sfL') = 10106 LIST_DS_ENTAILS (c1, ((e1,e2)::c2)) ((pf_unequal e1 e2)::pfL, sfL) (pfL', sfL'))``, 10107 10108SIMP_TAC std_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL] THEN 10109METIS_TAC[HEAP_DISTINCT___UNEQUAL]) 10110 10111 10112 10113 10114 10115val INFERENCE_UNROLL_COLLAPSE_LS___NON_EMPTY = store_thm ("INFERENCE_UNROLL_COLLAPSE_LS___NON_EMPTY", 10116``!e1:('b, 'a) ds_expression e2 f c1 c2 pfL sfL pfL' sfL'. 10117 (INFINITE (UNIV:'b set)) ==> 10118 10119 ((!x. LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e2)::(pf_unequal (dse_const x) e2)::pfL, 10120 (sf_points_to e1 [(f, dse_const x)])::(sf_points_to (dse_const x) [(f, e2)])::sfL) (pfL', sfL')) = 10121 LIST_DS_ENTAILS (c1,c2) ((pf_unequal e1 e2)::pfL, (sf_ls f e1 e2)::sfL) (pfL', sfL'))``, 10122 10123 10124REPEAT STRIP_TAC THEN 10125ASM_SIMP_TAC std_ss [Once (GSYM INFERENCE_UNROLL_COLLAPSE_LS)] THEN 10126SIMP_TAC list_ss [LIST_DS_ENTAILS_def, LIST_DS_SEM_EVAL] THEN 10127METIS_TAC[]) 10128 10129 10130 10131 10132val INFERENCE_LIST_APPEND___helper = prove (`` 10133!e1 e2 e3 e1' x f s h pfL' sfL'. 10134((e1' = DS_EXPRESSION_EVAL_VALUE s e1) /\ 10135~(DS_EXPRESSION_EQUAL s (dse_const x) e2) /\ 10136~(DS_EXPRESSION_EQUAL s (dse_const x) e3) /\ 10137DS_POINTS_TO s h e1 [(f, dse_const x)] /\ 10138DS_POINTS_TO s (h \\ e1') (dse_const x) [(f, e2)]) ==> 10139 10140(LIST_DS_SEM s (h \\ e1') 10141(pfL', sf_ls f (dse_const (h ' e1' ' f)) e2::sf_ls f e2 e3::sfL') = 10142LIST_DS_SEM s (h \\ e1') (pfL', 10143 sf_ls f (dse_const (h ' e1' ' f)) e3::sfL'))``, 10144 10145 10146REPEAT STRIP_TAC THEN 10147`(h ' (GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) ' f) = x` by ( 10148 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10149 DS_EXPRESSION_EVAL_def] 10150) THEN 10151FULL_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def, LIST_DS_SEM_EVAL, LET_THM, 10152 DS_EXPRESSION_EVAL_def] THEN 10153STRIP_EQ_BOOL_TAC THEN 10154`DS_EXPRESSION_EQUAL s (dse_const 10155((h \\ GET_DSV_VALUE (DS_EXPRESSION_EVAL s e1)) ' 10156(GET_DSV_VALUE x) ' f)) e2` by ( 10157 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10158 DS_EXPRESSION_EVAL_def, DS_EXPRESSION_EQUAL_def] 10159) THEN 10160ASM_SIMP_TAC std_ss [LIST_DS_SEM_EVAL] THEN 10161SIMP_TAC std_ss [LIST_DS_SEM_THM] THEN 10162REPEAT STRIP_EQ_EXISTS_TAC THEN 10163STRIP_EQ_BOOL_TAC THEN 10164SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_def, SF_SEM_def] THEN 10165STRIP_EQ_EXISTS_TAC THEN 10166MATCH_MP_TAC SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM THEN 10167FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def]) 10168 10169 10170 10171 10172 10173 10174val INFERENCE_APPEND_LIST___nil = store_thm ("INFERENCE_APPEND_LIST___nil", 10175``!e1:('b, 'a) ds_expression e2 f c1 c2 pfL sfL pfL' sfL'. 10176 (INFINITE (UNIV:'b set)) ==> 10177 10178 ((LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', (sf_ls f e1 e2)::(sf_ls f e2 dse_nil)::sfL')) = 10179 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', (sf_ls f e1 dse_nil)::sfL'))``, 10180 10181 10182REPEAT STRIP_TAC THEN 10183ASM_SIMP_TAC std_ss [GSYM INFERENCE_UNROLL_COLLAPSE_LS] THEN 10184BINOP_TAC THENL [ 10185 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10186 REPEAT STRIP_EQ_FORALL_TAC THEN 10187 STRIP_EQ_BOOL_TAC THEN 10188 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, PF_SEM_def] THEN 10189 SIMP_TAC std_ss [LIST_DS_SEM_THM] THEN 10190 REPEAT STRIP_EQ_EXISTS_TAC THEN 10191 STRIP_EQ_BOOL_TAC THEN 10192 SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_def, SF_SEM_def] THEN 10193 STRIP_EQ_EXISTS_TAC THEN 10194 MATCH_MP_TAC SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM THEN 10195 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def], 10196 10197 10198 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10199 REPEAT STRIP_EQ_FORALL_TAC THEN 10200 STRIP_EQ_BOOL_TAC THEN 10201 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10202 `~(DS_EXPRESSION_EQUAL s e1 dse_nil)` by ( 10203 FULL_SIMP_TAC std_ss [DS_POINTS_TO_def, DS_EXPRESSION_EQUAL_def, 10204 DS_EXPRESSION_EVAL_def, NOT_IS_DSV_NIL_THM, dse_nil_def, ds_value_distinct] 10205 ) THEN 10206 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10207 `(h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f) = x` by ( 10208 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10209 DS_EXPRESSION_EVAL_def] 10210 ) THEN 10211 ASM_SIMP_TAC std_ss [] THEN 10212 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10213 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 10214 10215 MATCH_MP_TAC (SIMP_RULE std_ss [DS_EXPRESSION_EVAL_VALUE_def] INFERENCE_LIST_APPEND___helper) THEN 10216 Q.EXISTS_TAC `x` THEN 10217 ASM_SIMP_TAC std_ss [] THEN 10218 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def, NOT_IS_DSV_NIL_THM, DS_POINTS_TO_def, 10219 dse_nil_def, DS_EXPRESSION_EVAL_def, ds_value_distinct] 10220]) 10221 10222 10223 10224 10225val INFERENCE_APPEND_LIST___precond = store_thm ("INFERENCE_APPEND_LIST___precond", 10226``!e1:('b, 'a) ds_expression e2 e3 f c1 c2 pfL sfL pfL' sfL'. 10227 (INFINITE (UNIV:'b set) /\ 10228 MEM_UNEQ_PF_LIST e1 e3 pfL) ==> 10229 10230 ((LIST_DS_ENTAILS (e3::c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', (sf_ls f e1 e2)::(sf_ls f e2 e3)::sfL')) = 10231 LIST_DS_ENTAILS (e3::c1,c2) (pfL, (sf_ls f e1 e2)::sfL) (pfL', (sf_ls f e1 e3)::sfL'))``, 10232 10233 10234REPEAT STRIP_TAC THEN 10235ASM_SIMP_TAC std_ss [GSYM INFERENCE_UNROLL_COLLAPSE_LS] THEN 10236BINOP_TAC THENL [ 10237 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10238 REPEAT STRIP_EQ_FORALL_TAC THEN 10239 STRIP_EQ_BOOL_TAC THEN 10240 FULL_SIMP_TAC std_ss [LIST_DS_SEM_THM, PF_SEM_def] THEN 10241 `!h1. SF_SEM s h1 (sf_ls f e1 e2) = (h1 = FEMPTY)` by ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_THM] THEN 10242 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 10243 REPEAT STRIP_EQ_EXISTS_TAC THEN 10244 STRIP_EQ_BOOL_TAC THEN 10245 SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_def, SF_SEM_def] THEN 10246 STRIP_EQ_EXISTS_TAC THEN 10247 MATCH_MP_TAC SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM THEN 10248 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def], 10249 10250 10251 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10252 REPEAT STRIP_EQ_FORALL_TAC THEN 10253 STRIP_EQ_BOOL_TAC THEN 10254 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10255 `~(DS_EXPRESSION_EQUAL s e1 e3)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 10256 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10257 `(h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f) = x` by ( 10258 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10259 DS_EXPRESSION_EVAL_def] 10260 ) THEN 10261 ASM_SIMP_TAC std_ss [] THEN 10262 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10263 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 10264 10265 MATCH_MP_TAC (SIMP_RULE std_ss [DS_EXPRESSION_EVAL_VALUE_def] INFERENCE_LIST_APPEND___helper) THEN 10266 Q.EXISTS_TAC `x` THEN 10267 ASM_SIMP_TAC std_ss [] THEN 10268 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10269 FULL_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, 10270 dse_nil_def, DS_EXPRESSION_EVAL_def, ds_value_distinct, DS_EXPRESSION_EVAL_VALUE_def, HEAP_DISTINCT___IND_DEF, FDOM_DOMSUB, IN_DELETE] THEN 10271 METIS_TAC[] 10272]); 10273 10274 10275 10276 10277val INFERENCE_APPEND_LIST___points_to = store_thm ("INFERENCE_APPEND_LIST___points_to", 10278``!e1:('b, 'a) ds_expression e2 e3 a f c1 c2 pfL sfL pfL' sfL'. 10279 (INFINITE (UNIV:'b set) /\ 10280 MEM_UNEQ_PF_LIST e1 e3 pfL) ==> 10281 10282 ((LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::(sf_points_to e3 a)::sfL) (pfL', (sf_ls f e1 e2)::(sf_ls f e2 e3)::sfL')) = 10283 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::(sf_points_to e3 a)::sfL) (pfL', (sf_ls f e1 e3)::sfL'))``, 10284 10285 10286REPEAT STRIP_TAC THEN 10287ASM_SIMP_TAC std_ss [GSYM INFERENCE_UNROLL_COLLAPSE_LS] THEN 10288BINOP_TAC THENL [ 10289 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10290 REPEAT STRIP_EQ_FORALL_TAC THEN 10291 STRIP_EQ_BOOL_TAC THEN 10292 FULL_SIMP_TAC std_ss [LIST_DS_SEM_THM, PF_SEM_def] THEN 10293 `!h1. SF_SEM s h1 (sf_ls f e1 e2) = (h1 = FEMPTY)` by ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_THM] THEN 10294 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 10295 REPEAT STRIP_EQ_EXISTS_TAC THEN 10296 STRIP_EQ_BOOL_TAC THEN 10297 SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_def, SF_SEM_def] THEN 10298 STRIP_EQ_EXISTS_TAC THEN 10299 MATCH_MP_TAC SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM THEN 10300 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def], 10301 10302 10303 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10304 REPEAT STRIP_EQ_FORALL_TAC THEN 10305 STRIP_EQ_BOOL_TAC THEN 10306 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10307 `~(DS_EXPRESSION_EQUAL s e1 e3)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 10308 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10309 `(h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f) = x` by ( 10310 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10311 DS_EXPRESSION_EVAL_def] 10312 ) THEN 10313 ASM_SIMP_TAC std_ss [] THEN 10314 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10315 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 10316 10317 MATCH_MP_TAC (SIMP_RULE std_ss [DS_EXPRESSION_EVAL_VALUE_def] INFERENCE_LIST_APPEND___helper) THEN 10318 Q.EXISTS_TAC `x` THEN 10319 ASM_SIMP_TAC std_ss [] THEN 10320 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10321 FULL_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, 10322 dse_nil_def, DS_EXPRESSION_EVAL_def, ds_value_distinct, DS_EXPRESSION_EVAL_VALUE_def, HEAP_DISTINCT___IND_DEF, FDOM_DOMSUB, IN_DELETE] THEN 10323 METIS_TAC[] 10324]) 10325 10326 10327 10328val INFERENCE_APPEND_LIST___tree = store_thm ("INFERENCE_APPEND_LIST___tree", 10329``!e1:('b, 'a) ds_expression e2 e3 fL es f c1 c2 pfL sfL pfL' sfL'. 10330 (INFINITE (UNIV:'b set) /\ 10331 MEM_UNEQ_PF_LIST e1 e3 pfL /\ 10332 MEM_UNEQ_PF_LIST e3 es pfL) ==> 10333 10334 ((LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::(sf_tree fL es e3)::sfL) (pfL', (sf_ls f e1 e2)::(sf_ls f e2 e3)::sfL')) = 10335 LIST_DS_ENTAILS (c1,c2) (pfL, (sf_ls f e1 e2)::(sf_tree fL es e3)::sfL) (pfL', (sf_ls f e1 e3)::sfL'))``, 10336 10337 10338REPEAT STRIP_TAC THEN 10339ASM_SIMP_TAC std_ss [GSYM INFERENCE_UNROLL_COLLAPSE_LS] THEN 10340BINOP_TAC THENL [ 10341 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10342 REPEAT STRIP_EQ_FORALL_TAC THEN 10343 STRIP_EQ_BOOL_TAC THEN 10344 FULL_SIMP_TAC std_ss [LIST_DS_SEM_THM, PF_SEM_def] THEN 10345 `!h1. SF_SEM s h1 (sf_ls f e1 e2) = (h1 = FEMPTY)` by ASM_SIMP_TAC std_ss [SF_SEM___sf_ls_THM] THEN 10346 ASM_SIMP_TAC std_ss [FUNION_FEMPTY_1, FDOM_FEMPTY, DISJOINT_EMPTY] THEN 10347 REPEAT STRIP_EQ_EXISTS_TAC THEN 10348 STRIP_EQ_BOOL_TAC THEN 10349 SIMP_TAC list_ss [sf_ls_def, SF_SEM___sf_tree_def, SF_SEM_def] THEN 10350 STRIP_EQ_EXISTS_TAC THEN 10351 MATCH_MP_TAC SF_SEM___sf_tree_len___DS_EXPRESSION_EQUAL_THM THEN 10352 FULL_SIMP_TAC std_ss [DS_EXPRESSION_EQUAL_def], 10353 10354 10355 SIMP_TAC std_ss [LIST_DS_ENTAILS_def] THEN 10356 REPEAT STRIP_EQ_FORALL_TAC THEN 10357 STRIP_EQ_BOOL_TAC THEN 10358 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10359 `~(DS_EXPRESSION_EQUAL s e1 e3)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 10360 `~(DS_EXPRESSION_EQUAL s e3 es)` by METIS_TAC[MEM_UNEQ_PF_LIST_SEM, LIST_DS_SEM_def] THEN 10361 FULL_SIMP_TAC std_ss [LIST_DS_SEM_EVAL, LET_THM] THEN 10362 `(h ' (DS_EXPRESSION_EVAL_VALUE s e1) ' f) = x` by ( 10363 FULL_SIMP_TAC list_ss [DS_POINTS_TO_def, DS_EXPRESSION_EVAL_VALUE_def, 10364 DS_EXPRESSION_EVAL_def] 10365 ) THEN 10366 ASM_SIMP_TAC std_ss [] THEN 10367 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10368 ASM_SIMP_TAC std_ss [DS_EXPRESSION_EVAL_VALUE_def] THEN 10369 10370 MATCH_MP_TAC (SIMP_RULE std_ss [DS_EXPRESSION_EVAL_VALUE_def] INFERENCE_LIST_APPEND___helper) THEN 10371 Q.EXISTS_TAC `x` THEN 10372 ASM_SIMP_TAC std_ss [] THEN 10373 POP_ASSUM (ASSUME_TAC o GSYM) THEN 10374 Q.PAT_X_ASSUM `LIST_DS_SEM s H L` MP_TAC THEN 10375 FULL_SIMP_TAC list_ss [DS_EXPRESSION_EQUAL_def, DS_POINTS_TO_def, 10376 dse_nil_def, DS_EXPRESSION_EVAL_def, ds_value_distinct, DS_EXPRESSION_EVAL_VALUE_def, FDOM_DOMSUB, IN_DELETE, LIST_DS_SEM_THM, SF_SEM___sf_tree_THM, LET_THM, SF_SEM___sf_points_to_THM] THEN 10377 REPEAT STRIP_TAC THEN 10378 METIS_TAC[] 10379]) 10380 10381val _ = export_theory(); 10382