1(* ========================================================================= *) 2(* FILE : wordsScript.sml *) 3(* DESCRIPTION : A model of binary words. Based on John Harrison's *) 4(* treatment of finite Cartesian products (TPHOLs 2005) *) 5(* AUTHOR : (c) Anthony Fox, University of Cambridge *) 6(* ========================================================================= *) 7 8open HolKernel Parse boolLib bossLib; 9open arithmeticTheory pred_setTheory 10open bitTheory sum_numTheory fcpTheory fcpLib 11open numposrepTheory ASCIInumbersTheory 12 13val () = new_theory "words" 14val _ = set_grammar_ancestry ["ASCIInumbers", "numeral_bit", "fcp", "sum_num"] 15 16val ERR = mk_HOL_ERR "wordsScript" 17 18val fcp_ss = std_ss ++ fcpLib.FCP_ss 19 20val WL = ``dimindex (:'a)`` 21val HB = ``^WL - 1`` 22 23val dimword_def = zDefine `dimword (:'a) = 2 ** ^WL` 24val INT_MIN_def = zDefine `INT_MIN (:'a) = 2 ** ^HB` 25val UINT_MAX_def = Define `UINT_MAX (:'a) = dimword(:'a) - 1` 26val INT_MAX_def = Define `INT_MAX (:'a) = INT_MIN(:'a) - 1` 27 28val dimword_ML = rhs (#2 (strip_forall (concl dimword_def))) 29val INT_MIN_ML = rhs (#2 (strip_forall (concl INT_MIN_def))) 30 31val _ = type_abbrev ("word", ``:bool['a]``) 32 33fun add_infixes n assoc = 34 List.app (fn (s, t) => ( Parse.add_infix (s, n, assoc) 35 ; Parse.overload_on (s, Parse.Term t) 36 )) 37 38fun add_TeX_tokens n = 39 List.app 40 (fn (s, m) => 41 TexTokenMap.TeX_notation {hol = s, TeX = ("\\HOLToken" ^ m ^ "{}", n)}) 42 43(* ------------------------------------------------------------------------- 44 Domain transforming maps : definitions 45 ------------------------------------------------------------------------- *) 46 47val w2n_def = zDefine` 48 w2n (w:'a word) = SUM ^WL (\i. SBIT (w ' i) i)` 49 50val n2w_def = zDefine` 51 (n2w:num->'a word) n = FCP i. BIT i n` 52 53val w2w_def = zDefine` 54 (w2w:'a word -> 'b word) w = n2w (w2n w)` 55 56val sw2sw_def = zDefine` 57 (sw2sw:'a word -> 'b word) w = 58 n2w (SIGN_EXTEND (dimindex(:'a)) (dimindex(:'b)) (w2n w))` 59 60val _ = add_bare_numeral_form (#"w", SOME "n2w") 61 62val w2l_def = Define `w2l b w = n2l b (w2n w)` 63val l2w_def = Define `l2w b l = n2w (l2n b l)` 64val w2s_def = Define `w2s b f w = n2s b f (w2n w)` 65val s2w_def = Define `s2w b f s = n2w (s2n b f s)` 66 67val word_from_bin_list_def = Define `word_from_bin_list = l2w 2` 68val word_from_oct_list_def = Define `word_from_oct_list = l2w 8` 69val word_from_dec_list_def = Define `word_from_dec_list = l2w 10` 70val word_from_hex_list_def = Define `word_from_hex_list = l2w 16` 71 72val word_to_bin_list_def = Define `word_to_bin_list = w2l 2` 73val word_to_oct_list_def = Define `word_to_oct_list = w2l 8` 74val word_to_dec_list_def = Define `word_to_dec_list = w2l 10` 75val word_to_hex_list_def = Define `word_to_hex_list = w2l 16` 76 77val word_from_bin_string_def = Define `word_from_bin_string = s2w 2 UNHEX` 78val word_from_oct_string_def = Define `word_from_oct_string = s2w 8 UNHEX` 79val word_from_dec_string_def = Define `word_from_dec_string = s2w 10 UNHEX` 80val word_from_hex_string_def = Define `word_from_hex_string = s2w 16 UNHEX` 81 82val word_to_bin_string_def = Define `word_to_bin_string = w2s 2 HEX` 83val word_to_oct_string_def = Define `word_to_oct_string = w2s 8 HEX` 84val word_to_dec_string_def = Define `word_to_dec_string = w2s 10 HEX` 85val word_to_hex_string_def = Define `word_to_hex_string = w2s 16 HEX` 86 87(* ------------------------------------------------------------------------- 88 The Boolean operations : definitions 89 ------------------------------------------------------------------------- *) 90 91val word_T_def = Define` 92 word_T = (n2w:num->'a word) (UINT_MAX(:'a))` 93 94val word_L_def = Define` 95 word_L = (n2w:num->'a word) (INT_MIN(:'a))` 96 97val word_H_def = Define` 98 word_H = (n2w:num->'a word) (INT_MAX(:'a))` 99 100val word_1comp_def = zDefine` 101 word_1comp (w:'a word) = (FCP i. ~(w ' i)):'a word` 102 103val word_and_def = zDefine` 104 word_and (v:'a word) (w:'a word) = 105 (FCP i. (v ' i) /\ (w ' i)):'a word` 106 107val word_or_def = zDefine` 108 word_or (v:'a word) (w:'a word) = 109 (FCP i. (v ' i) \/ (w ' i)):'a word` 110 111val word_xor_def = zDefine` 112 word_xor (v:'a word) (w:'a word) = 113 (FCP i. ~((v ' i) = (w ' i))):'a word` 114 115val word_nand_def = zDefine` 116 word_nand (v:'a word) (w:'a word) = 117 (FCP i. ~((v ' i) /\ (w ' i))):'a word` 118 119val word_nor_def = zDefine` 120 word_nor (v:'a word) (w:'a word) = 121 (FCP i. ~((v ' i) \/ (w ' i))):'a word` 122 123val word_xnor_def = zDefine` 124 word_xnor (v:'a word) (w:'a word) = 125 (FCP i. (v ' i) = (w ' i)):'a word` 126 127 128val () = add_infixes 400 HOLgrammars.RIGHT 129 [("&&", `words$word_and`), 130 ("~&&", `words$word_nand`)] 131 132val () = add_infixes 375 HOLgrammars.RIGHT 133 [("??", `words$word_xor`), 134 ("~??", `words$word_xnor`)] 135 136val () = add_infixes 300 HOLgrammars.RIGHT 137 [("!!", `words$word_or`), 138 ("||", `words$word_or`), 139 ("~||", `words$word_nor`)] 140 141val _ = overload_on ("~", ``words$word_1comp``) 142val _ = send_to_back_overload "~" {Name = "word_1comp", Thy = "words"} 143 144val _ = overload_on ("UINT_MAXw", ``words$word_T``) 145val _ = overload_on ("INT_MAXw", ``words$word_H``) 146val _ = overload_on ("INT_MINw", ``words$word_L``) 147 148val _ = Unicode.unicode_version {u = Unicode.UChar.xor, tmnm = "??"} 149val _ = Unicode.unicode_version {u = Unicode.UChar.or, tmnm = "||"} 150 151val () = add_TeX_tokens 1 152 [("!!", "Or"), ("||", "Or"), (Unicode.UChar.or, "Or"), 153 ("??", "Eor"), (Unicode.UChar.xor, "Eor")] 154 155(* ------------------------------------------------------------------------- 156 Reduction operations : definitions 157 ------------------------------------------------------------------------- *) 158 159val word_reduce_def = zDefine` 160 word_reduce f (w : 'a word) = 161 $FCP (K 162 (let l = GENLIST (\i. w ' (dimindex(:'a) - 1 - i)) (dimindex(:'a)) in 163 FOLDL f (HD l) (TL l))) : 1 word` 164 165(* equals 1w iff all bits are equal *) 166val word_compare_def = Define` 167 word_compare (a:'a word) b = if a = b then 1w else 0w :1 word` 168 169val reduce_and_def = zDefine `reduce_and = word_reduce (/\)` 170val reduce_or_def = zDefine `reduce_or = word_reduce (\/)` 171val reduce_xor_def = Define `reduce_xor = word_reduce (<>)` 172val reduce_nand_def = Define `reduce_nand = word_reduce (\a b. ~(a /\ b))` 173val reduce_nor_def = Define `reduce_nor = word_reduce (\a b. ~(a \/ b))` 174val reduce_xnor_def = Define `reduce_xnor = word_reduce (=)` 175 176(* ------------------------------------------------------------------------- 177 Bit field operations : definitions 178 ------------------------------------------------------------------------- *) 179 180val word_lsb_def = zDefine` 181 word_lsb (w:'a word) = w ' 0` 182 183val word_msb_def = zDefine` 184 word_msb (w:'a word) = w ' ^HB` 185 186val word_slice_def = zDefine` 187 word_slice h l = \w:'a word. 188 (FCP i. l <= i /\ i <= MIN h ^HB /\ w ' i):'a word` 189 190val word_bits_def = zDefine` 191 word_bits h l = \w:'a word. 192 (FCP i. i + l <= MIN h ^HB /\ w ' (i + l)):'a word` 193 194val word_signed_bits_def = zDefine` 195 word_signed_bits h l = \w:'a word. 196 (FCP i. l <= MIN h ^HB /\ w ' (MIN (i + l) (MIN h ^HB))):'a word` 197 198val word_extract_def = zDefine` 199 word_extract h l = w2w o word_bits h l` 200 201val word_bit_def = zDefine` 202 word_bit b (w:'a word) = b <= ^HB /\ w ' b` 203 204val word_reverse_def = zDefine` 205 word_reverse (w:'a word) = (FCP i. w ' (^HB - i)):'a word` 206 207val word_modify_def = zDefine` 208 word_modify f (w:'a word) = (FCP i. f i (w ' i)):'a word` 209 210val BIT_SET_def = zDefine` 211 BIT_SET i n = 212 if n = 0 then 213 {} 214 else 215 if ODD n then 216 i INSERT (BIT_SET (SUC i) (n DIV 2)) 217 else 218 BIT_SET (SUC i) (n DIV 2)` 219 220val bit_field_insert_def = Define` 221 bit_field_insert h l a = 222 word_modify (\i. COND (l <= i /\ i <= h) (a ' (i - l)))` 223 224val word_sign_extend_def = Define` 225 word_sign_extend n (w:'a word) = 226 n2w (SIGN_EXTEND n (dimindex(:'a)) (w2n w)) : 'a word` 227 228val word_len_def = Define `word_len (w:'a word) = dimindex (:'a)` 229 230val bit_count_upto_def = Define` 231 bit_count_upto n (w : 'a word) = SUM n (\i. if w ' i then 1 else 0)` 232 233val bit_count_def = Define` 234 bit_count (w : 'a word) = bit_count_upto (dimindex(:'a)) w` 235 236val () = add_infixes 375 HOLgrammars.RIGHT 237 [("''", `$word_slice`), 238 ("--", `$word_bits`), 239 ("><", `$word_extract`), 240 ("---", `$word_signed_bits`)] 241 242val _ = TeX_notation {hol = "><", TeX = ("\\HOLTokenExtract{}", 2)} 243 244(* ------------------------------------------------------------------------- 245 Word arithmetic: definitions 246 ------------------------------------------------------------------------- *) 247 248val word_2comp_def = zDefine` 249 word_2comp (w:'a word) = (n2w:num->'a word) (dimword(:'a) - w2n w)` 250 251val word_add_def = zDefine` 252 word_add (v:'a word) (w:'a word) = (n2w:num->'a word) (w2n v + w2n w)` 253 254val word_mul_def = zDefine` 255 word_mul (v:'a word) (w:'a word) = (n2w:num->'a word) (w2n v * w2n w)` 256 257val word_log2_def = zDefine` 258 word_log2 (w:'a word) = (n2w (LOG2 (w2n w)):'a word)` 259 260val add_with_carry_def = Define` 261 add_with_carry (x:'a word, y:'a word, carry_in:bool) = 262 let unsigned_sum = w2n x + w2n y + (if carry_in then 1 else 0) in 263 let result = n2w unsigned_sum : 'a word in 264 let carry_out = ~(w2n result = unsigned_sum) 265 and overflow = (word_msb x = word_msb y) /\ (word_msb x <> word_msb result) 266 in 267 (result,carry_out,overflow)` 268 269val word_sub_def = Define` 270 word_sub (v:'a word) (w:'a word) = word_add v (word_2comp w)` 271 272val word_div_def = Define` 273 word_div (v: 'a word) (w: 'a word) = n2w (w2n v DIV w2n w): 'a word` 274 275val word_mod_def = Define` 276 word_mod (v: 'a word) (w: 'a word) = n2w (w2n v MOD w2n w): 'a word` 277 278val word_quot_def = Define` 279 word_quot a b = 280 if word_msb a then 281 if word_msb b then 282 word_div (word_2comp a) (word_2comp b) 283 else 284 word_2comp (word_div (word_2comp a) b) 285 else 286 if word_msb b then 287 word_2comp (word_div a (word_2comp b)) 288 else 289 word_div a b` 290 291(* 2's complement signed remainder (sign follows dividend) *) 292val word_rem_def = Define` 293 word_rem a b = 294 if word_msb a then 295 if word_msb b then 296 word_2comp (word_mod (word_2comp a) (word_2comp b)) 297 else 298 word_2comp (word_mod (word_2comp a) b) 299 else 300 if word_msb b then 301 word_mod a (word_2comp b) 302 else 303 word_mod a b` 304 305val word_L2_def = Define `word_L2 = word_mul word_L word_L` 306 307val () = List.app (fn (s, t) => Parse.overload_on (s, Parse.Term t)) 308 [("+", `$word_add`), 309 ("-", `$word_sub`), 310 ("numeric_negate", `$word_2comp`), 311 ("*", `$word_mul`), 312 ("CARRY_OUT", `\a b c. FST (SND (add_with_carry (a,b,c)))`), 313 ("OVERFLOW", `\a b c. SND (SND (add_with_carry (a,b,c)))`)] 314 315val () = add_infixes 600 HOLgrammars.LEFT 316 [("//", `$word_div`), 317 ("/", `$word_quot`)] 318 319(* ------------------------------------------------------------------------- 320 Orderings : definitions 321 ------------------------------------------------------------------------- *) 322 323val nzcv_def = Define ` 324 nzcv (a:'a word) (b:'a word) = 325 let q = w2n a + w2n (- b) in 326 let r = (n2w q):'a word in 327 (word_msb r,r = 0w,BIT ^WL q \/ (b = 0w), 328 ~(word_msb a = word_msb b) /\ ~(word_msb r = word_msb a))` 329 330val word_lt_def = zDefine` 331 word_lt a b = let (n,z,c,v) = nzcv a b in ~(n = v)` 332 333val word_gt_def = zDefine` 334 word_gt a b = let (n,z,c,v) = nzcv a b in ~z /\ (n = v)` 335 336val word_le_def = zDefine` 337 word_le a b = let (n,z,c,v) = nzcv a b in z \/ ~(n = v)` 338 339val word_ge_def = zDefine` 340 word_ge a b = let (n,z,c,v) = nzcv a b in n = v` 341 342val word_ls_def = zDefine` 343 word_ls a b = let (n,z,c,v) = nzcv a b in ~c \/ z` 344 345val word_hi_def = zDefine` 346 word_hi a b = let (n,z,c,v) = nzcv a b in c /\ ~z` 347 348val word_lo_def = zDefine` 349 word_lo a b = let (n,z,c,v) = nzcv a b in ~c` 350 351val word_hs_def = zDefine` 352 word_hs a b = let (n,z,c,v) = nzcv a b in c` 353 354val word_min_def = Define` 355 word_min a b = if word_lo a b then a else b` 356 357val word_max_def = Define` 358 word_max a b = if word_lo a b then b else a` 359 360val word_smin_def = Define` 361 word_smin a b = if word_lt a b then a else b` 362 363val word_smax_def = Define` 364 word_smax a b = if word_lt a b then b else a` 365 366val word_abs_def = Define` 367 word_abs w = if word_lt w (n2w 0) then word_2comp w else w` 368 369val () = add_infixes 450 HOLgrammars.NONASSOC 370 [("<", `word_lt`), 371 (">", `word_gt`), 372 ("<=", `word_le`), 373 (">=", `word_ge`), 374 ("<=+", `word_ls`), 375 (">+", `word_hi`), 376 ("<+", `word_lo`), 377 (">=+", `word_hs`)] 378 379val _ = Unicode.unicode_version {u = Unicode.UChar.ls, tmnm = "<=+"} 380val _ = Unicode.unicode_version {u = Unicode.UChar.hi, tmnm = ">+"} 381val _ = Unicode.unicode_version {u = Unicode.UChar.lo, tmnm = "<+"} 382val _ = Unicode.unicode_version {u = Unicode.UChar.hs, tmnm = ">=+"} 383 384val () = add_TeX_tokens 1 385 [("<+", "Lo"), (Unicode.UChar.lo, "Lo"), 386 (">+", "Hi"), (Unicode.UChar.hi, "Hi"), 387 ("<=+", "Ls"), (Unicode.UChar.ls, "Ls"), 388 (">=+", "Hs"), (Unicode.UChar.hs, "Hs")] 389 390(* ------------------------------------------------------------------------- 391 Shifts : definitions 392 ------------------------------------------------------------------------- *) 393 394val word_lsl_def = zDefine` 395 word_lsl (w:'a word) n = 396 (FCP i. i < ^WL /\ n <= i /\ w ' (i - n)):'a word` 397 398val word_lsr_def = zDefine` 399 word_lsr (w:'a word) n = 400 (FCP i. i + n < ^WL /\ w ' (i + n)):'a word` 401 402val word_asr_def = zDefine` 403 word_asr (w:'a word) n = 404 (FCP i. if ^WL <= i + n then 405 word_msb w 406 else 407 w ' (i + n)):'a word` 408 409val word_ror_def = zDefine` 410 word_ror (w:'a word) n = 411 (FCP i. w ' ((i + n) MOD ^WL)):'a word` 412 413val word_rol_def = zDefine` 414 word_rol (w:'a word) n = 415 word_ror w (^WL - n MOD ^WL)` 416 417val word_rrx_def = zDefine` 418 word_rrx(c, w:'a word) = 419 (word_lsb w, 420 (FCP i. if i = ^HB then c else (word_lsr w 1) ' i):'a word)` 421 422val word_lsl_bv_def = Define` 423 word_lsl_bv (w:'a word) (n:'a word) = word_lsl w (w2n n)` 424 425val word_lsr_bv_def = Define` 426 word_lsr_bv (w:'a word) (n:'a word) = word_lsr w (w2n n)` 427 428val word_asr_bv_def = Define` 429 word_asr_bv (w:'a word) (n:'a word) = word_asr w (w2n n)` 430 431val word_ror_bv_def = Define` 432 word_ror_bv (w:'a word) (n:'a word) = word_ror w (w2n n)` 433 434val word_rol_bv_def = Define` 435 word_rol_bv (w:'a word) (n:'a word) = word_rol w (w2n n)` 436 437val () = add_infixes 680 HOLgrammars.LEFT 438 [("<<", `words$word_lsl`), 439 (">>", `words$word_asr`), 440 (">>>", `words$word_lsr`), 441 ("#>>", `words$word_ror`), 442 ("#<<", `words$word_rol`), 443 ("<<~", `words$word_lsl_bv`), 444 (">>~", `words$word_asr_bv`), 445 (">>>~", `words$word_lsr_bv`), 446 ("#>>~", `words$word_ror_bv`), 447 ("#<<~", `words$word_rol_bv`)] 448 449val _ = Unicode.unicode_version {u = Unicode.UChar.lsl, tmnm = "<<"} 450val _ = Unicode.unicode_version {u = Unicode.UChar.asr, tmnm = ">>"} 451val _ = Unicode.unicode_version {u = Unicode.UChar.lsr, tmnm = ">>>"} 452val _ = Unicode.unicode_version {u = Unicode.UChar.ror, tmnm = "#>>"} 453val _ = Unicode.unicode_version {u = Unicode.UChar.rol, tmnm = "#<<"} 454 455val () = add_TeX_tokens 1 456 [("#<<", "Rol"), (Unicode.UChar.rol, "Rol"), 457 ("#>>", "Ror"), (Unicode.UChar.ror, "Ror")] 458 459val () = add_TeX_tokens 2 460 [("<<", "Lsl"), (Unicode.UChar.lsl, "Lsl"), 461 (">>", "Asr"), (Unicode.UChar.asr, "Asr")] 462 463val () = add_TeX_tokens 3 464 [(">>>", "Lsr"), (Unicode.UChar.lsr, "Lsr")] 465 466(* ------------------------------------------------------------------------- 467 Concatenation : definitions 468 ------------------------------------------------------------------------- *) 469 470val word_join_def = Define` 471 (word_join (v:'a word) (w:'b word)):('a + 'b) word = 472 let cv = (w2w v):('a + 'b) word 473 and cw = (w2w w):('a + 'b) word 474 in (cv << (dimindex (:'b))) || cw` 475 476val word_concat_def = zDefine` 477 word_concat (v:'a word) (w:'b word) = w2w (word_join v w)` 478 479val word_replicate_def = zDefine` 480 word_replicate n (w : 'a word) = 481 FCP i. i < n * dimindex(:'a) /\ w ' (i MOD dimindex(:'a))` 482 483val concat_word_list_def = Define` 484 (concat_word_list ([]:'a word list) = 0w) /\ 485 (concat_word_list (h::t) = w2w h || (concat_word_list t << dimindex(:'a)))` 486 487val () = add_infixes 700 HOLgrammars.RIGHT [("@@", `$word_concat`)] 488 489(* ------------------------------------------------------------------------- 490 Saturating maps/operations : definitions 491 ------------------------------------------------------------------------- *) 492 493val saturate_n2w_def = Define` 494 (saturate_n2w: num -> 'a word) n = 495 if dimword(:'a) <= n then word_T else n2w n` 496 497val saturate_w2w_def = zDefine` 498 saturate_w2w (w: 'a word) = saturate_n2w (w2n w)` 499 500val saturate_add_def = Define` 501 saturate_add (a: 'a word) (b: 'a word) = 502 saturate_n2w (w2n a + w2n b) : 'a word` 503 504val saturate_sub_def = Define` 505 saturate_sub (a: 'a word) (b: 'a word) = 506 n2w (w2n a - w2n b) : 'a word` 507 508val saturate_mul_def = Define` 509 saturate_mul (a: 'a word) (b: 'a word) = 510 saturate_n2w (w2n a * w2n b) : 'a word` 511 512(* ------------------------------------------------------------------------- 513 Theorems 514 ------------------------------------------------------------------------- *) 515 516val ZERO_LT_dimword = Q.store_thm("ZERO_LT_dimword[simp]", 517 `0 < dimword(:'a)`, 518 SRW_TAC [][dimword_def]) 519 520val DIMINDEX_GT_0 = save_thm("DIMINDEX_GT_0[simp]", 521 PROVE [DECIDE ``!s. 1 <= s ==> 0 < s``,DIMINDEX_GE_1] ``0 < dimindex(:'a)``) 522 523val dimword_IS_TWICE_INT_MIN = Q.store_thm("dimword_IS_TWICE_INT_MIN", 524 `dimword(:'a) = 2 * INT_MIN(:'a)`, 525 simp [INT_MIN_def, GSYM (CONJUNCT2 arithmeticTheory.EXP), 526 DECIDE ``0n < a ==> (SUC (a - 1) = a)``, DIMINDEX_GT_0, dimword_def]) 527 528val dimword_sub_int_min = Q.store_thm("dimword_sub_int_min", 529 `dimword(:'a) - INT_MIN(:'a) = INT_MIN(:'a)`, 530 SRW_TAC [ARITH_ss] [dimword_IS_TWICE_INT_MIN]) 531 532val ONE_LT_dimword = Q.store_thm("ONE_LT_dimword[simp]", 533 `1 < dimword(:'a)`, 534 METIS_TAC [dimword_def,DIMINDEX_GT_0,EXP,EXP_BASE_LT_MONO,DECIDE ``1 < 2``]) 535 536val DIMINDEX_LT = 537 (GEN_ALL o CONJUNCT2 o SPEC_ALL o SIMP_RULE bool_ss [DIMINDEX_GT_0] o 538 Q.SPEC `^WL`) DIVISION 539 540val EXISTS_HB = save_thm("EXISTS_HB", 541 PROVE [DIMINDEX_GT_0,LESS_ADD_1,ADD1,ADD] ``?m. ^WL = SUC m``) 542 543val MOD_DIMINDEX = Q.store_thm("MOD_DIMINDEX", 544 `!n. n MOD dimword (:'a) = BITS (^WL - 1) 0 n`, 545 STRIP_ASSUME_TAC EXISTS_HB \\ ASM_SIMP_TAC arith_ss [dimword_def,BITS_ZERO3]) 546 547val BITS_ZEROL_DIMINDEX = Q.store_thm("BITS_ZEROL_DIMINDEX", 548 `!n. n < dimword (:'a) ==> (BITS (dimindex (:'a) - 1) 0 n = n)`, 549 SIMP_TAC arith_ss [GSYM MOD_DIMINDEX]) 550 551val SUB1_SUC = DECIDE (Term `!n. 0 < n ==> (SUC (n - 1) = n)`) 552val SUB_SUC1 = DECIDE (Term `!n. ~(n = 0) ==> (SUC (n - 1) = n)`) 553val SUC_SUB2 = DECIDE (Term `!n. ~(n = 0) ==> (SUC n - 2 = n - 1)`) 554 555val MOD_2EXP_DIMINDEX = save_thm("MOD_2EXP_DIMINDEX", 556 SIMP_RULE std_ss [SUB1_SUC,BITS_ZERO3,DIMINDEX_GT_0,GSYM MOD_2EXP_def] 557 MOD_DIMINDEX) 558 559val INT_MIN_SUM = Q.store_thm("INT_MIN_SUM", 560 `INT_MIN (:('a+'b)) = 561 if FINITE (UNIV:'a->bool) /\ FINITE (UNIV:'b->bool) then 562 dimword (:'a) * INT_MIN (:'b) 563 else 564 INT_MIN (:('a+'b))`, 565 SRW_TAC [ARITH_ss] [LESS_EQ_ADD_SUB,DIMINDEX_GE_1,EXP_ADD,INT_MIN_def, 566 dimword_def,index_sum]) 567 568val ZERO_LT_INT_MIN = Q.store_thm("ZERO_LT_INT_MIN[simp]", 569 `0n < INT_MIN (:'a)`, 570 SRW_TAC [] [INT_MIN_def]) 571 572val ZERO_LT_INT_MAX = Q.store_thm("ZERO_LT_INT_MAX", 573 `1 < dimindex(:'a) ==> 0n < INT_MAX (:'a)`, 574 SRW_TAC [] [INT_MAX_def, INT_MIN_def] 575 \\ `1n <= dimindex (:'a) - 1` by DECIDE_TAC 576 \\ IMP_RES_TAC bitTheory.TWOEXP_MONO2 577 \\ FULL_SIMP_TAC bool_ss [EVAL ``2n ** 1``] 578 \\ DECIDE_TAC 579) 580 581val ZERO_LE_INT_MAX = Q.store_thm("ZERO_LE_INT_MAX", 582 `0n <= INT_MAX (:'a)`, 583 SRW_TAC [] [INT_MAX_def, INT_MIN_def]) 584 585val ZERO_LT_UINT_MAX = Q.store_thm("ZERO_LT_UINT_MAX[simp]", 586 `0n < UINT_MAX (:'a)`, 587 SRW_TAC [] [UINT_MAX_def, ONE_LT_dimword, DECIDE ``1n < n ==> (0 < n - 1)``]) 588 589val INT_MIN_LT_DIMWORD = Q.store_thm("INT_MIN_LT_DIMWORD", 590 `INT_MIN (:'a) < dimword (:'a)`, 591 SRW_TAC [] [INT_MIN_def, DIMINDEX_GT_0, dimword_def]) 592 593val INT_MAX_LT_DIMWORD = Q.store_thm("INT_MAX_LT_DIMWORD", 594 `INT_MAX (:'a) < dimword (:'a)`, 595 SRW_TAC [ARITH_ss] [INT_MAX_def, INT_MIN_LT_DIMWORD] 596) 597 598val dimindex_lt_dimword = Q.store_thm("dimindex_lt_dimword", 599 `dimindex(:'a) < dimword(:'a)`, 600 SRW_TAC [] [dimword_def, arithmeticTheory.X_LT_EXP_X]) 601 602val BOUND_ORDER = Q.store_thm("BOUND_ORDER", 603 `INT_MAX (:'a) < INT_MIN (:'a) /\ 604 INT_MIN (:'a) <= UINT_MAX (:'a) /\ 605 UINT_MAX (:'a) < dimword (:'a)`, 606 SRW_TAC [ARITH_ss] 607 [UINT_MAX_def, INT_MAX_def, ZERO_LT_INT_MIN, INT_MIN_LT_DIMWORD, 608 DECIDE ``0n < b /\ a < b ==> a <= b - 1``]) 609 610val iso_lem = 611 DECIDE ``0n < a /\ 0n < b ==> 612 ((a = b) = (a - 1 = b - 1)) /\ 613 ((a < b) = (a - 1 < b - 1)) /\ 614 ((a <= b) = (a - 1 <= b - 1))`` 615 616val dimindex_dimword_iso = Q.store_thm("dimindex_dimword_iso", 617 `(dimindex (:'a) = dimindex (:'b)) = (dimword (:'a) = dimword (:'b))`, 618 SRW_TAC [] [fcpTheory.dimindex_def, dimword_def]) 619 620val dimindex_dimword_le_iso = Q.store_thm("dimindex_dimword_le_iso", 621 `dimindex (:'a) <= dimindex (:'b) = dimword (:'a) <= dimword (:'b)`, 622 SRW_TAC [] [logrootTheory.LE_EXP_ISO, fcpTheory.dimindex_def, dimword_def]) 623 624val dimindex_dimword_lt_iso = Q.store_thm("dimindex_dimword_lt_iso", 625 `dimindex (:'a) < dimindex (:'b) = dimword (:'a) < dimword (:'b)`, 626 SRW_TAC [] [logrootTheory.LT_EXP_ISO, fcpTheory.dimindex_def, dimword_def]) 627 628 629 630val dimindex_int_min_iso = Q.store_thm("dimindex_int_min_iso", 631 `(dimindex (:'a) = dimindex (:'b)) = (INT_MIN (:'a) = INT_MIN (:'b))`, 632 SRW_TAC [] [INT_MIN_def] \\ SIMP_TAC (srw_ss()) [iso_lem]) 633 634val dimindex_int_min_le_iso = Q.store_thm("dimindex_int_min_le_iso", 635 `(dimindex (:'a) <= dimindex (:'b)) = (INT_MIN (:'a) <= INT_MIN (:'b))`, 636 SRW_TAC [] [INT_MIN_def] \\ SIMP_TAC (srw_ss()) [iso_lem]) 637 638val dimindex_int_min_lt_iso = Q.store_thm("dimindex_int_min_lt_iso", 639 `(dimindex (:'a) < dimindex (:'b)) = (INT_MIN (:'a) < INT_MIN (:'b))`, 640 SRW_TAC [] [INT_MIN_def] \\ SIMP_TAC (srw_ss()) [iso_lem]) 641 642 643 644val dimindex_int_max_iso = Q.store_thm("dimindex_int_max_iso", 645 `(dimindex (:'a) = dimindex (:'b)) = (INT_MAX (:'a) = INT_MAX (:'b))`, 646 SRW_TAC [] [INT_MAX_def, dimindex_int_min_iso] 647 \\ SIMP_TAC (srw_ss()) [iso_lem]) 648 649val dimindex_int_max_le_iso = Q.store_thm("dimindex_int_max_le_iso", 650 `(dimindex (:'a) <= dimindex (:'b)) = (INT_MAX (:'a) <= INT_MAX (:'b))`, 651 SIMP_TAC bool_ss [INT_MAX_def, dimindex_int_min_le_iso, 652 iso_lem, DIMINDEX_GT_0, ZERO_LT_INT_MIN]) 653 654val dimindex_int_max_lt_iso = Q.store_thm("dimindex_int_max_lt_iso", 655 `(dimindex (:'a) < dimindex (:'b)) = (INT_MAX (:'a) < INT_MAX (:'b))`, 656 SIMP_TAC bool_ss [INT_MAX_def, dimindex_int_min_lt_iso, 657 iso_lem, DIMINDEX_GT_0, ZERO_LT_INT_MIN]) 658 659 660 661val dimindex_uint_max_iso = Q.store_thm("dimindex_uint_max_iso", 662 `(dimindex (:'a) = dimindex (:'b)) = (UINT_MAX (:'a) = UINT_MAX (:'b))`, 663 SRW_TAC [] [UINT_MAX_def, dimindex_dimword_iso] 664 \\ SIMP_TAC (srw_ss()) [iso_lem]) 665 666val dimindex_uint_max_le_iso = Q.store_thm("dimindex_uint_max_le_iso", 667 `(dimindex (:'a) <= dimindex (:'b)) = (UINT_MAX (:'a) <= UINT_MAX (:'b))`, 668 SIMP_TAC bool_ss [UINT_MAX_def, dimindex_dimword_le_iso, 669 iso_lem, ZERO_LT_dimword]) 670 671val dimindex_uint_max_lt_iso = Q.store_thm("dimindex_uint_max_lt_iso", 672 `(dimindex (:'a) < dimindex (:'b)) = (UINT_MAX (:'a) < UINT_MAX (:'b))`, 673 SIMP_TAC bool_ss [UINT_MAX_def, dimindex_dimword_lt_iso, 674 iso_lem, ZERO_LT_dimword]) 675 676(* ------------------------------------------------------------------------- 677 Domain transforming maps : theorems 678 ------------------------------------------------------------------------- *) 679 680val WORD_ss = rewrites [w2n_def,n2w_def] 681 682val SUM_SLICE = Q.prove( 683 `!n x. SUM n (\i. SLICE i i x) = x MOD 2 ** n`, 684 Induct \\ ASM_SIMP_TAC arith_ss [SUM_def] 685 \\ Cases_on `n` 686 \\ SIMP_TAC arith_ss [GSYM BITS_ZERO3,GSYM SLICE_ZERO_THM, 687 ONCE_REWRITE_RULE [ADD_COMM] SLICE_COMP_THM]) 688 689val SUM_SBIT_LT = Q.prove( 690 `!n f. SUM n (\i. SBIT (f i) i) < 2 ** n`, 691 Induct \\ ASM_SIMP_TAC arith_ss [SUM_def,ZERO_LT_TWOEXP] 692 \\ STRIP_TAC \\ `SBIT (f n) n <= 2 ** n` by RW_TAC arith_ss [SBIT_def] 693 \\ METIS_TAC [EXP,DECIDE ``!a b c. a <= b /\ c < b ==> a + c < 2 * b``]) 694 695val w2n_n2w_lem = Q.prove( 696 `!n. SUM ^WL (\i. SBIT (((FCP i. BIT i n):'a word) ' i) i) = 697 SUM ^WL (\i. SLICE i i n)`, 698 STRIP_TAC \\ REWRITE_TAC [SUM] \\ MATCH_MP_TAC GSUM_FUN_EQUAL 699 \\ RW_TAC (fcp_ss++ARITH_ss) [BIT_SLICE_THM]) 700 701val w2n_n2w = Q.store_thm("w2n_n2w[simp]", 702 `!n. w2n (n2w:num->('a word) n) = n MOD (dimword(:'a))`, 703 SIMP_TAC (fcp_ss++WORD_ss) [w2n_n2w_lem,SUM_SLICE, dimword_def]) 704 705val n2w_w2n_lem = Q.prove( 706 `!n f i. BIT i (SUM n (\j. SBIT (f j) j)) = f i /\ i < n`, 707 Induct \\ ASM_SIMP_TAC arith_ss [SUM_def,BIT_ZERO] 708 \\ REPEAT STRIP_TAC \\ Cases_on `i < n` 709 \\ FULL_SIMP_TAC arith_ss [NOT_LESS,prim_recTheory.LESS_THM] 710 >| [ 711 IMP_RES_TAC LESS_ADD_1 712 \\ `SBIT (f n) n = (if f n then 1 else 0) * 2 ** p * 2 ** (SUC i)` 713 by RW_TAC (std_ss++numSimps.ARITH_AC_ss) [SBIT_def,EXP_ADD,EXP] 714 \\ FULL_SIMP_TAC std_ss [BITS_SUM2,BIT_def], 715 Q.PAT_X_ASSUM `!f i. P` (Q.SPECL_THEN [`f`,`i`] ASSUME_TAC) 716 \\ `SUM n (\i. SBIT (f i) i) < 2 ** n` by METIS_TAC [SUM_SBIT_LT] 717 \\ IMP_RES_TAC LESS_EQUAL_ADD 718 \\ `SBIT (f n) n = (if f n then 1 else 0) * 2 ** n` 719 by RW_TAC arith_ss [SBIT_def] 720 \\ ASM_SIMP_TAC std_ss [BITS_SUM, 721 (GSYM o REWRITE_RULE [LESS_EQ_REFL] o 722 Q.SPECL [`p`,`n + p`,`n`]) BIT_OF_BITS_THM] 723 \\ FULL_SIMP_TAC std_ss [BIT_def,BITS_COMP_THM2] 724 \\ Cases_on `p = 0` \\ RW_TAC std_ss [BITS_ZERO2] 725 \\ ASM_SIMP_TAC arith_ss [GSYM BIT_def,BIT_B,BIT_B_NEQ]]) 726 727val n2w_w2n = Q.store_thm("n2w_w2n[simp]", 728 `!w. n2w (w2n (w:'a word)) = w`, 729 SIMP_TAC (fcp_ss++WORD_ss) [n2w_w2n_lem]) 730 731val word_nchotomy = Q.store_thm("word_nchotomy", 732 `!w. ?n. w = n2w n`, PROVE_TAC [n2w_w2n]) 733 734val n2w_mod = Q.store_thm("n2w_mod", 735 `!n. (n2w:num -> 'a word) (n MOD dimword(:'a)) = n2w n`, 736 RW_TAC fcp_ss [dimword_def] 737 \\ STRIP_ASSUME_TAC EXISTS_HB 738 \\ ASM_SIMP_TAC (fcp_ss++ARITH_ss) 739 [n2w_def,MIN_DEF,BIT_def,GSYM BITS_ZERO3,BITS_COMP_THM2]) 740 741val n2w_11 = Q.store_thm("n2w_11[simp]", 742 `!m n. ((n2w m):'a word = n2w n) = (m MOD dimword(:'a) = n MOD dimword(:'a))`, 743 NTAC 2 STRIP_TAC 744 \\ STRIP_ASSUME_TAC EXISTS_HB 745 \\ ASM_SIMP_TAC (fcp_ss++WORD_ss) [GSYM BITS_ZERO3,dimword_def] 746 \\ EQ_TAC \\ RW_TAC arith_ss [DECIDE ``i < SUC p = i <= p``] 747 \\ PROVE_TAC 748 [(REWRITE_RULE [ZERO_LESS_EQ] o Q.SPECL [`p`,`0`]) BIT_BITS_THM] 749) 750 751val ranged_word_nchotomy = Q.store_thm("ranged_word_nchotomy", 752 `!w:'a word. ?n. (w = n2w n) /\ n < dimword(:'a)`, 753 STRIP_TAC 754 \\ Q.ISPEC_THEN `w` STRUCT_CASES_TAC word_nchotomy 755 \\ SIMP_TAC (srw_ss()) [n2w_11] 756 \\ Q.EXISTS_TAC `n MOD dimword(:'a)` 757 \\ SIMP_TAC (srw_ss()) [dimword_def, MOD_MOD, DIVISION]) 758 759val _ = TypeBase.write [TypeBasePure.mk_nondatatype_info 760 (``:'a word``, 761 {nchotomy = SOME ranged_word_nchotomy, encode=NONE, 762 induction = NONE, 763 size = SOME (``\(v1:bool->num) (v2:'a->num) (v3:'a word). w2n v3``, 764 CONJUNCT1 (SPEC_ALL AND_CLAUSES))})] 765 766val dimindex_1_cases = Q.store_thm("dimindex_1_cases", 767 `!a:'a word. (dimindex(:'a) = 1) ==> (a = 0w) \/ (a = 1w)`, 768 Cases \\ STRIP_TAC 769 \\ FULL_SIMP_TAC std_ss [dimword_def] 770 \\ `(n = 0) \/ (n = 1)` by DECIDE_TAC 771 \\ ASM_REWRITE_TAC []) 772 773val mod_dimindex = Q.store_thm("mod_dimindex", 774 `!n. n MOD dimindex (:'a) < dimword (:'a)`, 775 METIS_TAC [arithmeticTheory.LESS_TRANS, arithmeticTheory.MOD_LESS, 776 dimindex_lt_dimword, DIMINDEX_GT_0]) 777 778val WORD_INDUCT = Q.store_thm("WORD_INDUCT", 779 `!P. P 0w /\ (!n. SUC n < dimword(:'a) ==> P (n2w n) ==> P (n2w (SUC n))) ==> 780 !x:'a word. P x`, 781 STRIP_TAC \\ STRIP_TAC \\ Cases \\ Induct_on `n` 782 \\ METIS_TAC [DECIDE ``SUC n < m ==> n < m``]) 783 784val w2n_11 = Q.store_thm("w2n_11[simp]", 785 `!v w. (w2n v = w2n w) = (v = w)`, 786 REPEAT Cases \\ REWRITE_TAC [w2n_n2w,n2w_11]) 787 788val w2n_lt = Q.store_thm("w2n_lt", 789 `!w:'a word. w2n w < dimword(:'a)`, 790 SIMP_TAC std_ss [w2n_def,SUM_SBIT_LT,dimword_def]) 791 792val word_0_n2w = Q.store_thm("word_0_n2w", 793 `w2n 0w = 0`, SIMP_TAC arith_ss [w2n_n2w, ZERO_LT_dimword]) 794 795val word_1_n2w = Q.store_thm("word_1_n2w", 796 `w2n 1w = 1`, SIMP_TAC arith_ss [w2n_n2w, ONE_LT_dimword]) 797 798val w2n_eq_0 = Q.store_thm("w2n_eq_0[simp]", 799 `!w. (w2n w = 0) = (w = 0w)`, 800 STRIP_TAC \\ Q.SPEC_THEN `w` STRUCT_CASES_TAC word_nchotomy \\ SRW_TAC [][]) 801 802val n2w_dimword = Q.store_thm("n2w_dimword", 803 `n2w (dimword (:'a)) = 0w : 'a word`, SRW_TAC [] []) 804 805val word_2comp_dimindex_1 = Q.store_thm("word_2comp_dimindex_1", 806 `!w:'a word. (dimindex (:'a) = 1) ==> (-w = w)`, 807 Cases \\ STRIP_TAC 808 \\ FULL_SIMP_TAC std_ss [dimword_def] 809 \\ `(n = 0) \/ (n = 1)` by DECIDE_TAC 810 \\ ASM_SIMP_TAC std_ss 811 [n2w_11, word_2comp_def, dimword_def, word_0_n2w, word_1_n2w]) 812 813val word_add_n2w = Q.store_thm("word_add_n2w", 814 `!m n. n2w m + n2w n = n2w (m + n)`, 815 SIMP_TAC fcp_ss [word_add_def,w2n_n2w] \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 816 \\ SIMP_TAC arith_ss [MOD_PLUS, ZERO_LT_dimword]) 817 818val word_mul_n2w = Q.store_thm("word_mul_n2w", 819 `!m n. n2w m * n2w n = n2w (m * n)`, 820 SIMP_TAC fcp_ss [word_mul_def,w2n_n2w] \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 821 \\ SIMP_TAC arith_ss [MOD_TIMES2,ZERO_LT_dimword]) 822 823val word_log2_n2w = Q.store_thm("word_log2_n2w", 824 `!n. word_log2 (n2w n):'a word = n2w (LOG2 (n MOD dimword(:'a)))`, 825 SIMP_TAC fcp_ss [word_log2_def,w2n_n2w]) 826 827val top = ``2 ** wl`` 828 829val BITWISE_ONE_COMP_THM = Q.prove( 830 `!wl a b. 0 < wl ==> 831 (BITWISE wl (\x y. ~x) a b = ^top - 1 - a MOD ^top)`, 832 REPEAT STRIP_TAC 833 \\ `?b. wl = SUC b` by PROVE_TAC [LESS_ADD_1,ADD1,ADD] 834 \\ ASM_SIMP_TAC bool_ss [BITWISE_ONE_COMP_LEM,BITS_ZERO3]) 835 836val ONE_COMP_THM = Q.prove( 837 `!wl a x. 0 < wl /\ x < wl ==> (BIT x (^top - 1 - a MOD ^top) = ~BIT x a)`, 838 REPEAT STRIP_TAC \\ IMP_RES_TAC (GSYM BITWISE_ONE_COMP_THM) 839 \\ ASM_REWRITE_TAC [] 840 \\ ASM_SIMP_TAC bool_ss [BITWISE_THM]) 841 842val word_1comp_n2w = Q.store_thm("word_1comp_n2w", 843 `!n. ~(n2w n):'a word = n2w (dimword(:'a) - 1 - n MOD dimword(:'a))`, 844 RW_TAC fcp_ss [word_1comp_def,n2w_def,ONE_COMP_THM,DIMINDEX_GT_0,dimword_def] 845) 846 847val word_2comp_n2w = Q.store_thm("word_2comp_n2w", 848 `!n. - (n2w n):'a word = n2w (dimword(:'a) - n MOD dimword(:'a))`, 849 SIMP_TAC std_ss [word_2comp_def,n2w_11,w2n_n2w]) 850 851val word_lsb = Q.store_thm("word_lsb", 852 `word_lsb = word_bit 0`, 853 SRW_TAC [fcpLib.FCP_ss] [FUN_EQ_THM, word_lsb_def, word_bit_def]) 854 855val word_msb = Q.store_thm("word_msb", 856 `word_msb:'a word->bool = word_bit (dimindex(:'a) - 1)`, 857 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [FUN_EQ_THM, word_msb_def, word_bit_def]) 858 859val word_lsb_n2w = Q.store_thm("word_lsb_n2w", 860 `!n. word_lsb ((n2w n):'a word) = ODD n`, 861 SIMP_TAC fcp_ss [word_lsb_def,n2w_def,DIMINDEX_GT_0,BIT0_ODD]) 862 863val word_msb_n2w = Q.store_thm("word_msb_n2w", 864 `!n. word_msb ((n2w n):'a word) = BIT ^HB n`, 865 SIMP_TAC (fcp_ss++ARITH_ss) [word_msb_def,n2w_def,DIMINDEX_GT_0]) 866 867val word_msb_n2w_numeric = Q.store_thm( 868 "word_msb_n2w_numeric", 869 `word_msb (n2w n : 'a word) = INT_MIN(:'a) <= n MOD dimword(:'a)`, 870 `dimword(:'a) = 2 * INT_MIN(:'a)` by ACCEPT_TAC dimword_IS_TWICE_INT_MIN THEN 871 Q.ABBREV_TAC `WL = dimword (:'a)` THEN 872 `0 < WL` by SRW_TAC [][Abbr`WL`, DIMINDEX_GT_0] THEN 873 `(n = (n DIV WL) * WL + n MOD WL) /\ n MOD WL < WL` 874 by METIS_TAC [DIVISION] THEN 875 Q.ABBREV_TAC `q = n DIV WL` THEN 876 Q.ABBREV_TAC `r = n MOD WL` THEN 877 ASM_SIMP_TAC (srw_ss())[word_msb_n2w, bitTheory.BIT_def, bitTheory.BITS_def, 878 MOD_2EXP_def, DIV_2EXP_def, DECIDE ``SUC x - x = 1``, EQ_IMP_THM] 879 THEN REPEAT STRIP_TAC 880 THENL [ 881 SPOSE_NOT_THEN ASSUME_TAC THEN 882 `r < INT_MIN(:'a)` by SRW_TAC [ARITH_ss][Abbr`r`] THEN 883 `n DIV INT_MIN(:'a) = 2 * q` 884 by (SRW_TAC [][] THEN METIS_TAC [DIV_MULT, 885 MULT_COMM, 886 MULT_ASSOC]) THEN 887 METIS_TAC 888 [DECIDE ``~(0n = 1) /\ 0 < 2n``, MOD_EQ_0, MULT_COMM, INT_MIN_def], 889 890 MATCH_MP_TAC MOD_UNIQUE THEN 891 Q.EXISTS_TAC `q` THEN ASM_SIMP_TAC (srw_ss()) [] THEN 892 MATCH_MP_TAC DIV_UNIQUE THEN 893 Q.EXISTS_TAC `r - INT_MIN(:'a)` THEN 894 FULL_SIMP_TAC (srw_ss() ++ ARITH_ss) [INT_MIN_def] 895 ]) 896 897val word_and_n2w = Q.store_thm("word_and_n2w", 898 `!n m. (n2w n):'a word && (n2w m) = n2w (BITWISE ^WL (/\) n m)`, 899 SIMP_TAC fcp_ss [word_and_def,n2w_11,n2w_def,BITWISE_THM]) 900 901val word_or_n2w = Q.store_thm("word_or_n2w", 902 `!n m. (n2w n):'a word || (n2w m) = n2w (BITWISE ^WL (\/) n m)`, 903 SIMP_TAC fcp_ss [word_or_def,n2w_11,n2w_def,BITWISE_THM]) 904 905val word_xor_n2w = Q.store_thm("word_xor_n2w", 906 `!n m. (n2w n):'a word ?? (n2w m) = n2w (BITWISE ^WL (\x y. ~(x = y)) n m)`, 907 SIMP_TAC fcp_ss [word_xor_def,n2w_11,n2w_def,BITWISE_THM]) 908 909val word_nand_n2w = Q.store_thm("word_nand_n2w", 910 `!n m. (n2w n):'a word ~&& (n2w m) = n2w (BITWISE ^WL (\x y. ~(x /\ y)) n m)`, 911 SIMP_TAC fcp_ss [word_nand_def,n2w_11,n2w_def,BITWISE_THM]) 912 913val word_nor_n2w = Q.store_thm("word_nor_n2w", 914 `!n m. (n2w n):'a word ~|| (n2w m) = n2w (BITWISE ^WL (\x y. ~(x \/ y)) n m)`, 915 SIMP_TAC fcp_ss [word_nor_def,n2w_11,n2w_def,BITWISE_THM]) 916 917val word_xnor_n2w = Q.store_thm("word_xnor_n2w", 918 `!n m. (n2w n):'a word ~?? (n2w m) = n2w (BITWISE ^WL (=) n m)`, 919 SIMP_TAC fcp_ss [word_xnor_def,n2w_11,n2w_def,BITWISE_THM]) 920 921(* ......................................................................... *) 922 923val l2w_w2l = Q.store_thm("l2w_w2l", 924 `!b w. 1 < b ==> (l2w b (w2l b w) = w)`, 925 SRW_TAC [ARITH_ss] [l2w_def, w2l_def, l2n_n2l]) 926 927val w2l_l2w = Q.store_thm("w2l_l2w", 928 `!b l. w2l b (l2w b l : 'a word) = n2l b (l2n b l MOD dimword(:'a))`, 929 SRW_TAC [] [l2w_def, w2l_def]) 930 931val s2w_w2s = Q.store_thm("s2w_w2s", 932 `!c2n n2c b w. 1 < b /\ (!x. x < b ==> (c2n (n2c x) = x)) ==> 933 (s2w b c2n (w2s b n2c w) = w)`, 934 SRW_TAC [] [s2w_def, w2s_def, s2n_n2s]) 935 936val w2s_s2w = Q.store_thm("w2s_s2w", 937 `!b c2n n2c s. 938 w2s b n2c (s2w b c2n s : 'a word) = 939 n2s b n2c (s2n b c2n s MOD dimword(:'a))`, 940 SRW_TAC [] [s2w_def, w2s_def]) 941 942val NUMERAL_LESS_THM = save_thm("NUMERAL_LESS_THM", 943 CONV_RULE numLib.SUC_TO_NUMERAL_DEFN_CONV prim_recTheory.LESS_THM) 944 945val rwts = [FUN_EQ_THM, UNHEX_HEX, l2n_n2l, s2n_n2s, l2w_w2l, s2w_w2s, 946 word_from_bin_list_def,word_from_oct_list_def,word_from_dec_list_def, 947 word_from_hex_list_def,word_to_bin_list_def,word_to_oct_list_def, 948 word_to_dec_list_def,word_to_hex_list_def,word_from_bin_string_def, 949 word_from_oct_string_def,word_from_dec_string_def,word_from_hex_string_def, 950 word_to_bin_string_def,word_to_oct_string_def,word_to_dec_string_def, 951 word_to_hex_string_def] 952 953val word_bin_list = Q.store_thm("word_bin_list", 954 `word_from_bin_list o word_to_bin_list = I`, SRW_TAC [ARITH_ss] rwts) 955val word_oct_list = Q.store_thm("word_oct_list", 956 `word_from_oct_list o word_to_oct_list = I`, SRW_TAC [ARITH_ss] rwts) 957val word_dec_list = Q.store_thm("word_dec_list", 958 `word_from_dec_list o word_to_dec_list = I`, SRW_TAC [ARITH_ss] rwts) 959val word_hex_list = Q.store_thm("word_hex_list", 960 `word_from_hex_list o word_to_hex_list = I`, SRW_TAC [ARITH_ss] rwts) 961 962val word_bin_string = Q.store_thm("word_bin_string", 963 `word_from_bin_string o word_to_bin_string = I`, SRW_TAC [ARITH_ss] rwts) 964val word_oct_string = Q.store_thm("word_oct_string", 965 `word_from_oct_string o word_to_oct_string = I`, SRW_TAC [ARITH_ss] rwts) 966val word_dec_string = Q.store_thm("word_dec_string", 967 `word_from_dec_string o word_to_dec_string = I`, SRW_TAC [ARITH_ss] rwts) 968val word_hex_string = Q.store_thm("word_hex_string", 969 `word_from_hex_string o word_to_hex_string = I`, SRW_TAC [ARITH_ss] rwts) 970 971(* ------------------------------------------------------------------------- 972 The Boolean operations : theorems 973 ------------------------------------------------------------------------- *) 974 975val _ = temp_overload_on ("Tw",``words$word_T``) 976 977val ONE_COMP_0_THM = 978 (SIMP_RULE arith_ss [BIT_ZERO,ZERO_MOD,ZERO_LT_TWOEXP] o 979 Q.SPECL [`wl`,`0`]) ONE_COMP_THM 980 981val word_0 = Q.store_thm("word_0", 982 `!i. i < ^WL ==> ~((0w:'a word) ' i)`, 983 SIMP_TAC fcp_ss [n2w_def,BIT_ZERO]) 984 985val word_eq_0 = Q.store_thm("word_eq_0", 986 `!w: 'a word. (w = 0w) = (!i. i < dimindex(:'a) ==> ~w ' i)`, 987 SRW_TAC [fcpLib.FCP_ss] [word_0]) 988 989val word_T = Q.store_thm("word_T", 990 `!i. i < ^WL ==> (Tw:'a word) ' i`, 991 SIMP_TAC fcp_ss [word_T_def,n2w_def,ONE_COMP_0_THM,DIMINDEX_GT_0, 992 UINT_MAX_def, dimword_def]) 993 994val FCP_T_F = Q.store_thm("FCP_T_F[simp]", 995 `($FCP (K T) = word_T) /\ ($FCP (K F) = 0w)`, 996 SRW_TAC [fcpLib.FCP_ss] [word_T, word_0]) 997 998val word_L = Q.store_thm("word_L", 999 `!n. n < dimindex(:'a) ==> 1000 ((INT_MINw:'a word) ' n = (n = dimindex(:'a) - 1))`, 1001 SRW_TAC [fcpLib.FCP_ss] [word_L_def, n2w_def, INT_MIN_def] 1002 \\ Cases_on `n = dimindex (:'a) - 1` 1003 \\ SRW_TAC [] []) 1004 1005val word_H = Q.store_thm("word_H", 1006 `!n. n < dimindex(:'a) ==> 1007 ((INT_MAXw:'a word) ' n = (n < dimindex(:'a) - 1))`, 1008 SRW_TAC [fcpLib.FCP_ss] [word_H_def, n2w_def, INT_MAX_def, INT_MIN_def] 1009 \\ Cases_on `n < dimindex (:'a) - 1` 1010 \\ SRW_TAC [] [BIT_EXP_SUB1]) 1011 1012val word_L2 = Q.store_thm("word_L2", 1013 `word_L2:'a word = if 1 < dimindex(:'a) then 0w else word_L`, 1014 SRW_TAC [] 1015 [GSYM EXP_ADD, word_L2_def, word_L_def, INT_MIN_def, word_mul_n2w] 1016 \\ FULL_SIMP_TAC arith_ss [ZERO_LT_dimword, dimword_def, 1017 DECIDE ``~(1 < n) = (n = 0) \/ (n = 1)``] 1018 \\ IMP_RES_TAC LESS_ADD_1 1019 \\ SRW_TAC [ARITH_ss] [LEFT_ADD_DISTRIB] 1020 \\ SIMP_TAC bool_ss [TIMES2, EXP_ADD, GSYM MULT_ASSOC, 1021 GSYM MOD_COMMON_FACTOR, ZERO_LT_TWOEXP] 1022 \\ SRW_TAC [] [MOD_EQ_0, MULT_ASSOC, ZERO_LT_TWOEXP]) 1023 1024val WORD_NEG_1 = Q.store_thm("WORD_NEG_1", 1025 `-1w:'a word = Tw:'a word`, 1026 REWRITE_TAC [word_T_def,word_2comp_def,w2n_n2w,UINT_MAX_def] 1027 \\ Cases_on `dimword (:'a) = 1` 1028 >- ASM_SIMP_TAC arith_ss [n2w_11] 1029 \\ ASM_SIMP_TAC arith_ss [DECIDE ``0 < x /\ ~(x = 1) ==> 1 < x``, 1030 LESS_MOD,ZERO_LT_TWOEXP,dimword_def]) 1031 1032val WORD_NEG_1_T = save_thm("WORD_NEG_1_T", 1033 REWRITE_RULE [GSYM WORD_NEG_1] word_T) 1034 1035val WORD_MSB_1COMP = Q.store_thm("WORD_MSB_1COMP", 1036 `!w. word_msb ~w = ~word_msb w`, 1037 SRW_TAC [fcpLib.FCP_ss] [DIMINDEX_GT_0,word_msb_def,word_1comp_def]) 1038 1039val w2n_minus1 = Q.store_thm("w2n_minus1", 1040 `w2n (-1w:'a word) = dimword(:'a) - 1`, 1041 simp [WORD_NEG_1, word_T_def, w2n_n2w, UINT_MAX_def] 1042 ) 1043 1044val w2n_plus1 = Q.store_thm("w2n_plus1", 1045 `!a: 'a word. 1046 w2n a + 1 = if a = UINT_MAXw then dimword(:'a) else w2n (a + 1w)`, 1047 rw [w2n_minus1, DECIDE ``0n < a ==> (a - 1 + 1 = a)``] 1048 \\ strip_assume_tac (Q.SPEC `a` ranged_word_nchotomy) 1049 \\ simp [word_add_n2w] 1050 \\ full_simp_tac std_ss [WORD_NEG_1, word_T_def] 1051 \\ fs [BOUND_ORDER, UINT_MAX_def] 1052 ) 1053 1054val WORD_ss = 1055 rewrites [word_1comp_def,word_and_def,word_or_def,word_xor_def, 1056 word_nand_def,word_nor_def,word_xnor_def,word_0,word_T] 1057 1058val BOOL_WORD_TAC = SIMP_TAC (fcp_ss++WORD_ss) [] \\ DECIDE_TAC 1059 1060val WORD_NOT_NOT = Q.store_thm("WORD_NOT_NOT[simp]", 1061 `!a:'a word. ~(~a) = a`, BOOL_WORD_TAC) 1062 1063val WORD_DE_MORGAN_THM = Q.store_thm("WORD_DE_MORGAN_THM", 1064 `!a b. (~(a && b) = ~a || ~b) /\ (~(a || b) = ~a && ~b)`, BOOL_WORD_TAC) 1065 1066val WORD_NOT_XOR = Q.store_thm("WORD_NOT_XOR[simp]", 1067 `!a b. (~a ?? ~b = a ?? b) /\ (a ?? ~b = ~(a ?? b)) /\ (~a ?? b = ~(a ?? b))`, 1068 RW_TAC (fcp_ss++WORD_ss) [] \\ DECIDE_TAC) 1069 1070val WORD_AND_CLAUSES = Q.store_thm("WORD_AND_CLAUSES", 1071 `!a:'a word. 1072 (Tw && a = a) /\ (a && Tw = a) /\ 1073 (0w && a = 0w) /\ (a && 0w = 0w) /\ 1074 (a && a = a)`, BOOL_WORD_TAC) 1075 1076val WORD_OR_CLAUSES = Q.store_thm("WORD_OR_CLAUSES", 1077 `!a:'a word. 1078 (Tw || a = Tw) /\ (a || Tw = Tw) /\ 1079 (0w || a = a) /\ (a || 0w = a) /\ 1080 (a || a = a)`, BOOL_WORD_TAC) 1081 1082val WORD_XOR_CLAUSES = Q.store_thm("WORD_XOR_CLAUSES", 1083 `!a:'a word. 1084 (Tw ?? a = ~a) /\ (a ?? Tw = ~a) /\ 1085 (0w ?? a = a) /\ (a ?? 0w = a) /\ 1086 (a ?? a = 0w)`, BOOL_WORD_TAC) 1087 1088val WORD_AND_ASSOC = Q.store_thm("WORD_AND_ASSOC", 1089 `!a b c. (a && b) && c = a && b && c`, BOOL_WORD_TAC) 1090 1091val WORD_OR_ASSOC = Q.store_thm("WORD_OR_ASSOC", 1092 `!a b c. (a || b) || c = a || b || c`, BOOL_WORD_TAC) 1093 1094val WORD_XOR_ASSOC = Q.store_thm("WORD_XOR_ASSOC", 1095 `!a b c. (a ?? b) ?? c = a ?? b ?? c`, BOOL_WORD_TAC) 1096 1097val WORD_AND_COMM = Q.store_thm("WORD_AND_COMM", 1098 `!a b. a && b = b && a`, BOOL_WORD_TAC) 1099 1100val WORD_OR_COMM = Q.store_thm("WORD_OR_COMM", 1101 `!a b. a || b = b || a`, BOOL_WORD_TAC) 1102 1103val WORD_XOR_COMM = Q.store_thm("WORD_XOR_COMM", 1104 `!a b. a ?? b = b ?? a`, BOOL_WORD_TAC) 1105 1106val WORD_AND_IDEM = Q.store_thm("WORD_AND_IDEM", 1107 `!a. a && a = a`, BOOL_WORD_TAC) 1108 1109val WORD_OR_IDEM = Q.store_thm("WORD_OR_IDEM", 1110 `!a. a || a = a`, BOOL_WORD_TAC) 1111 1112val WORD_AND_ABSORD = Q.store_thm("WORD_AND_ABSORD[simp]", 1113 `!a b. a || a && b = a`, BOOL_WORD_TAC) 1114 1115val WORD_OR_ABSORB = Q.store_thm("WORD_OR_ABSORB", 1116 `!a b. a && (a || b) = a`, BOOL_WORD_TAC) 1117 1118val WORD_AND_COMP = Q.store_thm("WORD_AND_COMP[simp]", 1119 `!a. a && ~a = 0w`, BOOL_WORD_TAC) 1120 1121val WORD_OR_COMP = Q.store_thm("WORD_OR_COMP", 1122 `!a. a || ~a = Tw`, BOOL_WORD_TAC) 1123 1124val WORD_XOR_COMP = Q.store_thm("WORD_XOR_COMP", 1125 `!a. a ?? ~a = Tw`, BOOL_WORD_TAC) 1126 1127val WORD_RIGHT_AND_OVER_OR = Q.store_thm("WORD_RIGHT_AND_OVER_OR", 1128 `!a b c. (a || b) && c = a && c || b && c`, BOOL_WORD_TAC) 1129 1130val WORD_RIGHT_OR_OVER_AND = Q.store_thm("WORD_RIGHT_OR_OVER_AND", 1131 `!a b c. (a && b) || c = (a || c) && (b || c)`, BOOL_WORD_TAC) 1132 1133val WORD_RIGHT_AND_OVER_XOR = Q.store_thm("WORD_RIGHT_AND_OVER_XOR", 1134 `!a b c. (a ?? b) && c = a && c ?? b && c`, BOOL_WORD_TAC) 1135 1136val WORD_LEFT_AND_OVER_OR = Q.store_thm("WORD_LEFT_AND_OVER_OR", 1137 `!a b c. a && (b || c) = a && b || a && c`, BOOL_WORD_TAC) 1138 1139val WORD_LEFT_OR_OVER_AND = Q.store_thm("WORD_LEFT_OR_OVER_AND", 1140 `!a b c. a || b && c = (a || b) && (a || c)`, BOOL_WORD_TAC) 1141 1142val WORD_LEFT_AND_OVER_XOR = Q.store_thm("WORD_LEFT_AND_OVER_XOR", 1143 `!a b c. a && (b ?? c) = a && b ?? a && c`, BOOL_WORD_TAC) 1144 1145val WORD_XOR = Q.store_thm("WORD_XOR", 1146 `!a b. a ?? b = a && ~b || b && ~a`, BOOL_WORD_TAC) 1147 1148val WORD_NAND_NOT_AND = Q.store_thm("WORD_NAND_NOT_AND[simp]", 1149 `!a b. a ~&& b = ~(a && b)`, BOOL_WORD_TAC) 1150 1151val WORD_NOR_NOT_OR = Q.store_thm("WORD_NOR_NOT_OR[simp]", 1152 `!a b. a ~|| b = ~(a || b)`, BOOL_WORD_TAC) 1153 1154val WORD_XNOR_NOT_XOR = Q.store_thm("WORD_XNOR_NOT_XOR[simp]", 1155 `!a b. a ~?? b = ~(a ?? b)`, BOOL_WORD_TAC) 1156 1157val ADD_OR_lem_ = Q.prove( 1158 `!a b n. ~BIT n a \/ ~BIT n b ==> 1159 (SBIT (BIT n a \/ BIT n b) n = SBIT (BIT n a) n + SBIT (BIT n b) n)`, 1160 SRW_TAC [] [SBIT_def] \\ FULL_SIMP_TAC std_ss []) 1161 1162val ADD_OR_lem = Q.prove( 1163 `!n a b. (!i. i < n ==> ~BIT i a \/ ~BIT i b) ==> 1164 (SUM n (\i. SBIT (BIT i a) i) + SUM n (\i. SBIT (BIT i b) i) = 1165 BITWISE n $\/ a b)`, 1166 Induct \\ SRW_TAC [ARITH_ss] [BITWISE_def, sum_numTheory.SUM_def] 1167 \\ REWRITE_TAC [ADD_ASSOC] 1168 \\ METIS_TAC [ADD_OR_lem_, DECIDE ``n < SUC n``]) 1169 1170val WORD_ADD_OR = Q.store_thm("WORD_ADD_OR", 1171 `!a b. (a && b = 0w) ==> (a + b = a || b)`, 1172 SRW_TAC [fcpLib.FCP_ss] [word_and_def, word_add_def, word_or_def, 1173 word_0, n2w_def, w2n_def] 1174 \\ Cases_on `a` 1175 \\ Cases_on `b` 1176 \\ FULL_SIMP_TAC (std_ss++fcpLib.FCP_ss) [n2w_def] 1177 \\ `!n j. j < dimindex (:'a) ==> 1178 ((\i'. SBIT (((FCP i. BIT i n):'a word) ' i') i') j = 1179 (\i'. SBIT (BIT i' n) i') j)` 1180 by SRW_TAC [fcpLib.FCP_ss] [] 1181 \\ POP_ASSUM (fn th => ASSUME_TAC (MATCH_MP SUM_FUN_EQUAL (Q.SPEC `n` th)) 1182 \\ ASSUME_TAC (MATCH_MP SUM_FUN_EQUAL (Q.SPEC `n'` th))) 1183 \\ NTAC 2 (POP_ASSUM SUBST1_TAC) 1184 \\ SRW_TAC [] [ADD_OR_lem, BITWISE_THM]) 1185 1186val WORD_ADD_XOR = Q.store_thm("WORD_ADD_XOR", 1187 `!a b. (a && b = 0w) ==> (a + b = a ?? b)`, 1188 SIMP_TAC std_ss [WORD_ADD_OR] 1189 \\ SIMP_TAC std_ss [CART_EQ,word_0,word_xor_def, 1190 word_or_def,FCP_BETA,word_and_def] 1191 \\ REPEAT STRIP_TAC \\ RES_TAC \\ ASM_SIMP_TAC std_ss []) 1192 1193val WORD_AND_EXP_SUB1 = Q.store_thm("WORD_AND_EXP_SUB1", 1194 `!m n. n2w n && n2w (2 ** m - 1) = n2w (n MOD 2 ** m)`, 1195 Cases 1196 \\ SRW_TAC [fcpLib.FCP_ss] [BIT_ZERO, BIT_EXP_SUB1, n2w_def, word_and_def] 1197 \\ Cases_on `i < SUC n` 1198 \\ SRW_TAC [ARITH_ss] [BITS_ZERO, MIN_DEF, BIT_def, BITS_COMP_THM2, 1199 GSYM BITS_ZERO3]) 1200 1201val word_msb_add_word_L = Q.store_thm("word_msb_add_word_L", 1202 `!a: 'a word. word_msb (a + INT_MINw) = ~word_msb a`, 1203 Cases 1204 \\ fs [word_L_def, word_add_n2w, dimword_IS_TWICE_INT_MIN, 1205 word_msb_n2w_numeric] 1206 \\ Cases_on `INT_MIN (:'a) <= n` 1207 \\ simp [] 1208 \\ imp_res_tac arithmeticTheory.LESS_EQUAL_ADD 1209 \\ simp [] 1210 ) 1211 1212(* ------------------------------------------------------------------------- 1213 Bit field operations : theorems 1214 ------------------------------------------------------------------------- *) 1215 1216val w2w = Q.store_thm("w2w", 1217 `!w:'a word i. i < dimindex (:'b) ==> 1218 (((w2w w):'b word) ' i = i < ^WL /\ w ' i)`, 1219 Cases \\ POP_ASSUM (K ALL_TAC) \\ SIMP_TAC std_ss [w2w_def,w2n_n2w] 1220 \\ STRIP_ASSUME_TAC EXISTS_HB 1221 \\ STRIP_ASSUME_TAC (Thm.INST_TYPE [alpha |-> beta] EXISTS_HB) 1222 \\ RW_TAC (fcp_ss++ARITH_ss) [n2w_def,BIT_def,BITS_COMP_THM2, 1223 GSYM BITS_ZERO3, dimword_def] 1224 \\ Cases_on `i < SUC m` 1225 \\ ASM_SIMP_TAC (fcp_ss++ARITH_ss) [MIN_DEF,BITS_ZERO]) 1226 1227val sw2sw = Q.store_thm("sw2sw", 1228 `!w:'a word i. i < dimindex(:'b) ==> 1229 ((sw2sw w :'b word) ' i = 1230 if i < dimindex (:'a) \/ dimindex(:'b) < dimindex(:'a) then 1231 w ' i 1232 else 1233 word_msb w)`, 1234 STRIP_TAC \\ Q.ISPEC_THEN `w` FULL_STRUCT_CASES_TAC ranged_word_nchotomy 1235 \\ SRW_TAC [ARITH_ss,fcpLib.FCP_ss] [sw2sw_def, w2n_n2w, n2w_def, 1236 word_msb_n2w, BIT_SIGN_EXTEND, DIMINDEX_GT_0] 1237 \\ FULL_SIMP_TAC arith_ss [dimword_def, BIT_SIGN_EXTEND, DIMINDEX_GT_0]) 1238 1239val WORD_ss = rewrites [word_extract_def, word_slice_def,word_bits_def, 1240 word_bit_def,word_lsl_def,word_lsr_def,word_and_def,word_or_def,word_xor_def, 1241 word_reverse_def,word_modify_def,n2w_def,w2w,sw2sw,word_msb_def, 1242 SUC_SUB1,BIT_SLICE_THM4] 1243 1244val FIELD_WORD_TAC = RW_TAC (fcp_ss++WORD_ss++ARITH_ss) [] 1245 1246val w2w_id = Q.store_thm("w2w_id[simp]", 1247 `!w:'a word. w2w w:'a word = w`, FIELD_WORD_TAC) 1248 1249val sw2sw_id = Q.store_thm("sw2sw_id[simp]", 1250 `!w:'a word. sw2sw w:'a word = w`, FIELD_WORD_TAC) 1251 1252val w2w_w2w = Q.store_thm("w2w_w2w", 1253 `!w:'a word. (w2w ((w2w w):'b word)):'c word = 1254 w2w ((dimindex (:'b) - 1 -- 0) w)`, 1255 FIELD_WORD_TAC 1256 \\ Cases_on `i < ^WL` \\ FIELD_WORD_TAC 1257 \\ Cases_on `i < dimindex (:'b)` \\ FIELD_WORD_TAC 1258 \\ PROVE_TAC [DECIDE ``0 < n /\ ~(i < n) ==> ~(i <= n - 1)``, 1259 DIMINDEX_GT_0]) 1260 1261val sw2sw_sw2sw_lem = Q.prove( 1262 `!w:'a word. ~(dimindex(:'b) < dimindex(:'a) /\ 1263 dimindex(:'b) < dimindex(:'c)) ==> 1264 (sw2sw ((sw2sw w):'b word) :'c word = sw2sw w)`, 1265 FIELD_WORD_TAC 1266 \\ FIELD_WORD_TAC 1267 \\ FULL_SIMP_TAC arith_ss [sw2sw,DIMINDEX_GT_0,NOT_LESS] 1268 \\ FIELD_WORD_TAC 1269 \\ `dimindex (:'b) = dimindex (:'a)` by DECIDE_TAC 1270 \\ ASM_REWRITE_TAC []) 1271 1272val sw2sw_sw2sw_lem2 = Q.prove( 1273 `!w:'a word. dimindex(:'b) < dimindex(:'a) /\ 1274 dimindex(:'b) < dimindex(:'c) ==> 1275 (sw2sw ((sw2sw w):'b word) :'c word = 1276 sw2sw (w2w w :'b word))`, 1277 FIELD_WORD_TAC 1278 \\ ASM_SIMP_TAC arith_ss [sw2sw,w2w,DIMINDEX_GT_0, 1279 DECIDE ``0 < b ==> (1 + (b - 1) = b) /\ (i <= b - 1 = i < b)``]) 1280 1281val sw2sw_sw2sw = Q.store_thm("sw2sw_sw2sw", 1282 `!w:'a word. (sw2sw ((sw2sw w):'b word)):'c word = 1283 if dimindex(:'b) < dimindex(:'a) /\ dimindex(:'b) < dimindex(:'c) then 1284 sw2sw (w2w w : 'b word) 1285 else 1286 sw2sw w`, 1287 STRIP_TAC 1288 \\ Cases_on `dimindex(:'b) < dimindex(:'a) /\ dimindex(:'b) < dimindex(:'c)` 1289 \\ ASM_SIMP_TAC std_ss [sw2sw_sw2sw_lem2] 1290 \\ METIS_TAC [sw2sw_sw2sw_lem]) 1291 1292val sw2sw_w2w = Q.store_thm("sw2sw_w2w", 1293 `!w:'a word. (sw2sw w):'b word = 1294 (if word_msb w then -1w << dimindex(:'a) else 0w) || w2w w`, 1295 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 1296 [word_or_def, word_lsl_def, sw2sw, w2w, WORD_NEG_1, word_T, word_0] 1297 \\ Cases_on `i < dimindex (:'a)` 1298 \\ SRW_TAC [ARITH_ss] []) 1299 1300val word_bit = Q.store_thm("word_bit", 1301 `!w:'a word b. b < dimindex (:'a) ==> 1302 (w ' b = word_bit b w)`, RW_TAC arith_ss [word_bit_def]) 1303 1304val word_slice_n2w = Q.store_thm("word_slice_n2w", 1305 `!h l n. (h '' l) (n2w n):'a word = 1306 (n2w (SLICE (MIN h ^HB) l n)):'a word`, 1307 FIELD_WORD_TAC) 1308 1309val word_bits_n2w = Q.store_thm("word_bits_n2w", 1310 `!h l n. (h -- l) (n2w n):'a word = 1311 (n2w (BITS (MIN h ^HB) l n)):'a word`, 1312 FIELD_WORD_TAC \\ Cases_on `i + l <= MIN h ^HB` 1313 \\ FULL_SIMP_TAC (fcp_ss++ARITH_ss) [MIN_DEF,NOT_LESS_EQUAL, 1314 BIT_OF_BITS_THM,BIT_OF_BITS_THM2]) 1315 1316val word_bit_n2w = Q.store_thm("word_bit_n2w", 1317 `!b n. word_bit b ((n2w n):'a word) = b <= ^HB /\ BIT b n`, 1318 FIELD_WORD_TAC \\ Cases_on `b <= ^HB` 1319 \\ ASM_SIMP_TAC fcp_ss [DIMINDEX_GT_0, 1320 DECIDE ``0 < b /\ a <= b - 1 ==> a < b:num``]) 1321 1322val bit_sign_extend = 1323 REWRITE_RULE [Q.SPEC `l <= h:num` IMP_DISJ_THM] BIT_SIGN_EXTEND 1324 1325val word_signed_bits_n2w = Q.store_thm("word_signed_bits_n2w", 1326 `!h l n. 1327 (h --- l) (n2w n) : 'a word = 1328 n2w (SIGN_EXTEND (MIN (SUC h) (dimindex(:'a)) - l) (dimindex(:'a)) 1329 (BITS (MIN h ^HB) l n))`, 1330 SRW_TAC [fcpLib.FCP_ss,ARITH_ss] [MIN_DEF, word_signed_bits_def, 1331 w2n_n2w, n2w_def] 1332 \\ FULL_SIMP_TAC (arith_ss++boolSimps.CONJ_ss) [NOT_LESS] 1333 >| [ 1334 Cases_on `l <= h` 1335 >| [ 1336 SRW_TAC [ARITH_ss] [bit_sign_extend, BIT_OF_BITS_THM, 1337 DECIDE ``l <= h ==> (SUC h - l = SUC (h - l))``, 1338 GSYM BITS_ZERO3, BITS_COMP_THM2] 1339 \\ FULL_SIMP_TAC arith_ss [NOT_LESS] 1340 \\ `i + l = h` by DECIDE_TAC 1341 \\ METIS_TAC [], 1342 `SUC h - l = 0` by DECIDE_TAC 1343 \\ SRW_TAC [ARITH_ss, boolSimps.LET_ss] 1344 [SIGN_EXTEND_def, BIT_ZERO, BITS_ZERO]], 1345 Cases_on `l <= dimindex (:'a) - 1` 1346 >| [ 1347 `0 < dimindex (:'a) - l` by DECIDE_TAC 1348 \\ `?x. dimindex (:'a) - l = SUC x` 1349 by METIS_TAC [LESS_ADD_1, ADD1, ADD] 1350 \\ SRW_TAC [ARITH_ss] [bit_sign_extend, BIT_OF_BITS_THM, 1351 GSYM BITS_ZERO3, BITS_COMP_THM2] 1352 \\ FULL_SIMP_TAC arith_ss [NOT_LESS] 1353 >| [ 1354 `i + l = dimindex (:'a) - 1` by DECIDE_TAC \\ METIS_TAC [], 1355 `l + x = dimindex (:'a) - 1` by DECIDE_TAC \\ METIS_TAC []], 1356 `(dimindex (:'a) - l = 0)` by DECIDE_TAC 1357 \\ SRW_TAC [ARITH_ss, boolSimps.LET_ss] 1358 [SIGN_EXTEND_def, BIT_ZERO, BITS_ZERO]]]) 1359 1360val MIN_lem = Q.prove( 1361 `!h t. MIN (MIN h t) (t + l) = MIN h t`, 1362 SRW_TAC [ARITH_ss] [MIN_DEF]) 1363 1364val word_sign_extend_bits = Q.store_thm("word_sign_extend_bits", 1365 `!h l w:'a word. 1366 (h --- l) w = 1367 word_sign_extend (MIN (SUC h) (dimindex(:'a)) - l) ((h -- l) w)`, 1368 NTAC 2 STRIP_TAC \\ Cases 1369 \\ SRW_TAC [] [word_sign_extend_def, word_signed_bits_n2w, word_bits_n2w, 1370 MOD_DIMINDEX, bitTheory.BITS_COMP_THM2, MIN_lem]) 1371 1372val word_index_n2w = Q.store_thm("word_index_n2w", 1373 `!n i. (n2w n : 'a word) ' i = 1374 if i < dimindex (:'a) then 1375 BIT i n 1376 else 1377 FAIL fcp$fcp_index ^(mk_var("index too large",bool)) 1378 (n2w n : 'a word) i`, 1379 RW_TAC arith_ss [word_bit,word_bit_n2w,combinTheory.FAIL_THM]) 1380 1381val word_index = save_thm("word_index", 1382 word_index_n2w 1383 |> SPEC_ALL 1384 |> Q.DISCH `i < dimindex (:'a)` 1385 |> SIMP_RULE bool_ss [] 1386 |> GEN_ALL) 1387 1388val MIN_lem = Q.prove( 1389 `(!m n. MIN m (m + n) = m) /\ !m n. MIN (m + n) m = m`, 1390 RW_TAC arith_ss [MIN_DEF]) 1391 1392val MIN_lem2 = Q.prove( 1393 `MIN a (MIN b (MIN (c + a) (c + b))) = MIN a b`, 1394 RW_TAC arith_ss [MIN_DEF]) 1395 1396val MIN_FST = Q.prove( 1397 `!x y. x <= y ==> (MIN x y = x)`, RW_TAC arith_ss [MIN_DEF]) 1398 1399val word_bits_w2w = Q.store_thm("word_bits_w2w", 1400 `!w h l. (h -- l) (w2w (w:'a word)):'b word = 1401 w2w ((MIN h (dimindex (:'b) - 1) -- l) w)`, 1402 Cases \\ SIMP_TAC arith_ss [word_bits_n2w,w2w_def,w2n_n2w,dimword_def] 1403 \\ STRIP_ASSUME_TAC EXISTS_HB 1404 \\ STRIP_ASSUME_TAC (Thm.INST_TYPE [alpha |-> beta] EXISTS_HB) 1405 \\ ASM_SIMP_TAC arith_ss [n2w_11,GSYM BITS_ZERO3,BITS_COMP_THM2, 1406 AC MIN_ASSOC MIN_COMM,ONCE_REWRITE_RULE [ADD_COMM] MIN_lem, 1407 MIN_lem2,dimword_def]) 1408 1409val word_reverse_n2w = Q.store_thm("word_reverse_n2w", 1410 `!n. word_reverse ((n2w n):'a word) = 1411 (n2w (BIT_REVERSE ^WL n)):'a word`, 1412 FIELD_WORD_TAC \\ ASM_SIMP_TAC arith_ss [BIT_REVERSE_THM]) 1413 1414val word_modify_n2w = Q.store_thm("word_modify_n2w", 1415 `!f n. word_modify f ((n2w n):'a word) = 1416 (n2w (BIT_MODIFY ^WL f n)):'a word`, 1417 FIELD_WORD_TAC \\ ASM_SIMP_TAC arith_ss [BIT_MODIFY_THM]) 1418 1419val fcp_n2w = Q.store_thm("fcp_n2w", 1420 `!f. $FCP f = word_modify (\i b. f i) 0w`, 1421 RW_TAC fcp_ss [word_modify_def]) 1422 1423val w2n_w2w = Q.store_thm("w2n_w2w", 1424 `!w:'a word. w2n ((w2w w):'b word) = 1425 if ^WL <= dimindex (:'b) then 1426 w2n w 1427 else 1428 w2n ((dimindex (:'b) - 1 -- 0) w)`, 1429 Cases 1430 \\ STRIP_ASSUME_TAC EXISTS_HB 1431 \\ STRIP_ASSUME_TAC (Thm.INST_TYPE [alpha |-> beta] EXISTS_HB) 1432 \\ ASM_SIMP_TAC arith_ss [BITS_COMP_THM2,w2w_def,word_bits_n2w, 1433 REWRITE_RULE [MOD_DIMINDEX,dimword_def] w2n_n2w] 1434 \\ RW_TAC arith_ss [MIN_DEF] 1435 \\ `m' = m` by DECIDE_TAC \\ ASM_REWRITE_TAC []) 1436 1437val w2n_w2w_le = Q.store_thm("w2n_w2w_le", 1438 `!w:'a word. w2n (w2w w) <= w2n w`, 1439 SRW_TAC [] [w2n_w2w] 1440 \\ Cases_on `w` 1441 \\ SRW_TAC [] [w2n_n2w, word_bits_n2w, MOD_DIMINDEX, MIN_DEF, BITS_COMP_THM2] 1442 \\ FULL_SIMP_TAC arith_ss 1443 [BITS_ZERO3,SUB1_SUC, DIMINDEX_GT_0, GSYM dimword_def] 1444 \\ Cases_on `n < dimword(:'b)` 1445 \\ SRW_TAC [] [] 1446 \\ `n MOD dimword (:'b) < dimword (:'b)` 1447 by SRW_TAC [] [DIMINDEX_GT_0, MOD_LESS] 1448 \\ DECIDE_TAC) 1449 1450val w2w_lt = Q.store_thm("w2w_lt", 1451 `!w:'a word. w2n (w2w w) < dimword(:'a)`, 1452 METIS_TAC [w2n_w2w_le, w2n_lt, LESS_EQ_LESS_TRANS]) 1453 1454val w2w_n2w = Q.store_thm("w2w_n2w", 1455 `!n. w2w ((n2w n):'a word):'b word = 1456 if dimindex (:'b) <= ^WL then 1457 n2w n 1458 else 1459 n2w (BITS (^WL - 1) 0 n)`, 1460 RW_TAC arith_ss [MIN_DEF,MOD_DIMINDEX,BITS_COMP_THM2,w2n_n2w,w2w_def,n2w_11, 1461 dimword_def]) 1462 1463val w2w_0 = Q.store_thm("w2w_0", 1464 `w2w 0w = 0w`, SRW_TAC [] [BITS_ZERO2, ZERO_LT_dimword, w2w_n2w]) 1465 1466val w2n_11_lift = Q.store_thm("w2n_11_lift", 1467 `!a:'a word b:'b word. 1468 dimindex (:'a) <= dimindex (:'c) /\ 1469 dimindex (:'b) <= dimindex (:'c) ==> 1470 ((w2n a = w2n b) = (w2w a = w2w b : 'c word))`, 1471 Cases \\ Cases 1472 \\ SRW_TAC [ARITH_ss] 1473 [dimindex_dimword_le_iso, w2n_n2w, w2w_n2w, BITS_ZEROL_DIMINDEX]) 1474 1475val word_extract_n2w = save_thm("word_extract_n2w", 1476 (SIMP_RULE std_ss [BITS_COMP_THM2, word_bits_n2w, w2w_n2w] o 1477 Q.SPECL [`h`,`l`,`n2w n`] o SIMP_RULE std_ss [FUN_EQ_THM]) word_extract_def) 1478 1479(* |- !h l n. h < dimindex (:'a) ==> (n2w (BITS h l n) = (h -- l) (n2w n)) *) 1480val n2w_BITS = save_thm("n2w_BITS", 1481 word_bits_n2w 1482 |> SPEC_ALL 1483 |> SYM 1484 |> Thm.DISCH ``h <= dimindex(:'a) - 1`` 1485 |> SIMP_RULE std_ss 1486 [MIN_FST, DECIDE ``0n < d ==> (h <= d - 1 = h < d)``, DIMINDEX_GT_0] 1487 |> Q.GEN `n` |> Q.GEN `l` |> Q.GEN `h`) 1488 1489val word_extract_w2w = Q.store_thm("word_extract_w2w", 1490 `!w:'a word h l. dimindex(:'a) <= dimindex(:'b) ==> 1491 ((h >< l) (w2w w : 'b word) = (h >< l) w : 'c word)`, 1492 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_extract_def, w2w, word_bits_def] 1493 \\ Cases_on `i < dimindex(:'a)` 1494 \\ Cases_on `i < dimindex(:'b)` 1495 \\ Cases_on `i + l < dimindex(:'a)` 1496 \\ Cases_on `i + l < dimindex(:'b)` 1497 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w]) 1498 1499val WORD_w2w_EXTRACT = Q.store_thm("WORD_w2w_EXTRACT", 1500 `!w:'a word. (w2w w):'b word = (dimindex(:'a) - 1 >< 0) w`, 1501 SRW_TAC [fcpLib.FCP_ss] [word_bits_def,word_extract_def, w2w] 1502 \\ Cases_on `i < dimindex (:'a)` 1503 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] []) 1504 1505val WORD_EQ = Q.store_thm("WORD_EQ", 1506 `!v:'a word w. (!x. x < ^WL ==> (word_bit x v = word_bit x w)) = (v = w)`, 1507 REPEAT Cases \\ FIELD_WORD_TAC) 1508 1509val BIT_UPDATE = Q.store_thm("BIT_UPDATE", 1510 `!n x. (n :+ x) = word_modify (\i b. if i = n then x else b)`, 1511 SIMP_TAC fcp_ss [FUN_EQ_THM,FCP_UPDATE_def,word_modify_def] 1512 \\ PROVE_TAC []) 1513 1514val WORD_MODIFY_BIT = Q.store_thm("WORD_MODIFY_BIT", 1515 `!f w:'a word i. i < dimindex(:'a) ==> ((word_modify f w) ' i = f i (w ' i))`, 1516 SRW_TAC [fcpLib.FCP_ss] [word_modify_def]) 1517 1518val TWO_EXP_DIMINDEX = Q.prove( 1519 `2 <= 2 ** ^WL`, 1520 METIS_TAC [EXP_BASE_LE_MONO, DECIDE ``1 < 2``, EXP_1, DIMINDEX_GE_1]) 1521 1522val lem = GEN_ALL (MATCH_MP LESS_LESS_EQ_TRANS (CONJ 1523 ((REWRITE_RULE [SUC_SUB,EXP_1] o Q.SPECL [`b`,`b`,`n`]) BITSLT_THM) 1524 TWO_EXP_DIMINDEX)) 1525 1526val lem2 = GEN_ALL (MATCH_MP LESS_LESS_EQ_TRANS (CONJ 1527 (DECIDE ``1 < 2``) TWO_EXP_DIMINDEX)) 1528 1529val WORD_BIT_BITS = Q.store_thm("WORD_BIT_BITS", 1530 `!b w. word_bit b w = ((b -- b) w = 1w)`, 1531 STRIP_TAC \\ Cases 1532 \\ RW_TAC arith_ss [MIN_DEF,BIT_def,word_bit_n2w,word_bits_n2w,n2w_11, 1533 LESS_MOD,lem,lem2,dimword_def] 1534 \\ STRIP_ASSUME_TAC EXISTS_HB 1535 \\ FULL_SIMP_TAC arith_ss [MIN_DEF,GSYM BITS_ZERO3,SUC_SUB1,BITS_COMP_THM2] 1536 \\ Cases_on `b = 0` \\ FULL_SIMP_TAC arith_ss [] 1537 >| [`m = 0` by DECIDE_TAC \\ ASM_REWRITE_TAC [], 1538 Cases_on `m = b` \\ ASM_SIMP_TAC arith_ss [BITS_ZERO]]) 1539 1540val lem = Q.prove(`MIN d (l1 + MIN h2 d) = MIN (h2 + l1) d`, 1541 RW_TAC arith_ss [MIN_DEF]) 1542 1543val WORD_BITS_COMP_THM = Q.store_thm("WORD_BITS_COMP_THM", 1544 `!h1 l1 h2 l2 w. (h2 -- l2) ((h1 -- l1) w) = 1545 ((MIN h1 (h2 + l1)) -- (l2 + l1)) w`, 1546 REPEAT STRIP_TAC \\ Cases_on `w` 1547 \\ RW_TAC arith_ss [word_bits_n2w,lem,BITS_COMP_THM2, 1548 AC MIN_ASSOC MIN_COMM]) 1549 1550val WORD_BITS_EXTRACT = Q.store_thm("WORD_BITS_EXTRACT", 1551 `!h l w. (h -- l) w = (h >< l) w`, 1552 SRW_TAC [fcpLib.FCP_ss] [word_bits_def, word_extract_def, w2w]) 1553 1554val WORD_BITS_LSR = Q.store_thm("WORD_BITS_LSR", 1555 `!h l w n. (h -- l) w >>> n = (h -- (l + n)) w`, 1556 FIELD_WORD_TAC \\ Cases_on `i + n < dimindex (:'a)` 1557 \\ ASM_SIMP_TAC (fcp_ss++ARITH_ss) []) 1558 1559val WORD_BITS_ZERO = Q.store_thm("WORD_BITS_ZERO", 1560 `!h l w. h < l ==> ((h -- l) w = 0w)`, 1561 NTAC 2 STRIP_TAC \\ Cases 1562 \\ RW_TAC arith_ss [word_bits_n2w,BITS_ZERO,MIN_DEF]) 1563 1564val WORD_BITS_ZERO2 = Q.store_thm("WORD_BITS_ZERO2", 1565 `!h l. (h -- l) 0w = 0w`, 1566 SIMP_TAC std_ss [word_bits_n2w, BITS_ZERO2]) 1567 1568val WORD_BITS_ZERO3 = Q.store_thm("WORD_BITS_ZERO3", 1569 `!h l w:'a word. dimindex(:'a) <= l ==> ((h -- l) w = 0w)`, 1570 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_bits_def, word_0]) 1571 1572val WORD_BITS_LT = Q.store_thm("WORD_BITS_LT", 1573 `!h l w. w2n ((h -- l) w) < 2 ** (SUC h - l)`, 1574 NTAC 2 STRIP_TAC \\ Cases 1575 \\ STRIP_ASSUME_TAC EXISTS_HB 1576 \\ RW_TAC arith_ss [word_bits_n2w,w2n_n2w,GSYM BITS_ZERO3, 1577 BITS_COMP_THM2,MIN_DEF,BITSLT_THM,dimword_def] 1578 \\ FULL_SIMP_TAC std_ss [] 1579 >| [`SUC m - l <= SUC h - l` by DECIDE_TAC, 1580 `SUC (l + m) - l <= SUC h - l` by DECIDE_TAC] 1581 \\ PROVE_TAC [TWOEXP_MONO2,BITSLT_THM,LESS_LESS_EQ_TRANS]) 1582 1583val WORD_EXTRACT_LT = Q.store_thm("WORD_EXTRACT_LT", 1584 `!h l w:'a word. w2n ((h >< l) w) < 2 ** (SUC h - l)`, 1585 SRW_TAC [] [word_extract_def] 1586 \\ METIS_TAC [w2w_lt, w2n_w2w_le, 1587 WORD_BITS_LT, LESS_EQ_LESS_TRANS, LESS_TRANS]) 1588 1589val WORD_EXTRACT_ZERO = Q.store_thm("WORD_EXTRACT_ZERO", 1590 `!h l w. h < l ==> ((h >< l) w = 0w)`, 1591 SRW_TAC [] [word_extract_def, WORD_BITS_ZERO, w2w_0]) 1592 1593val WORD_EXTRACT_ZERO2 = Q.store_thm("WORD_EXTRACT_ZERO2", 1594 `!h l. (h >< l) 0w = 0w`, 1595 SRW_TAC [] [word_extract_def, WORD_BITS_ZERO2, w2w_0]) 1596 1597val WORD_EXTRACT_ZERO3 = Q.store_thm("WORD_EXTRACT_ZERO3", 1598 `!h l w:'a word. dimindex (:'a) <= l ==> ((h >< l) w = 0w)`, 1599 SRW_TAC [] [word_extract_def, WORD_BITS_ZERO3, w2w_0]) 1600 1601val WORD_SLICE_THM = Q.store_thm("WORD_SLICE_THM", 1602 `!h l w. (h '' l) w = (h -- l) w << l`, 1603 FIELD_WORD_TAC \\ Cases_on `l <= i` \\ ASM_SIMP_TAC arith_ss []) 1604 1605val WORD_SLICE_ZERO = Q.store_thm("WORD_SLICE_ZERO", 1606 `!h l w. h < l ==> ((h '' l) w = 0w)`, 1607 NTAC 2 STRIP_TAC \\ Cases 1608 \\ RW_TAC arith_ss [word_slice_n2w,SLICE_ZERO,MIN_DEF]) 1609 1610val WORD_SLICE_ZERO2 = save_thm("WORD_SLICE_ZERO2", 1611 GEN_ALL (SIMP_CONV std_ss [word_slice_n2w, SLICE_ZERO2] ``(h '' l) 0w``)) 1612 1613val WORD_SLICE_BITS_THM = Q.store_thm("WORD_SLICE_BITS_THM", 1614 `!h w. (h '' 0) w = (h -- 0) w`, FIELD_WORD_TAC) 1615 1616val WORD_BITS_SLICE_THM = Q.store_thm("WORD_BITS_SLICE_THM", 1617 `!h l w. (h -- l) ((h '' l) w) = (h -- l) w`, 1618 NTAC 2 STRIP_TAC \\ Cases 1619 \\ RW_TAC arith_ss [word_slice_n2w,word_bits_n2w,BITS_SLICE_THM]) 1620 1621val WORD_SLICE_COMP_THM = Q.store_thm("WORD_SLICE_COMP_THM", 1622 `!h m' m l w:'a word. l <= m /\ (m' = m + 1) /\ m < h ==> 1623 (((h '' m') w):'a word || (m '' l) w = 1624 ((h '' l) w):'a word)`, 1625 FIELD_WORD_TAC \\ `i <= m \/ m + 1 <= i` by DECIDE_TAC 1626 \\ ASM_SIMP_TAC arith_ss []) 1627 1628val WORD_EXTRACT_COMP_THM = Q.store_thm("WORD_EXTRACT_COMP_THM", 1629 `!w:'c word h l m n. (h >< l) ((m >< n) w :'b word) = 1630 (MIN m (MIN (h + n) 1631 (MIN (dimindex(:'c) - 1) (dimindex(:'b) + n - 1))) >< l + n) w`, 1632 SRW_TAC [fcpLib.FCP_ss] [word_extract_def,word_bits_def,w2w,word_0] 1633 \\ Cases_on `i < dimindex (:'b)` 1634 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w] 1635 \\ Cases_on `i < dimindex (:'c)` 1636 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w] 1637 \\ Cases_on `i + l < dimindex (:'b)` 1638 \\ Cases_on `i + l < dimindex (:'c)` 1639 \\ Cases_on `i + (l + n) < dimindex (:'c)` 1640 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w] 1641 \\ FULL_SIMP_TAC bool_ss [NOT_LESS, NOT_LESS_EQUAL] 1642 >| [ 1643 METIS_TAC [DECIDE ``i + (l + n) <= h + n = i + l <= h:num``], 1644 `0 < i + l` by METIS_TAC [LESS_LESS_EQ_TRANS,DIMINDEX_GT_0] 1645 \\ ASM_SIMP_TAC arith_ss []]) 1646 1647val word_extract = (GSYM o SIMP_RULE std_ss [] o 1648 REWRITE_RULE [FUN_EQ_THM]) word_extract_def 1649 1650val WORD_EXTRACT_BITS_COMP = save_thm("WORD_EXTRACT_BITS_COMP", 1651 (GEN_ALL o SIMP_RULE std_ss [word_extract] o 1652 SIMP_CONV std_ss [word_extract_def,WORD_BITS_COMP_THM]) 1653 ``(j >< k) ((h -- l) n)``) 1654 1655val WORD_ALL_BITS = Q.store_thm("WORD_ALL_BITS", 1656 `!w:'a word h. (dimindex (:'a) - 1 <= h) ==> ((h -- 0) w = w)`, 1657 Cases 1658 \\ SRW_TAC [] [word_bits_n2w,GSYM MOD_DIMINDEX,DIVISION,DIMINDEX_GT_0, 1659 simpLib.SIMP_PROVE arith_ss [MIN_DEF] ``l <= h ==> (MIN h l = l)``]) 1660 1661val EXTRACT_ALL_BITS = Q.store_thm("EXTRACT_ALL_BITS", 1662 `!h w:'a word. dimindex (:'a) - 1 <= h ==> ((h >< 0) w = w2w w)`, 1663 SRW_TAC [] [word_extract_def, WORD_ALL_BITS]) 1664 1665val WORD_BITS_MIN_HIGH = Q.store_thm("WORD_BITS_MIN_HIGH", 1666 `!w:'a word h l. dimindex(:'a) - 1 < h ==> 1667 ((h -- l) w = (dimindex(:'a) - 1 -- l) w)`, 1668 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_bits_def] 1669 \\ Cases_on `i + l < dimindex(:'a)` 1670 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] []) 1671 1672val WORD_EXTRACT_MIN_HIGH = Q.store_thm("WORD_EXTRACT_MIN_HIGH", 1673 `(!h l w:'a word. 1674 dimindex (:'a) <= dimindex (:'b) + l /\ dimindex (:'a) <= h ==> 1675 (((h >< l) w):'b word = (dimindex (:'a) - 1 >< l) w)) /\ 1676 !h l w:'a word. 1677 dimindex (:'b) + l < dimindex (:'a) /\ dimindex (:'b) + l <= h ==> 1678 (((h >< l) w):'b word = (dimindex (:'b) + l - 1 >< l) w)`, 1679 SRW_TAC [fcpLib.FCP_ss] [word_bits_def,word_extract_def, w2w] 1680 \\ Cases_on `i < dimindex (:'a)` 1681 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [] 1682 \\ Cases_on `i + l < dimindex (:'a)` 1683 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] []) 1684 1685val CONCAT_EXTRACT = Q.store_thm("CONCAT_EXTRACT", 1686 `!h m l w:'a word. 1687 (h - m = dimindex(:'b)) /\ (m + 1 - l = dimindex(:'c)) /\ 1688 (h + 1 - l = dimindex (:'d)) /\ ~(dimindex(:'b + 'c) = 1) ==> 1689 (((h >< m + 1) w):'b word @@ ((m >< l) w):'c word = 1690 ((h >< l) w):'d word)`, 1691 SRW_TAC [boolSimps.LET_ss,ARITH_ss,fcpLib.FCP_ss] 1692 [DIMINDEX_GT_0,word_concat_def,word_extract_def,word_join_def, 1693 w2w,fcpTheory.index_sum,word_bits_def,word_or_def,word_lsl_def] 1694 \\ Q.PAT_X_ASSUM `~(x = 1)` (K ALL_TAC) 1695 \\ Cases_on `dimindex (:'c) <= i` 1696 \\ ASM_REWRITE_TAC [] \\ FULL_SIMP_TAC std_ss [NOT_LESS_EQUAL] 1697 \\ Cases_on `i < dimindex (:'a)` 1698 \\ SRW_TAC [ARITH_ss,fcpLib.FCP_ss] [DIMINDEX_GT_0,w2w] 1699 \\ FULL_SIMP_TAC arith_ss [DIMINDEX_GT_0,SUB_RIGHT_EQ,NOT_LESS, 1700 DECIDE ``0 < x ==> (a + (b + c) <= x + c - 1 = a + b <= x - 1)``] 1701 >| [ 1702 METIS_TAC [DIMINDEX_GT_0,NOT_ZERO_LT_ZERO], 1703 Cases_on `dimindex (:'a) + dimindex (:'c) <= i` 1704 \\ FULL_SIMP_TAC arith_ss [NOT_LESS_EQUAL] 1705 \\ `i - dimindex (:'c) < dimindex (:'a)` by DECIDE_TAC 1706 \\ SRW_TAC [ARITH_ss,fcpLib.FCP_ss] [DIMINDEX_GT_0]]) 1707 1708val EXTRACT_CONCAT = Q.store_thm("EXTRACT_CONCAT", 1709 `!v:'a word w:'b word. 1710 FINITE (UNIV:'a set) /\ FINITE (UNIV:'b set) /\ 1711 dimindex(:'a) + dimindex(:'b) <= dimindex(:'c) ==> 1712 ((dimindex(:'b) - 1 >< 0) 1713 ((v @@ w):'c word) = w) /\ 1714 ((dimindex(:'a) + dimindex(:'b) - 1 >< dimindex(:'b)) 1715 ((v @@ w):'c word) = v)`, 1716 SRW_TAC [fcpLib.FCP_ss, ARITH_ss, boolSimps.LET_ss] 1717 [word_concat_def, word_extract_def, word_bits_def, word_join_def, 1718 word_or_def, word_lsl_def, w2w, fcpTheory.index_sum]) 1719 1720val EXTRACT_JOIN = Q.store_thm("EXTRACT_JOIN", 1721 `!h m m' l s w:'a word. 1722 l <= m /\ m' <= h /\ (m' = m + 1) /\ (s = m' - l) ==> 1723 ((h >< m') w << s || (m >< l) w = 1724 (MIN h (MIN (dimindex(:'b) + l - 1) 1725 (dimindex(:'a) - 1)) >< l) w :'b word)`, 1726 SRW_TAC [fcpLib.FCP_ss] 1727 [word_extract_def, word_bits_def, word_or_def, word_lsl_def, w2w] 1728 \\ Cases_on `i < dimindex (:'a)` 1729 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 1730 [w2w, DIMINDEX_GT_0, NOT_LESS, NOT_LESS_EQUAL] 1731 >| [ 1732 Cases_on `i + l <= dimindex (:'a) - 1` 1733 \\ SRW_TAC [ARITH_ss] [] 1734 \\ Cases_on `m + 1 < i + l` 1735 \\ SRW_TAC [ARITH_ss] [] 1736 \\ Cases_on `m + 1 = i + l` 1737 \\ FULL_SIMP_TAC arith_ss [NOT_LESS], 1738 Cases_on `i + l < m + 1` 1739 \\ FULL_SIMP_TAC arith_ss [NOT_LESS] 1740 \\ Cases_on `m + (dimindex (:'a) + 1) <= i + l` 1741 \\ FULL_SIMP_TAC arith_ss [NOT_LESS_EQUAL] 1742 \\ `i + l - (m + 1) < dimindex (:'a)` by DECIDE_TAC 1743 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] []]) 1744 1745val EXTRACT_JOIN_ADD = Q.store_thm("EXTRACT_JOIN_ADD", 1746 `!h m m' l s w:'a word. 1747 l <= m /\ m' <= h /\ (m' = m + 1) /\ (s = m' - l) ==> 1748 ((h >< m') w << s + (m >< l) w = 1749 (MIN h (MIN (dimindex(:'b) + l - 1) 1750 (dimindex(:'a) - 1)) >< l) w :'b word)`, 1751 REPEAT STRIP_TAC 1752 \\ `(h >< m') w << s + (m >< l) w = (h >< m') w << s || (m >< l) w` 1753 by (MATCH_MP_TAC WORD_ADD_OR 1754 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 1755 [word_extract_def, word_bits_def, word_lsl_def, word_and_def, 1756 word_0, w2w, DIMINDEX_GT_0] 1757 \\ Cases_on `i < dimindex (:'a)` 1758 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [] 1759 \\ Cases_on `m + 1 <= i + l` 1760 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] []) 1761 \\ ASM_SIMP_TAC std_ss [EXTRACT_JOIN]) 1762 1763val EXTEND_EXTRACT = Q.store_thm("EXTEND_EXTRACT", 1764 `!h l w : 'a word. 1765 (dimindex(:'c) = h + 1 - l) ==> 1766 ((h >< l) w : 'b word = w2w ((h >< l) w : 'c word))`, 1767 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_extract_def, word_bits_def, w2w] 1768 \\ Cases_on `i < dimindex(:'c)` 1769 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w] 1770 \\ Cases_on `i < dimindex(:'a)` 1771 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [w2w]) 1772 1773val WORD_SLICE_OVER_BITWISE = Q.store_thm("WORD_SLICE_OVER_BITWISE", 1774 `(!h l v:'a word w:'a word. 1775 (h '' l) v && (h '' l) w = (h '' l) (v && w)) /\ 1776 (!h l v:'a word w:'a word. 1777 (h '' l) v || (h '' l) w = (h '' l) (v || w)) /\ 1778 (!h l v:'a word w:'a word. 1779 (h '' l) v ?? (h '' l) w = (h '' l) (v ?? w))`, 1780 FIELD_WORD_TAC >| [PROVE_TAC [], PROVE_TAC [], ALL_TAC] 1781 \\ Cases_on `l <= i /\ i <= h` \\ FULL_SIMP_TAC arith_ss []) 1782 1783val WORD_BITS_OVER_BITWISE = Q.store_thm("WORD_BITS_OVER_BITWISE", 1784 `(!h l v:'a word w:'a word. 1785 (h -- l) v && (h -- l) w = (h -- l) (v && w)) /\ 1786 (!h l v:'a word w:'a word. 1787 (h -- l) v || (h -- l) w = (h -- l) (v || w)) /\ 1788 (!h l v:'a word w:'a word. 1789 (h -- l) v ?? (h -- l) w = (h -- l) (v ?? w))`, 1790 FIELD_WORD_TAC 1791 \\ Cases_on `i + l <= h /\ i + l <= dimindex (:'a) - 1` 1792 \\ FULL_SIMP_TAC (fcp_ss++ARITH_ss) []) 1793 1794val WORD_w2w_OVER_BITWISE = Q.store_thm("WORD_w2w_OVER_BITWISE", 1795 `(!v:'a word w:'a word. w2w v && w2w w = w2w (v && w):'b word) /\ 1796 (!v:'a word w:'a word. w2w v || w2w w = w2w (v || w):'b word) /\ 1797 (!v:'a word w:'a word. w2w v ?? w2w w = w2w (v ?? w):'b word)`, 1798 FIELD_WORD_TAC 1799 \\ Cases_on `i < dimindex (:'a)` 1800 \\ FULL_SIMP_TAC (fcp_ss++ARITH_ss) []) 1801 1802val WORD_EXTRACT_OVER_BITWISE = Q.store_thm("WORD_EXTRACT_OVER_BITWISE", 1803 `(!h l v:'a word w:'a word. 1804 (h >< l) v && (h >< l) w = (h >< l) (v && w)) /\ 1805 (!h l v:'a word w:'a word. 1806 (h >< l) v || (h >< l) w = (h >< l) (v || w)) /\ 1807 (!h l v:'a word w:'a word. 1808 (h >< l) v ?? (h >< l) w = (h >< l) (v ?? w))`, 1809 SIMP_TAC std_ss 1810 [word_extract_def, GSYM WORD_BITS_OVER_BITWISE, WORD_w2w_OVER_BITWISE]) 1811 1812val EXTRACT_OVER_ADD_lem = Q.prove( 1813 `!h1 h2 a b. 1814 h1 <= h2 ==> 1815 (BITS h1 0 (BITS h2 0 a + BITS h2 0 b) = BITS h1 0 (a + b))`, 1816 REPEAT STRIP_TAC 1817 \\ Q.SPEC_THEN `h1` (fn thm => ONCE_REWRITE_TAC [GSYM thm]) BITS_SUM3 1818 \\ SRW_TAC [ARITH_ss] [BITS_COMP_THM2, MIN_DEF]) 1819 1820val EXTRACT_OVER_MUL_lem = Q.prove( 1821 `!h1 h2 a b. 1822 h1 <= h2 ==> 1823 (BITS h1 0 (BITS h2 0 a * BITS h2 0 b) = BITS h1 0 (a * b))`, 1824 REPEAT STRIP_TAC 1825 \\ Q.SPEC_THEN `h1` (fn thm => ONCE_REWRITE_TAC [GSYM thm]) BITS_MUL 1826 \\ SRW_TAC [ARITH_ss] [BITS_COMP_THM2, MIN_DEF]) 1827 1828val tac = 1829 REPEAT STRIP_TAC 1830 \\ Cases_on `a:'a word` 1831 \\ Cases_on `b:'a word` 1832 \\ `n < 2 ** SUC (dimindex (:'a) - 1) /\ n' < 2 ** SUC (dimindex (:'a) - 1)` 1833 by FULL_SIMP_TAC arith_ss [dimword_def,DIMINDEX_GT_0, SUB1_SUC] 1834 \\ SRW_TAC [ARITH_ss] [WORD_w2w_EXTRACT, word_extract_n2w, word_bits_n2w, 1835 MOD_DIMINDEX, BITS_COMP_THM2, MIN_DEF, BITS_ZEROL, WORD_BITS_EXTRACT] 1836 \\ SRW_TAC [ARITH_ss] [word_add_n2w, word_mul_n2w, word_extract_n2w, 1837 MOD_DIMINDEX, BITS_COMP_THM2] 1838 \\ SRW_TAC [ARITH_ss] [MIN_DEF, EXTRACT_OVER_ADD_lem, EXTRACT_OVER_MUL_lem] 1839 1840val WORD_w2w_OVER_ADD = Q.store_thm("WORD_w2w_OVER_ADD", 1841 `!a b:'a word. (w2w (a + b) = (dimindex(:'a) - 1 -- 0) (w2w a + w2w b))`, 1842 tac) 1843 1844val WORD_w2w_OVER_MUL = Q.store_thm("WORD_w2w_OVER_MUL", 1845 `!a b:'a word. (w2w (a * b) = (dimindex(:'a) - 1 -- 0) (w2w a * w2w b))`, 1846 tac) 1847 1848val WORD_EXTRACT_OVER_ADD = Q.store_thm("WORD_EXTRACT_OVER_ADD", 1849 `!a b:'a word h. 1850 dimindex(:'b) - 1 <= h /\ dimindex(:'b) <= dimindex(:'a) ==> 1851 ((h >< 0) (a + b) = (h >< 0) a + (h >< 0) b : 'b word)`, 1852 tac) 1853 1854val WORD_EXTRACT_OVER_MUL = Q.store_thm("WORD_EXTRACT_OVER_MUL", 1855 `!a b:'a word h. 1856 dimindex(:'b) - 1 <= h /\ dimindex(:'b) <= dimindex(:'a) ==> 1857 ((h >< 0) (a * b) = (h >< 0) a * (h >< 0) b : 'b word)`, 1858 tac) 1859 1860val WORD_EXTRACT_OVER_ADD2 = Q.store_thm("WORD_EXTRACT_OVER_ADD2", 1861 `!a b:'a word h. 1862 h < dimindex(:'a) ==> 1863 ((h >< 0) (((h >< 0) a + (h >< 0) b) : 'b word) = 1864 (h >< 0) (a + b) :'b word)`, 1865 tac \\ `dimindex(:'a) - 1 = h` by DECIDE_TAC \\ SRW_TAC [] []) 1866 1867val WORD_EXTRACT_OVER_MUL2 = Q.store_thm("WORD_EXTRACT_OVER_MUL2", 1868 `!a b:'a word h. 1869 h < dimindex(:'a) ==> 1870 ((h >< 0) (((h >< 0) a * (h >< 0) b) :'b word) = 1871 (h >< 0) (a * b) :'b word)`, 1872 tac \\ `dimindex(:'a) - 1 = h` by DECIDE_TAC \\ SRW_TAC [] []) 1873 1874val WORD_EXTRACT_ID = Q.store_thm("WORD_EXTRACT_ID", 1875 `!w:'a word h. w2n w < 2 ** SUC h ==> ((h >< 0) w = w)`, 1876 Cases 1877 \\ `n < 2 ** SUC (dimindex (:'a) - 1)` 1878 by FULL_SIMP_TAC arith_ss [dimword_def,DIMINDEX_GT_0, SUB1_SUC] 1879 \\ SRW_TAC [] [w2w_n2w, word_extract_n2w, word_bits_n2w, 1880 BITS_COMP_THM2, MOD_DIMINDEX, MIN_DEF, BITS_ZEROL] 1881 \\ FULL_SIMP_TAC arith_ss [BITS_ZEROL] 1882 \\ METIS_TAC 1883 [prim_recTheory.LESS_SUC_REFL, TWOEXP_MONO, LESS_TRANS, BITS_ZEROL]) 1884 1885val BIT_SET_lem_ = Q.prove( 1886 `!i j n. i < j ==> ~(i IN BIT_SET j n)`, 1887 completeInduct_on `n` \\ ONCE_REWRITE_TAC [BIT_SET_def] 1888 \\ SRW_TAC [ARITH_ss] []) 1889 1890val BIT_SET_lem = Q.prove( 1891 `!k i n. BIT i n = i + k IN BIT_SET k n`, 1892 Induct_on `i` \\ ONCE_REWRITE_TAC [BIT_SET_def] 1893 \\ SRW_TAC [] [BIT_ZERO, BIT0_ODD, BIT_SET_lem_] 1894 \\ REWRITE_TAC [DECIDE ``SUC a + b = a + SUC b``] 1895 \\ Q.PAT_X_ASSUM `!k n. BIT i n = i + k IN BIT_SET k n` 1896 (fn th => REWRITE_TAC [GSYM th, BIT_DIV2])) 1897 1898val BIT_SET = save_thm("BIT_SET", 1899 (REWRITE_RULE [ADD_0] o Q.SPEC `0`) BIT_SET_lem) 1900 1901val lem = Q.prove( 1902 `!i a b. MAX (LOG2 a) (LOG2 b) < i ==> ~BIT i a /\ ~BIT i b`, 1903 SRW_TAC [ARITH_ss] [NOT_BIT_GT_LOG2]) 1904 1905val lem2 = Q.prove( 1906 `!i a b. MIN (LOG2 a) (LOG2 b) < i ==> ~BIT i a \/ ~BIT i b`, 1907 NTAC 2 (SRW_TAC [ARITH_ss] [NOT_BIT_GT_LOG2])) 1908 1909val bitwise_log_max = Q.prove( 1910 `!op i l a b. ~(op F F) /\ i < l ==> 1911 (BIT i (BITWISE l op a b) = 1912 BIT i (BITWISE (SUC (MAX (LOG2 a) (LOG2 b))) op a b))`, 1913 REPEAT STRIP_TAC 1914 \\ Cases_on `l <= SUC (MAX (LOG2 a) (LOG2 b))` 1915 \\ SRW_TAC [ARITH_ss] [BITWISE_THM] 1916 \\ Cases_on `i < SUC (MAX (LOG2 a) (LOG2 b))` 1917 >- ASM_SIMP_TAC std_ss [BITWISE_THM] 1918 \\ FULL_SIMP_TAC pure_ss [NOT_LESS_EQUAL,NOT_LESS,NOT_BIT_GT_BITWISE] 1919 \\ `MAX (LOG2 a) (LOG2 b) < i` by DECIDE_TAC 1920 \\ IMP_RES_TAC lem \\ ASM_SIMP_TAC std_ss []) 1921 1922val bitwise_log_min = Q.prove( 1923 `!op i l a b. (!x. ~(op x F) /\ ~(op F x)) /\ i < l ==> 1924 (BIT i (BITWISE l op a b) = 1925 BIT i (BITWISE (SUC (MIN (LOG2 a) (LOG2 b))) op a b))`, 1926 REPEAT STRIP_TAC 1927 \\ Cases_on `l <= SUC (MIN (LOG2 a) (LOG2 b))` 1928 \\ SRW_TAC [ARITH_ss] [BITWISE_THM] 1929 \\ Cases_on `i < SUC (MIN (LOG2 a) (LOG2 b))` 1930 >- ASM_SIMP_TAC std_ss [BITWISE_THM] 1931 \\ FULL_SIMP_TAC pure_ss [NOT_LESS_EQUAL,NOT_LESS,NOT_BIT_GT_BITWISE] 1932 \\ `MIN (LOG2 a) (LOG2 b) < i` by DECIDE_TAC 1933 \\ IMP_RES_TAC lem2 \\ ASM_SIMP_TAC std_ss []) 1934 1935val bitwise_log_left = Q.prove( 1936 `!op i l a b. (!x. ~(op F x)) /\ i < l ==> 1937 (BIT i (BITWISE l op a b) = 1938 BIT i (BITWISE (SUC (LOG2 a)) op a b))`, 1939 REPEAT STRIP_TAC 1940 \\ Cases_on `l <= SUC (LOG2 a)` 1941 \\ SRW_TAC [ARITH_ss] [BITWISE_THM] 1942 \\ Cases_on `i < SUC (LOG2 a)` 1943 >- ASM_SIMP_TAC std_ss [BITWISE_THM] 1944 \\ FULL_SIMP_TAC pure_ss [NOT_LESS_EQUAL,NOT_LESS,NOT_BIT_GT_BITWISE] 1945 \\ `LOG2 a < i` by DECIDE_TAC 1946 \\ IMP_RES_TAC NOT_BIT_GT_LOG2 \\ ASM_SIMP_TAC std_ss []) 1947 1948val word_or_n2w_alpha = Q.prove( 1949 `!n m. n2w n || n2w m = n2w (BITWISE (SUC (MAX (LOG2 n) (LOG2 m))) $\/ n m)`, 1950 RW_TAC arith_ss [word_or_n2w, GSYM WORD_EQ, word_bit_n2w, bitwise_log_max]) 1951 1952val word_and_n2w_alpha = Q.prove( 1953 `!n m. n2w n && n2w m = n2w (BITWISE (SUC (MIN (LOG2 n) (LOG2 m))) $/\ n m)`, 1954 RW_TAC arith_ss [word_and_n2w, GSYM WORD_EQ, word_bit_n2w, bitwise_log_min]) 1955 1956val lem = Q.prove( 1957 `!n m. n2w n && ~(n2w m) : 'a word = 1958 n2w (BITWISE (dimindex(:'a)) (\x y. x /\ ~y) n m)`, 1959 SRW_TAC [fcpLib.FCP_ss] [word_and_def, word_1comp_def, n2w_def, BITWISE_THM]) 1960 1961val word_and_1comp_n2w_alpha = Q.prove( 1962 `!n m. n2w n && ~(n2w m) = 1963 n2w (BITWISE (SUC (LOG2 n)) (\a b. a /\ ~b) n m)`, 1964 RW_TAC arith_ss [lem, GSYM WORD_EQ, word_bit_n2w, bitwise_log_left]) 1965 1966val word_and_1comp_n2w_alpha2 = Q.prove( 1967 `!n m. ~(n2w n) && ~(n2w m) = 1968 ~(n2w (BITWISE (SUC (MAX (LOG2 n) (LOG2 m))) $\/ n m))`, 1969 RW_TAC std_ss [GSYM WORD_DE_MORGAN_THM, word_or_n2w_alpha]) 1970 1971val word_or_1comp_n2w_alpha = Q.prove( 1972 `!n m. n2w n || ~(n2w m) = 1973 ~(n2w (BITWISE (SUC (LOG2 m)) (\a b. a /\ ~b) m n))`, 1974 RW_TAC std_ss [word_and_1comp_n2w_alpha, 1975 PROVE [WORD_NOT_NOT, WORD_DE_MORGAN_THM, WORD_AND_COMM] 1976 ``a || ~b = ~(b && ~a)``]) 1977 1978val word_or_1comp_n2w_alpha2 = Q.prove( 1979 `!n m. ~(n2w n) || ~(n2w m) = 1980 ~(n2w (BITWISE (SUC (MIN (LOG2 n) (LOG2 m))) $/\ n m))`, 1981 RW_TAC std_ss [GSYM WORD_DE_MORGAN_THM, word_and_n2w_alpha]) 1982 1983val WORD_LITERAL_AND = save_thm("WORD_LITERAL_AND", 1984 LIST_CONJ 1985 [word_and_n2w_alpha, word_and_1comp_n2w_alpha, 1986 ONCE_REWRITE_RULE [WORD_AND_COMM] word_and_1comp_n2w_alpha, 1987 word_and_1comp_n2w_alpha2]) 1988 1989val WORD_LITERAL_OR = save_thm("WORD_LITERAL_OR", 1990 LIST_CONJ 1991 [word_or_n2w_alpha, word_or_1comp_n2w_alpha, 1992 ONCE_REWRITE_RULE [WORD_OR_COMM] word_or_1comp_n2w_alpha, 1993 word_or_1comp_n2w_alpha2]) 1994 1995val WORD_LITERAL_XOR = Q.store_thm("WORD_LITERAL_XOR", 1996 `!n m. n2w n ?? n2w m = 1997 n2w (BITWISE (SUC (MAX (LOG2 n) (LOG2 m))) (\x y. ~(x = y)) n m)`, 1998 RW_TAC arith_ss [word_xor_n2w, GSYM WORD_EQ, word_bit_n2w, bitwise_log_max]) 1999 2000val SNOC_GENLIST_K = Q.prove( 2001 `!n c. SNOC c (GENLIST (K c) n) = c::(GENLIST (K c) n)`, 2002 Induct \\ FULL_SIMP_TAC (srw_ss()) [rich_listTheory.GENLIST, listTheory.SNOC] 2003) 2004 2005val word_replicate_concat_word_list = Q.store_thm 2006 ("word_replicate_concat_word_list", 2007 `!n w. word_replicate n w = concat_word_list (GENLIST (K w) n)`, 2008 Induct 2009 \\ SRW_TAC [] [word_replicate_def, concat_word_list_def, 2010 rich_listTheory.GENLIST, SNOC_GENLIST_K] 2011 >- SRW_TAC [fcpLib.FCP_ss] [word_0] 2012 \\ POP_ASSUM (fn th => REWRITE_TAC [GSYM th]) 2013 \\ SRW_TAC [fcpLib.FCP_ss,ARITH_ss] 2014 [word_replicate_def, word_or_def, word_lsl_def, w2w] 2015 \\ ASSUME_TAC DIMINDEX_GT_0 2016 \\ Q.ABBREV_TAC `A = dimindex(:'a)` 2017 \\ Cases_on `i < A` \\ SRW_TAC [ARITH_ss] [MULT_SUC] 2018 \\ `?x. i = x + A` by METIS_TAC [NOT_LESS, LESS_EQ_ADD_EXISTS, ADD_COMM] 2019 \\ SRW_TAC [ARITH_ss] [ADD_MODULUS_RIGHT] 2020 \\ Cases_on `n` \\ SRW_TAC [ARITH_ss] [ZERO_LESS_MULT]) 2021 2022val bit_field_insert = Q.store_thm("bit_field_insert", 2023 `!h l (a:'a word) (b:'b word). 2024 h < l + dimindex(:'a) ==> 2025 (bit_field_insert h l a b = 2026 let mask = (h '' l) (-1w) in 2027 (w2w a << l) && mask || b && ~mask)`, 2028 SRW_TAC [fcpLib.FCP_ss, boolSimps.LET_ss, ARITH_ss] 2029 [bit_field_insert_def, word_modify_def, word_lsl_def, w2w, 2030 word_slice_def, word_and_def, word_or_def, word_1comp_def, 2031 WORD_NEG_1_T] 2032 \\ SRW_TAC [ARITH_ss] []) 2033 2034val word_join_index = Q.store_thm("word_join_index", 2035 `!i (a:'a word) (b:'b word). 2036 FINITE univ(:'a) /\ FINITE univ(:'b) /\ i < dimindex(:'a + 'b) ==> 2037 ((word_join a b) ' i = 2038 if i < dimindex(:'b) then 2039 b ' i 2040 else 2041 a ' (i - dimindex (:'b)))`, 2042 SRW_TAC [fcpLib.FCP_ss, boolSimps.LET_ss, ARITH_ss] 2043 [word_join_def, word_or_def, word_lsl_def, w2w, fcpTheory.index_sum] 2044 \\ `i = 0` by DECIDE_TAC 2045 \\ FULL_SIMP_TAC (srw_ss()) []) 2046 2047(* ------------------------------------------------------------------------- 2048 Reduce operations : theorems 2049 ------------------------------------------------------------------------- *) 2050 2051val genlist_dimindex_not_null = Q.prove( 2052 `!f. ~NULL (GENLIST f (dimindex(:'a)))`, 2053 SRW_TAC [ARITH_ss] [listTheory.NULL_GENLIST, DECIDE ``0 < n ==> (n <> 0n)``]) 2054 2055fun mk_word_reduce_thm (name,f,thm1,thm2,g,h) = 2056let 2057 val lem = Q.prove( 2058 `!l b. 2059 ((FOLDL ^g b l) : unit word) ' 0 = 2060 FOLDL ^h (b ' 0) (MAP (\x. x ' 0) l)`, 2061 Induct \\ SRW_TAC [fcpLib.FCP_ss] [thm1] 2062 ) 2063in 2064 Q.store_thm(name, 2065 `!w:'a word. 2066 ^f w = 2067 let l = GENLIST 2068 (\i. let n = dimindex(:'a) - 1 - i in (n >< n) w : unit word) 2069 (dimindex(:'a)) 2070 in 2071 FOLDL ^g (HD l) (TL l)`, 2072 SRW_TAC [boolSimps.LET_ss, fcpLib.FCP_ss] 2073 [fcpTheory.index_one, word_reduce_def, thm2] 2074 \\ `i = 0` by DECIDE_TAC 2075 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 2076 [lem, listTheory.MAP_GENLIST, listTheory.HD_GENLIST_COR, 2077 listTheory.MAP_TL, genlist_dimindex_not_null, word_extract_def, 2078 word_bits_def, w2w] 2079 \\ MATCH_MP_TAC (METIS_PROVE [] 2080 ``(l1 = l2) ==> (FOLDL f b (TL l1) = FOLDL f b (TL l2))``) 2081 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [listTheory.GENLIST_FUN_EQ, w2w] 2082 ) 2083end 2084 2085val mk_word_reduce_thms = 2086 List.map mk_word_reduce_thm 2087 [("foldl_reduce_and", ``$reduce_and``, word_and_def, reduce_and_def, 2088 ``(&&):unit word->unit word->unit word``, ``(/\)``), 2089 ("foldl_reduce_or", ``$reduce_or``, word_or_def, reduce_or_def, 2090 ``(||):unit word->unit word->unit word``, ``(\/)``), 2091 ("foldl_reduce_xor", ``$reduce_xor``, word_xor_def, reduce_xor_def, 2092 ``(??):unit word->unit word->unit word``, ``(<>):bool->bool->bool``), 2093 ("foldl_reduce_nand", ``$reduce_nand``, word_nand_def, reduce_nand_def, 2094 ``word_nand:unit word->unit word->unit word``, ``(\a b. ~(a /\ b))``), 2095 ("foldl_reduce_nor", ``$reduce_nor``, word_nor_def, reduce_nor_def, 2096 ``word_nor:unit word->unit word->unit word``, ``(\a b. ~(a \/ b))``), 2097 ("foldl_reduce_xnor", ``$reduce_xnor``, word_xnor_def, reduce_xnor_def, 2098 ``word_xnor:unit word->unit word->unit word``, ``(=):bool->bool->bool``)] 2099 2100(* ......................................................................... *) 2101 2102(* |- !w. w <> 0w ==> LOG2 (w2n w) < dimindex (:'a) *) 2103val LOG2_w2n_lt = save_thm("LOG2_w2n_lt", 2104 bitTheory.LT_TWOEXP 2105 |> Q.SPECL [`w2n (w : 'a word)`, `dimindex(:'a)`] 2106 |> SIMP_RULE std_ss [GSYM dimword_def, w2n_lt, w2n_eq_0] 2107 |> Q.DISCH `w <> 0w` 2108 |> SIMP_RULE std_ss [] 2109 |> Q.GEN `w`) 2110 2111val LOG2_w2n = Q.store_thm("LOG2_w2n", 2112 `!w:'a word. 2113 w <> 0w ==> 2114 (LOG2 (w2n w) = dimindex(:'a) - 1 - LEAST i. w ' (dimindex(:'a) - 1 - i))`, 2115 Cases \\ STRIP_TAC 2116 \\ MATCH_MP_TAC bitTheory.LOG2_UNIQUE 2117 \\ FULL_SIMP_TAC (srw_ss()) [] 2118 \\ numLib.LEAST_ELIM_TAC 2119 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_index, BIT_IMP_GE_TWOEXP] 2120 >| [ 2121 SPOSE_NOT_THEN STRIP_ASSUME_TAC 2122 \\ `!i. i <= dimindex (:'a) - 1 ==> ~BIT i n` 2123 by (SRW_TAC [] [] 2124 \\ Q.PAT_X_ASSUM `!n. P` (Q.SPEC_THEN `dimindex(:'a) - i - 1` MP_TAC) 2125 \\ ASM_SIMP_TAC arith_ss []) 2126 \\ FULL_SIMP_TAC (srw_ss()) [MOD_DIMINDEX, BITS_ZERO5], 2127 SPOSE_NOT_THEN (STRIP_ASSUME_TAC o SIMP_RULE std_ss [NOT_LESS]) 2128 \\ Cases_on `n = 0` 2129 \\ FULL_SIMP_TAC std_ss [dimword_def] 2130 \\ `?i. SUC (dimindex (:'a) - (n' + 1)) <= i /\ i < dimindex(:'a) /\ 2131 BIT i n` 2132 by METIS_TAC [EXISTS_BIT_IN_RANGE] 2133 \\ Q.PAT_X_ASSUM `!m. P` (Q.SPEC_THEN `dimindex(:'a) - i - 1` MP_TAC) 2134 \\ SRW_TAC [ARITH_ss] [] 2135 ]) 2136 2137val LEAST_BIT_LT = Q.store_thm("LEAST_BIT_LT", 2138 `!w:'a word. w <> 0w ==> (LEAST i. w ' i) < dimindex(:'a)`, 2139 Cases \\ SRW_TAC [] [] 2140 \\ numLib.LEAST_ELIM_TAC 2141 \\ FULL_SIMP_TAC std_ss [dimword_def] 2142 \\ `?i. i < dimindex(:'a) /\ BIT i n` by METIS_TAC [EXISTS_BIT_LT] 2143 \\ SRW_TAC [] [] 2144 THEN1 METIS_TAC [word_index] 2145 \\ SPOSE_NOT_THEN (ASSUME_TAC o SIMP_RULE std_ss [NOT_LESS]) 2146 \\ `i < n'` by DECIDE_TAC 2147 \\ Q.PAT_X_ASSUM `!m. P` (Q.SPEC_THEN `i` IMP_RES_TAC) 2148 \\ POP_ASSUM MP_TAC 2149 \\ ASM_SIMP_TAC std_ss [word_index]) 2150 2151(* ------------------------------------------------------------------------- 2152 Word reduction: theorems 2153 ------------------------------------------------------------------------- *) 2154 2155val BOOLIFY = Q.prove( 2156 `!n m a. GENLIST (\i. BIT (n - 1 - i) (BITS (n - 1) 0 m)) n ++ a = 2157 BOOLIFY n m a`, 2158 Induct 2159 \\ SRW_TAC [] 2160 [BOOLIFY_def, DIV2_def, rich_listTheory.GENLIST, 2161 rich_listTheory.APPEND_SNOC1] 2162 \\ POP_ASSUM (fn thm => REWRITE_TAC [GSYM thm]) 2163 \\ SRW_TAC [ARITH_ss] [BIT0_ODD, BIT_OF_BITS_THM, 2164 rich_listTheory.GENLIST_FUN_EQ, BIT_DIV2, 2165 DECIDE ``x < n ==> (n - x = SUC (n - 1 - x))``]) 2166 2167val GENLIST_FCP_INDEX = Q.prove( 2168 `!n. 2169 GENLIST (\i. (n2w n : 'a word) ' (dimindex(:'a) - 1 - i)) (dimindex(:'a)) = 2170 GENLIST (\i. BIT (dimindex(:'a) - 1 - i) (n MOD dimword(:'a))) 2171 (dimindex(:'a))`, 2172 SRW_TAC [ARITH_ss] 2173 [rich_listTheory.GENLIST_FUN_EQ, BIT_OF_BITS_THM, 2174 MOD_DIMINDEX, word_index]) 2175 2176val word_reduce_n2w = save_thm("word_reduce_n2w", 2177 word_reduce_def 2178 |> Q.SPECL [`f`,`n2w n`] 2179 |> REWRITE_RULE 2180 [BOOLIFY |> Q.SPECL [`dimindex(:'a)`,`n`,`[]`] 2181 |> SIMP_RULE (srw_ss()) [GSYM MOD_DIMINDEX, 2182 GSYM GENLIST_FCP_INDEX]] 2183 |> GEN_ALL) 2184 2185val GENLIST_UINT_MAXw = Q.prove( 2186 `GENLIST (\i. (UINT_MAXw:'a word) ' (dimindex(:'a) - 1 - i)) (dimindex(:'a)) = 2187 GENLIST (K T) (dimindex(:'a))`, 2188 SRW_TAC [ARITH_ss] [rich_listTheory.GENLIST_FUN_EQ, word_T]) 2189 2190val GENLIST_0w = Q.prove( 2191 `GENLIST (\i. (0w:'a word) ' (dimindex(:'a) - 1 - i)) (dimindex(:'a)) = 2192 GENLIST (K F) (dimindex(:'a))`, 2193 SRW_TAC [ARITH_ss] [rich_listTheory.GENLIST_FUN_EQ, word_0]) 2194 2195val WORD_REDUCE_LIFT = Q.prove( 2196 `(!b. ($FCP (K b) = 1w: 1 word) = b) /\ 2197 !b. ($FCP (K b) = 0w: 1 word) = ~b`, 2198 STRIP_TAC \\ Cases 2199 \\ SRW_TAC [fcpLib.FCP_ss] 2200 [DECIDE ``i < 1 = (i = 0)``, n2w_def, BIT_ZERO, fcpTheory.index_one, 2201 BIT0_ODD]) 2202 2203val TL_GENLIST_K = Q.prove( 2204 `!c n. TL (GENLIST (K c) (SUC n)) = GENLIST (K c) n`, 2205 REPEAT STRIP_TAC \\ MATCH_MP_TAC listTheory.LIST_EQ 2206 \\ SRW_TAC [listSimps.LIST_ss] 2207 [rich_listTheory.EL_GENLIST, rich_listTheory.LENGTH_GENLIST, 2208 listTheory.LENGTH_TL] 2209 \\ ONCE_REWRITE_TAC [rich_listTheory.EL |> CONJUNCT2 |> GSYM] 2210 \\ `SUC x < SUC n` by DECIDE_TAC 2211 \\ IMP_RES_TAC rich_listTheory.EL_GENLIST 2212 \\ ASM_SIMP_TAC std_ss []) 2213 2214val NOT_EVERY_HD_F = Q.prove( 2215 `!l. ~(FOLDL (/\) F l)`, Induct \\ SRW_TAC [listSimps.LIST_ss] []) 2216 2217val EXISTS_HD_T = Q.prove( 2218 `!l. (FOLDL (\/) T l)`, Induct \\ SRW_TAC [listSimps.LIST_ss] []) 2219 2220val NOT_UINTMAXw = Q.store_thm ("NOT_UINTMAXw", 2221 `!w:'a word. w <> UINT_MAXw ==> ?i. i < dimindex(:'a) /\ ~(w ' i)`, 2222 STRIP_TAC \\ SPOSE_NOT_THEN STRIP_ASSUME_TAC 2223 \\ Q.PAT_X_ASSUM `a <> b` MP_TAC 2224 \\ SRW_TAC [fcpLib.FCP_ss] [word_T]) 2225 2226val NOT_0w = Q.store_thm ("NOT_0w", 2227 `!w:'a word. w <> 0w ==> ?i. i < dimindex(:'a) /\ w ' i`, 2228 STRIP_TAC \\ SPOSE_NOT_THEN STRIP_ASSUME_TAC 2229 \\ Q.PAT_X_ASSUM `a <> b` MP_TAC 2230 \\ SRW_TAC [fcpLib.FCP_ss] [word_0]) 2231 2232val reduce_and = Q.store_thm ("reduce_and", 2233 `!w. reduce_and w = if w = UINT_MAXw then 1w else 0w`, 2234 SRW_TAC [boolSimps.LET_ss] 2235 [GENLIST_UINT_MAXw, WORD_REDUCE_LIFT, reduce_and_def, word_reduce_def] 2236 \\ (Cases_on `dimindex (:'a)` >- 2237 FULL_SIMP_TAC bool_ss [DECIDE ``0 < a ==> a <> 0n``, DIMINDEX_GT_0]) 2238 \\ SRW_TAC [] [rich_listTheory.HD_GENLIST, TL_GENLIST_K, 2239 rich_listTheory.EVERY_GENLIST, GSYM rich_listTheory.AND_EL_FOLDL, 2240 rich_listTheory.AND_EL_DEF] 2241 \\ Cases_on `w ' n` 2242 \\ SRW_TAC [listSimps.LIST_ss] 2243 [NOT_EVERY_HD_F, GSYM rich_listTheory.AND_EL_FOLDL, 2244 rich_listTheory.AND_EL_DEF, rich_listTheory.TL_GENLIST, 2245 rich_listTheory.EXISTS_GENLIST] 2246 \\ SPOSE_NOT_THEN STRIP_ASSUME_TAC 2247 \\ IMP_RES_TAC NOT_UINTMAXw 2248 \\ Cases_on `0 < n` 2249 >| [Cases_on `i = n` >- FULL_SIMP_TAC std_ss [] 2250 \\ `i < n` by DECIDE_TAC 2251 \\ `n - i - 1 < n` by DECIDE_TAC 2252 \\ Q.PAT_X_ASSUM `!i. P` (Q.SPEC_THEN ` n - i - 1` IMP_RES_TAC) 2253 \\ FULL_SIMP_TAC std_ss [] 2254 \\ METIS_TAC 2255 [DECIDE ``0 < n /\ i < n ==> (n - SUC (n - i - 1) = i)``], 2256 `(n = 0) /\ (i = 0)` by DECIDE_TAC 2257 \\ FULL_SIMP_TAC bool_ss []]) 2258 2259val reduce_or = Q.store_thm ("reduce_or", 2260 `!w. reduce_or w = if w = 0w then 0w else 1w`, 2261 SRW_TAC [boolSimps.LET_ss] 2262 [GENLIST_0w, WORD_REDUCE_LIFT, reduce_or_def, word_reduce_def] 2263 \\ (Cases_on `dimindex (:'a)` >- 2264 FULL_SIMP_TAC bool_ss [DECIDE ``0 < a ==> a <> 0n``, DIMINDEX_GT_0]) 2265 \\ SRW_TAC [] [rich_listTheory.HD_GENLIST, TL_GENLIST_K, 2266 rich_listTheory.EVERY_GENLIST, GSYM rich_listTheory.OR_EL_FOLDL, 2267 rich_listTheory.OR_EL_DEF] 2268 \\ Cases_on `w ' n` 2269 \\ SRW_TAC [listSimps.LIST_ss] 2270 [EXISTS_HD_T, GSYM rich_listTheory.OR_EL_FOLDL, 2271 rich_listTheory.OR_EL_DEF, rich_listTheory.TL_GENLIST, 2272 rich_listTheory.EXISTS_GENLIST] 2273 \\ SPOSE_NOT_THEN STRIP_ASSUME_TAC 2274 \\ IMP_RES_TAC NOT_0w 2275 \\ Cases_on `0 < n` 2276 >| [Cases_on `i = n` >- FULL_SIMP_TAC std_ss [] 2277 \\ `i < n` by DECIDE_TAC 2278 \\ `n - i - 1 < n` by DECIDE_TAC 2279 \\ Q.PAT_X_ASSUM `!i. P` (Q.SPEC_THEN ` n - i - 1` IMP_RES_TAC) 2280 \\ FULL_SIMP_TAC std_ss [] 2281 \\ METIS_TAC 2282 [DECIDE ``0 < n /\ i < n ==> (n - SUC (n - i - 1) = i)``], 2283 `(n = 0) /\ (i = 0)` by DECIDE_TAC 2284 \\ FULL_SIMP_TAC bool_ss []]) 2285 2286(* ------------------------------------------------------------------------- 2287 Word arithmetic: theorems 2288 ------------------------------------------------------------------------- *) 2289 2290val _ = set_fixity "==" (Infix(NONASSOC, 450)) 2291 2292val equiv = ``\x y. x MOD ^top = y MOD ^top`` 2293 2294val n2w_11' = REWRITE_RULE [dimword_def] n2w_11 2295val lift_rule = REWRITE_RULE [GSYM n2w_11'] o Q.INST [`wl` |-> `^WL`] 2296val LET_RULE = CONV_RULE (DEPTH_CONV pairLib.let_CONV) 2297val LET_TAC = CONV_TAC (DEPTH_CONV pairLib.let_CONV) 2298 2299val MOD_ADD = (REWRITE_RULE [ZERO_LT_TWOEXP] o Q.SPEC `^top`) MOD_PLUS 2300val ONE_LT_EQ_TWOEXP = REWRITE_RULE [SYM ONE,LESS_EQ] ZERO_LT_TWOEXP 2301 2302val SUC_EQUIV_mod = LET_RULE (Q.prove( 2303 `!a b. let $== = ^equiv in 2304 SUC a == b ==> a == (b + (^top - 1))`, 2305 LET_TAC \\ REPEAT STRIP_TAC 2306 \\ ONCE_REWRITE_TAC [GSYM MOD_ADD] 2307 \\ POP_ASSUM (fn th => REWRITE_TAC [SYM th]) 2308 \\ SIMP_TAC std_ss [MOD_ADD,ADD1,GSYM LESS_EQ_ADD_SUB,ONE_LT_EQ_TWOEXP] 2309 \\ SIMP_TAC arith_ss [ADD_MODULUS,ZERO_LT_TWOEXP])) 2310 2311val INV_SUC_EQ_mod = LET_RULE (Q.prove( 2312 `!m n. let $== = ^equiv in 2313 (SUC m == SUC n) = (m == n)`, 2314 LET_TAC \\ REPEAT STRIP_TAC \\ EQ_TAC >| [ 2315 STRIP_TAC \\ IMP_RES_TAC SUC_EQUIV_mod 2316 \\ FULL_SIMP_TAC arith_ss [GSYM LESS_EQ_ADD_SUB,ADD1,ADD_MODULUS, 2317 ZERO_LT_TWOEXP,ONE_LT_EQ_TWOEXP], 2318 REWRITE_TAC [ADD1] \\ ONCE_REWRITE_TAC [GSYM MOD_ADD] 2319 \\ RW_TAC std_ss []])) 2320 2321val ADD_INV_0_mod = LET_RULE (Q.prove( 2322 `!m n. let $== = ^equiv in 2323 (m + n == m) ==> (n == 0)`, 2324 LET_TAC \\ Induct \\ RW_TAC bool_ss [ADD_CLAUSES] 2325 \\ FULL_SIMP_TAC bool_ss [INV_SUC_EQ_mod])) 2326 2327val ADD_INV_0_EQ_mod = LET_RULE (Q.prove( 2328 `!m n. let $== = ^equiv in 2329 (m + n == m) = (n == 0)`, 2330 LET_TAC \\ REPEAT STRIP_TAC \\ EQ_TAC \\ STRIP_TAC 2331 \\ IMP_RES_TAC ADD_INV_0_mod 2332 \\ ONCE_REWRITE_TAC [GSYM MOD_ADD] 2333 \\ ASM_SIMP_TAC arith_ss [ZERO_MOD,ADD_MODULUS,ZERO_LT_TWOEXP])) 2334 2335val EQ_ADD_LCANCEL_mod = LET_RULE (Q.prove( 2336 `!m n p. let $== = ^equiv in 2337 (m + n == m + p) = (n == p)`, 2338 LET_TAC \\ Induct \\ ASM_REWRITE_TAC [ADD_CLAUSES,INV_SUC_EQ_mod])) 2339 2340val WORD_NEG_mod = LET_RULE (Q.prove( 2341 `!n. let $== = ^equiv in 2342 ^top - n MOD ^top == (^top - 1 - n MOD ^top) + 1`, 2343 LET_TAC \\ STRIP_TAC 2344 \\ `1 + n MOD ^top <= ^top` 2345 by SIMP_TAC std_ss [DECIDE ``a < b ==> 1 + a <= b``,MOD_2EXP_LT] 2346 \\ ASM_SIMP_TAC arith_ss [SUB_RIGHT_SUB,SUB_RIGHT_ADD] 2347 \\ Tactical.REVERSE (Cases_on `1 + n MOD ^top = ^top`) 2348 >- FULL_SIMP_TAC arith_ss [] 2349 \\ RULE_ASSUM_TAC 2350 (SIMP_RULE bool_ss [GSYM SUC_ONE_ADD,GSYM PRE_SUC_EQ,ZERO_LT_TWOEXP]) 2351 \\ ASM_SIMP_TAC arith_ss [PRE_SUB1])) 2352 2353val n2w_dimword = Q.prove( 2354 `n2w (2 ** ^WL) = 0w:'a word`, 2355 ONCE_REWRITE_TAC [GSYM n2w_mod] 2356 \\ SIMP_TAC std_ss [DIVMOD_ID,ZERO_MOD,ZERO_LT_TWOEXP,dimword_def]) 2357 2358val WORD_ss = rewrites [word_add_n2w,word_mul_n2w,word_sub_def,word_2comp_def, 2359 w2n_n2w,n2w_w2n,word_0,n2w_dimword,ZERO_LT_TWOEXP,dimword_def, 2360 LEFT_ADD_DISTRIB,RIGHT_ADD_DISTRIB, 2361 LEFT_SUB_DISTRIB,RIGHT_SUB_DISTRIB] 2362 2363val ARITH_WORD_TAC = 2364 REPEAT Cases 2365 \\ ASM_SIMP_TAC (fcp_ss++ARITH_ss++numSimps.ARITH_AC_ss++WORD_ss) [] 2366 2367(* -- *) 2368 2369val WORD_ADD_0 = Q.store_thm("WORD_ADD_0", 2370 `(!w:'a word. w + 0w = w) /\ (!w:'a word. 0w + w = w)`, 2371 CONJ_TAC \\ ARITH_WORD_TAC) 2372 2373val WORD_ADD_ASSOC = Q.store_thm("WORD_ADD_ASSOC", 2374 `!v:'a word w x. v + (w + x) = v + w + x`, ARITH_WORD_TAC) 2375 2376val WORD_MULT_ASSOC = Q.store_thm("WORD_MULT_ASSOC", 2377 `!v:'a word w x. v * (w * x) = v * w * x`, 2378 REPEAT Cases \\ ASM_SIMP_TAC (fcp_ss++WORD_ss) [MULT_ASSOC]) 2379 2380val WORD_ADD_COMM = Q.store_thm("WORD_ADD_COMM", 2381 `!v:'a word w. v + w = w + v`, ARITH_WORD_TAC) 2382 2383val WORD_MULT_COMM = Q.store_thm("WORD_MULT_COMM", 2384 `!v:'a word w. v * w = w * v`, ARITH_WORD_TAC) 2385 2386val WORD_MULT_CLAUSES = Q.store_thm("WORD_MULT_CLAUSES", 2387 `!v:'a word w. 2388 (0w * v = 0w) /\ (v * 0w = 0w) /\ 2389 (1w * v = v) /\ (v * 1w = v) /\ 2390 ((v + 1w) * w = v * w + w) /\ (v * (w + 1w) = v + v * w)`, 2391 ARITH_WORD_TAC) 2392 2393val WORD_LEFT_ADD_DISTRIB = Q.store_thm("WORD_LEFT_ADD_DISTRIB", 2394 `!v:'a word w x. v * (w + x) = v * w + v * x`, ARITH_WORD_TAC) 2395 2396val WORD_RIGHT_ADD_DISTRIB = Q.store_thm("WORD_RIGHT_ADD_DISTRIB", 2397 `!v:'a word w x. (v + w) * x = v * x + w * x`, ARITH_WORD_TAC) 2398 2399val WORD_ADD_SUB_ASSOC = Q.store_thm("WORD_ADD_SUB_ASSOC", 2400 `!v:'a word w x. v + w - x = v + (w - x)`, ARITH_WORD_TAC) 2401 2402val WORD_ADD_SUB_SYM = Q.store_thm("WORD_ADD_SUB_SYM", 2403 `!v:'a word w x. v + w - x = v - x + w`, ARITH_WORD_TAC) 2404 2405val WORD_ADD_LINV = Q.store_thm("WORD_ADD_LINV", 2406 `!w:'a word. - w + w = 0w`, 2407 ARITH_WORD_TAC 2408 \\ STRIP_ASSUME_TAC 2409 ((REWRITE_RULE [ZERO_LT_TWOEXP] o Q.SPECL [`n`,`2 ** ^WL`]) DA) 2410 \\ ASM_SIMP_TAC std_ss [MOD_MULT] 2411 \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 2412 \\ ASM_SIMP_TAC arith_ss 2413 [GSYM MULT,MOD_EQ_0,ZERO_LT_TWOEXP,word_0,dimword_def]) 2414 2415val WORD_ADD_RINV = Q.store_thm("WORD_ADD_RINV", 2416 `!w:'a word. w + - w = 0w`, 2417 METIS_TAC [WORD_ADD_COMM,WORD_ADD_LINV]) 2418 2419val WORD_SUB_REFL = Q.store_thm("WORD_SUB_REFL", 2420 `!w:'a word. w - w = 0w`, 2421 REWRITE_TAC [word_sub_def,WORD_ADD_RINV]) 2422 2423val WORD_SUB_ADD2 = Q.store_thm("WORD_SUB_ADD2", 2424 `!v:'a word w. v + (w - v) = w`, 2425 REWRITE_TAC [GSYM WORD_ADD_SUB_ASSOC,WORD_ADD_SUB_SYM, 2426 WORD_SUB_REFL,WORD_ADD_0]) 2427 2428val WORD_ADD_SUB = Q.store_thm("WORD_ADD_SUB", 2429 `!v:'a word w. v + w - w = v`, 2430 REWRITE_TAC [WORD_ADD_SUB_ASSOC,WORD_SUB_REFL,WORD_ADD_0]) 2431 2432val WORD_SUB_ADD = save_thm("WORD_SUB_ADD", 2433 REWRITE_RULE [WORD_ADD_SUB_SYM] WORD_ADD_SUB) 2434 2435val WORD_ADD_EQ_SUB = Q.store_thm("WORD_ADD_EQ_SUB", 2436 `!v:'a word w x. (v + w = x) = (v = (x - w))`, 2437 METIS_TAC [WORD_ADD_SUB,WORD_SUB_ADD]) 2438 2439val WORD_ADD_INV_0_EQ = Q.store_thm("WORD_ADD_INV_0_EQ", 2440 `!v:'a word w. (v + w = v) = (w = 0w)`, 2441 REPEAT Cases 2442 \\ ASM_SIMP_TAC std_ss [word_add_n2w,lift_rule ADD_INV_0_EQ_mod]) 2443 2444val WORD_EQ_ADD_LCANCEL = Q.store_thm("WORD_EQ_ADD_LCANCEL[simp]", 2445 `!v:'a word w x. (v + w = v + x) = (w = x)`, 2446 REPEAT Cases 2447 \\ ASM_SIMP_TAC std_ss [word_add_n2w,lift_rule EQ_ADD_LCANCEL_mod]) 2448 2449val WORD_EQ_ADD_RCANCEL = Q.store_thm("WORD_EQ_ADD_RCANCEL[simp]", 2450 `!v:'a word w x. (v + w = x + w) = (v = x)`, 2451 METIS_TAC [WORD_ADD_COMM,WORD_EQ_ADD_LCANCEL]) 2452 2453val WORD_NEG = Q.store_thm("WORD_NEG", 2454 `!w:'a word. - w = ~w + 1w`, 2455 REPEAT Cases 2456 \\ ASM_SIMP_TAC (fcp_ss++ARITH_ss) [word_add_n2w,word_2comp_n2w, 2457 word_1comp_n2w,lift_rule WORD_NEG_mod,dimword_def]) 2458 2459val WORD_NOT = Q.store_thm("WORD_NOT", 2460 `!w:'a word. ~w = - w - 1w`, 2461 REWRITE_TAC [WORD_NEG,WORD_ADD_SUB]) 2462 2463val WORD_NEG_0 = Q.store_thm("WORD_NEG_0[simp]", 2464 `- 0w = 0w`, 2465 ARITH_WORD_TAC) 2466 2467val WORD_NEG_ADD = Q.store_thm("WORD_NEG_ADD", 2468 `!v:'a word w. - (v + w) = - v + - w`, 2469 REPEAT STRIP_TAC 2470 \\ `- v + v + (-w + w) = 0w` 2471 by REWRITE_TAC [WORD_ADD_LINV,WORD_ADD_0] 2472 \\ `- v + v + (-w + w) = - v + - w + (v + w)` 2473 by SIMP_TAC std_ss [AC WORD_ADD_ASSOC WORD_ADD_COMM] 2474 \\ METIS_TAC [GSYM WORD_ADD_LINV,WORD_EQ_ADD_RCANCEL]) 2475 2476val WORD_NEG_NEG = Q.store_thm("WORD_NEG_NEG[simp]", 2477 `!w:'a word. - (- w) = w`, 2478 STRIP_TAC 2479 \\ `- (- w) + - w = w + - w` 2480 by SIMP_TAC std_ss [WORD_NEG_0,WORD_ADD_0,WORD_ADD_LINV,WORD_ADD_RINV] 2481 \\ METIS_TAC [WORD_EQ_ADD_RCANCEL]) 2482 2483val WORD_SUB_LNEG = save_thm("WORD_SUB_LNEG", 2484 (REWRITE_RULE [GSYM word_sub_def] o GSYM) WORD_NEG_ADD) 2485 2486val WORD_SUB_RNEG = save_thm("WORD_SUB_RNEG", 2487 (Q.GEN `v` o Q.GEN `w` o REWRITE_RULE [WORD_NEG_NEG] o 2488 Q.SPECL [`v`,`- w`]) word_sub_def) 2489 2490val WORD_SUB_SUB = Q.store_thm("WORD_SUB_SUB", 2491 `!v:'a word w x. v - (w - x) = v + x - w`, 2492 SIMP_TAC std_ss [AC WORD_ADD_ASSOC WORD_ADD_COMM, 2493 word_sub_def,WORD_NEG_ADD,WORD_NEG_NEG]) 2494 2495val WORD_SUB_SUB2 = save_thm("WORD_SUB_SUB2", 2496 (Q.GEN `v` o Q.GEN `w` o 2497 REWRITE_RULE [WORD_ADD_SUB_SYM,WORD_SUB_REFL,WORD_ADD_0] o 2498 Q.SPECL [`v`,`v`,`w`]) WORD_SUB_SUB) 2499 2500val WORD_EQ_SUB_LADD = Q.store_thm("WORD_EQ_SUB_LADD", 2501 `!v:'a word w x. (v = w - x) = (v + x = w)`, 2502 METIS_TAC 2503 [word_sub_def,WORD_ADD_ASSOC,WORD_ADD_LINV,WORD_ADD_RINV,WORD_ADD_0]) 2504 2505val WORD_EQ_SUB_RADD = Q.store_thm("WORD_EQ_SUB_RADD", 2506 `!v:'a word w x. (v - w = x) = (v = x + w)`, 2507 METIS_TAC [WORD_EQ_SUB_LADD]) 2508 2509val WORD_EQ_SUB_ZERO = save_thm("WORD_EQ_SUB_ZERO", 2510 (GEN_ALL o REWRITE_RULE [WORD_ADD_0] o 2511 Q.SPECL [`v`,`w`,`0w`]) WORD_EQ_SUB_RADD) 2512 2513val WORD_LCANCEL_SUB = Q.store_thm("WORD_LCANCEL_SUB", 2514 `!v:'a word w x. (v - w = x - w) = (v = x)`, 2515 REWRITE_TAC [word_sub_def,WORD_EQ_ADD_RCANCEL]) 2516 2517val WORD_RCANCEL_SUB = Q.store_thm("WORD_RCANCEL_SUB", 2518 `!v:'a word w x. (v - w = v - x) = (w = x)`, 2519 REWRITE_TAC [word_sub_def,WORD_EQ_ADD_LCANCEL] 2520 \\ METIS_TAC [WORD_NEG_NEG]) 2521 2522val WORD_SUB_PLUS = Q.store_thm("WORD_SUB_PLUS", 2523 `!v:'a word w x. v - (w + x) = v - w - x`, 2524 REWRITE_TAC [word_sub_def,WORD_NEG_ADD,WORD_ADD_ASSOC]) 2525 2526val WORD_SUB_LZERO = Q.store_thm("WORD_SUB_LZERO", 2527 `!w:'a word. 0w - w = - w`, 2528 REWRITE_TAC [word_sub_def,WORD_ADD_0]) 2529 2530val WORD_SUB_RZERO = Q.store_thm("WORD_SUB_RZERO", 2531 `!w:'a word. w - 0w = w`, 2532 REWRITE_TAC [word_sub_def,WORD_ADD_0,WORD_NEG_0]) 2533 2534val WORD_ADD_LID_UNIQ = save_thm("WORD_ADD_LID_UNIQ", 2535 (Q.GEN `v` o Q.GEN `w` o REWRITE_RULE [WORD_SUB_REFL] o 2536 Q.SPECL [`v`,`w`,`w`]) WORD_ADD_EQ_SUB) 2537 2538val WORD_ADD_RID_UNIQ = save_thm("WORD_ADD_RID_UNIQ", 2539 (Q.GEN `v` o Q.GEN `w` o ONCE_REWRITE_RULE [WORD_ADD_COMM] o 2540 Q.SPECL [`w`,`v`]) WORD_ADD_LID_UNIQ) 2541 2542val WORD_SUM_ZERO = Q.store_thm("WORD_SUM_ZERO", 2543 `!a b. (a + b = 0w) = (a = -b)`, 2544 METIS_TAC [WORD_SUB_LZERO, WORD_LCANCEL_SUB, WORD_ADD_SUB]) 2545 2546val WORD_ADD_SUB2 = save_thm("WORD_ADD_SUB2", 2547 ONCE_REWRITE_RULE [WORD_ADD_COMM] WORD_ADD_SUB) 2548 2549val WORD_ADD_SUB3 = save_thm("WORD_ADD_SUB3", 2550 (GEN_ALL o REWRITE_RULE [WORD_SUB_REFL,WORD_SUB_LZERO] o 2551 Q.SPECL [`v`,`v`]) WORD_SUB_PLUS) 2552 2553val WORD_SUB_SUB3 = save_thm("WORD_SUB_SUB3", 2554 (GEN_ALL o REWRITE_RULE [WORD_ADD_SUB3] o ONCE_REWRITE_RULE [WORD_ADD_COMM] o 2555 Q.SPECL [`v`,`w`,`v`] o GSYM) WORD_SUB_PLUS) 2556 2557val WORD_EQ_NEG = Q.store_thm("WORD_EQ_NEG", 2558 `!v:'a word w. (- v = - w) = (v = w)`, 2559 REWRITE_TAC [GSYM WORD_SUB_LZERO,WORD_RCANCEL_SUB]) 2560 2561val WORD_NEG_EQ = save_thm("WORD_NEG_EQ", 2562 (GEN_ALL o REWRITE_RULE [WORD_NEG_NEG] o Q.SPECL [`v`,`- w`]) WORD_EQ_NEG) 2563 2564val WORD_NEG_EQ_0 = save_thm("WORD_NEG_EQ_0[simp]", 2565 (REWRITE_RULE [WORD_NEG_0] o Q.SPECL [`v`,`0w`]) WORD_EQ_NEG) 2566 2567val WORD_SUB = save_thm("WORD_SUB", 2568 (ONCE_REWRITE_RULE [WORD_ADD_COMM] o GSYM) word_sub_def) 2569 2570val WORD_SUB_NEG = save_thm("WORD_SUB_NEG", 2571 (GEN_ALL o REWRITE_RULE [WORD_SUB] o Q.SPEC `- v`) WORD_SUB_RNEG) 2572 2573val WORD_NEG_SUB = save_thm("WORD_NEG_SUB", 2574 (GEN_ALL o REWRITE_RULE [WORD_SUB_NEG,GSYM word_sub_def] o 2575 Q.SPECL [`v`,`- w`] o GSYM) WORD_SUB_LNEG) 2576 2577val WORD_SUB_TRIANGLE = Q.store_thm("WORD_SUB_TRIANGLE", 2578 `!v:'a word w x. v - w + (w - x) = v - x`, 2579 REWRITE_TAC [GSYM WORD_ADD_SUB_SYM,WORD_ADD_SUB_ASSOC,WORD_SUB_SUB3] 2580 \\ REWRITE_TAC [word_sub_def]) 2581 2582val WORD_NOT_0 = save_thm("WORD_NOT_0", 2583 (GEN_ALL o REWRITE_RULE [WORD_NEG_1,WORD_NEG_0,WORD_SUB_LZERO] o 2584 Q.SPEC `0w`) WORD_NOT) 2585 2586val WORD_NOT_T = Q.store_thm("WORD_NOT_T", 2587 `~Tw = 0w`, REWRITE_TAC [GSYM WORD_NOT_0,WORD_NOT_NOT]) 2588 2589val WORD_NEG_T = Q.store_thm("WORD_NEG_T", 2590 `- Tw = 1w`, REWRITE_TAC [GSYM WORD_NEG_1,WORD_NEG_NEG]) 2591 2592val WORD_MULT_SUC = Q.store_thm("WORD_MULT_SUC", 2593 `!v:'a word n. v * n2w (n + 1) = v * n2w n + v`, 2594 Cases \\ 2595 SIMP_TAC arith_ss [word_mul_n2w,word_add_n2w,LEFT_ADD_DISTRIB]) 2596 2597val WORD_NEG_LMUL = Q.store_thm("WORD_NEG_LMUL", 2598 `!v:'a word w. - (v * w) = (- v) * w`, 2599 REPEAT Cases \\ POP_ASSUM (K ALL_TAC) 2600 \\ Induct_on `n'` >- REWRITE_TAC [WORD_MULT_CLAUSES,WORD_NEG_0] 2601 \\ ASM_REWRITE_TAC [WORD_NEG_ADD,ADD1,WORD_MULT_SUC,GSYM word_mul_n2w]) 2602 2603val WORD_NEG_RMUL = save_thm("WORD_NEG_RMUL", 2604 (Q.GEN `v` o Q.GEN `w` o ONCE_REWRITE_RULE [WORD_MULT_COMM] o 2605 Q.SPECL [`w`,`v`]) WORD_NEG_LMUL) 2606 2607val WORD_NEG_MUL = Q.store_thm("WORD_NEG_MUL", 2608 `!w. - w = - 1w * w`, 2609 SRW_TAC [] [WORD_NEG_EQ, WORD_NEG_LMUL, WORD_NEG_NEG, WORD_MULT_CLAUSES]) 2610 2611val sw2sw_w2w_add = Q.store_thm("sw2sw_w2w_add", 2612 `!w : 'a word. 2613 sw2sw w = (if word_msb w then -1w << dimindex (:'a) else 0w) + w2w w`, 2614 SRW_TAC [] [sw2sw_w2w, WORD_OR_CLAUSES, WORD_ADD_0] 2615 \\ MATCH_MP_TAC (GSYM WORD_ADD_OR) 2616 \\ SRW_TAC [fcpLib.FCP_ss] 2617 [w2w, word_and_def, word_lsl_def, word_0, WORD_NEG_1] 2618 \\ Cases_on `i < dimindex (:'a)` 2619 \\ SRW_TAC [ARITH_ss] [word_T]) 2620 2621(*---------------------------------------------------------------------------*) 2622 2623val WORD_ADD_BIT0 = Q.store_thm("WORD_ADD_BIT0", 2624 `!a b. (a + b) ' 0 = (a ' 0 <=/=> b ' 0)`, 2625 Cases \\ Cases \\ SRW_TAC [fcpLib.FCP_ss] 2626 [n2w_def, word_add_n2w, DIMINDEX_GT_0, ADD_BIT0]) 2627 2628val WORD_ADD_BIT = Q.store_thm("WORD_ADD_BIT", 2629 `!n a:'a word b. 2630 n < dimindex(:'a) ==> 2631 ((a + b) ' n = 2632 (if n = 0 then 2633 a ' 0 <=/=> b ' 0 2634 else 2635 if ((n - 1 -- 0) a + (n - 1 -- 0) b) ' n then 2636 a ' n = b ' n 2637 else 2638 a ' n <=/=> b ' n))`, 2639 Cases >- SRW_TAC [] [WORD_ADD_BIT0] 2640 \\ Cases \\ Cases \\ STRIP_TAC 2641 \\ SRW_TAC [] [word_add_n2w, word_bits_n2w] 2642 \\ POP_ASSUM MP_TAC 2643 \\ SRW_TAC [fcpLib.FCP_ss] [n2w_def, DIMINDEX_GT_0, 2644 simpLib.SIMP_PROVE arith_ss [MIN_DEF] 2645 ``0 < m /\ SUC n < m ==> (MIN n (m - 1) = n)``] 2646 \\ ONCE_REWRITE_TAC [ADD_BIT_SUC] \\ SRW_TAC [] []) 2647 2648val WORD_LEFT_SUB_DISTRIB = Q.store_thm("WORD_LEFT_SUB_DISTRIB", 2649 `!v:'a word w x. v * (w - x) = v * w - v * x`, 2650 REWRITE_TAC [word_sub_def,WORD_LEFT_ADD_DISTRIB,WORD_NEG_RMUL]) 2651 2652val WORD_RIGHT_SUB_DISTRIB = save_thm("WORD_RIGHT_SUB_DISTRIB", 2653 ONCE_REWRITE_RULE [WORD_MULT_COMM] WORD_LEFT_SUB_DISTRIB) 2654 2655val WORD_LITERAL_MULT = Q.store_thm("WORD_LITERAL_MULT", 2656 `(!m n. n2w m * - (n2w n) = - (n2w (m * n))) /\ 2657 (!m n. - (n2w m) * - (n2w n) = n2w (m * n))`, 2658 REWRITE_TAC 2659 [GSYM word_mul_n2w, GSYM WORD_NEG_LMUL, GSYM WORD_NEG_RMUL, WORD_NEG_NEG]) 2660 2661val WORD_LITERAL_ADD = Q.store_thm("WORD_LITERAL_ADD", 2662 `(!m n. - (n2w m) + - (n2w n) = - (n2w (m + n))) /\ 2663 (!m n. n2w m + - (n2w n) = 2664 if n <= m then n2w (m - n) else - (n2w (n - m)))`, 2665 REPEAT STRIP_TAC 2666 >- REWRITE_TAC [GSYM word_sub_def,GSYM word_add_n2w,WORD_NEG_ADD] 2667 \\ Cases_on `n <= m` 2668 \\ IMP_RES_TAC (DECIDE ``~(m <= n) ==> n <= m:num``) 2669 \\ IMP_RES_TAC LESS_EQUAL_ADD 2670 \\ ASM_REWRITE_TAC [GSYM word_sub_def] 2671 \\ ONCE_REWRITE_TAC [ADD_COMM] 2672 \\ REWRITE_TAC [GSYM word_add_n2w,WORD_ADD_SUB,ADD_SUB] 2673 \\ ONCE_REWRITE_TAC [WORD_ADD_COMM] 2674 \\ REWRITE_TAC [WORD_SUB_PLUS,WORD_SUB_REFL,WORD_SUB_LZERO]) 2675 2676val WORD_SUB_INTRO = Q.store_thm("WORD_SUB_INTRO", 2677 `(!x y:'a word. (- y) + x = x - y) /\ 2678 (!x y:'a word. x + (- y) = x - y) /\ 2679 (!x y z:'a word. -x * y + z = z - x * y) /\ 2680 (!x y z:'a word. z + -x * y = z - x * y) /\ 2681 (!x. -1w * x = -x) /\ 2682 (!x y z:'a word. z - -x * y = z + x * y) /\ 2683 (!x y z:'a word. -x * y - z = -(x * y + z))`, 2684 SIMP_TAC std_ss [word_sub_def, WORD_NEG_LMUL, 2685 AC WORD_ADD_COMM WORD_ADD_ASSOC, 2686 AC WORD_MULT_COMM WORD_MULT_ASSOC, 2687 GSYM WORD_SUB_LNEG, WORD_NEG_NEG] 2688 \\ METIS_TAC [WORD_NEG_MUL, WORD_MULT_COMM, WORD_MULT_CLAUSES]) 2689 2690(* n2w_SUC |- !n. n2w (SUC n) = n2w n + 1w *) 2691val n2w_SUC = save_thm ("n2w_SUC", 2692 SIMP_RULE std_ss [WORD_MULT_CLAUSES,GSYM ADD1] 2693 (Q.ISPEC `1w` WORD_MULT_SUC)) 2694 2695val n2w_sub = Q.store_thm("n2w_sub", 2696 `!a b. b <= a ==> (n2w (a - b) = n2w a - n2w b)`, 2697 RW_TAC arith_ss [word_sub_def, WORD_LITERAL_ADD] 2698 \\ `a - b = 0n` by DECIDE_TAC 2699 \\ ASM_REWRITE_TAC []) 2700 2701val n2w_sub_eq_0 = Q.store_thm("n2w_sub_eq_0", 2702 `!a b. a <= b ==> (n2w (a - b) = 0w)`, 2703 REPEAT STRIP_TAC 2704 \\ `a - b = 0n` by DECIDE_TAC 2705 \\ ASM_REWRITE_TAC []) 2706 2707val WORD_H_WORD_L = Q.store_thm("WORD_H_WORD_L", 2708 `INT_MAXw = INT_MINw - 1w`, 2709 SRW_TAC [] [word_H_def, word_L_def, word_sub_def, WORD_LITERAL_ADD, 2710 ZERO_LT_INT_MIN, INT_MAX_def, DECIDE ``0 < n ==> 1 <= n``]) 2711 2712val word_L_MULT = Q.store_thm("word_L_MULT", 2713 `!n. n2w n * INT_MINw = if EVEN n then 0w else INT_MINw`, 2714 SRW_TAC [] [word_L_def, word_mul_n2w] 2715 \\ FULL_SIMP_TAC bool_ss [GSYM ODD_EVEN] 2716 \\ IMP_RES_TAC EVEN_ODD_EXISTS 2717 \\ SRW_TAC [] [ADD1, RIGHT_ADD_DISTRIB] 2718 \\ ONCE_REWRITE_TAC [DECIDE ``a * b * c = a * c * b:num``] 2719 \\ SRW_TAC [] [SYM dimword_IS_TWICE_INT_MIN] 2720 \\ SRW_TAC [] [ONCE_REWRITE_RULE [MULT_COMM] MOD_MULT, 2721 ONCE_REWRITE_RULE [MULT_COMM] MOD_EQ_0, 2722 ZERO_LT_dimword, INT_MIN_LT_DIMWORD]) 2723 2724(* ------------------------------------------------------------------------- 2725 Shifts : theorems 2726 ------------------------------------------------------------------------- *) 2727 2728val WORD_ss = rewrites [word_msb_def,word_lsl_def,word_lsr_def,word_asr_def, 2729 word_ror_def,word_rol_def,word_rrx_def,word_T,word_or_def,word_lsb_def, 2730 word_and_def,word_xor_def,n2w_def,DIMINDEX_GT_0,BIT_ZERO,DIMINDEX_LT, 2731 MOD_PLUS_RIGHT] 2732 2733val SHIFT_WORD_TAC = RW_TAC (fcp_ss++ARITH_ss++WORD_ss) [] 2734 2735val ASR_ADD = Q.store_thm("ASR_ADD", 2736 `!w m n. w >> m >> n = w >> (m + n)`, 2737 NTAC 2 SHIFT_WORD_TAC 2738 \\ FULL_SIMP_TAC arith_ss [DECIDE ``!m. m < 1 = (m = 0)``,NOT_LESS_EQUAL]) 2739 2740val LSR_ADD = Q.store_thm("LSR_ADD", 2741 `!w m n. w >>> m >>> n = w >>> (m + n)`, 2742 SHIFT_WORD_TAC \\ Cases_on `i + n < ^WL` 2743 \\ SHIFT_WORD_TAC) 2744 2745val ROR_ADD = Q.store_thm("ROR_ADD", 2746 `!w m n. w #>> m #>> n = w #>> (m + n)`, 2747 SHIFT_WORD_TAC) 2748 2749val LSL_ADD = Q.store_thm("LSL_ADD", 2750 `!w m n. w << m << n = w << (m + n)`, 2751 SHIFT_WORD_TAC \\ EQ_TAC \\ RW_TAC arith_ss []) 2752 2753val ASR_LIMIT = Q.store_thm("ASR_LIMIT", 2754 `!w:'a word n. ^WL <= n ==> 2755 (w >> n = if word_msb w then Tw else 0w)`, 2756 SHIFT_WORD_TAC) 2757 2758val ASR_UINT_MAX = Q.store_thm("ASR_UINT_MAX", 2759 `!n. Tw >> n = Tw`, SHIFT_WORD_TAC) 2760 2761val LSR_LIMIT = Q.store_thm("LSR_LIMIT", 2762 `!w:'a word n. ^WL <= n ==> (w >>> n = 0w)`, 2763 SHIFT_WORD_TAC) 2764 2765val LSL_LIMIT = Q.store_thm("LSL_LIMIT", 2766 `!w:'a word n. ^WL <= n ==> (w << n = 0w)`, 2767 SHIFT_WORD_TAC) 2768 2769val MOD_TIMES_COMM = ONCE_REWRITE_RULE [ADD_COMM] MOD_TIMES 2770 2771val ROR_CYCLE = Q.store_thm("ROR_CYCLE", 2772 `!w:'a word n. (w #>> (n * ^WL) = w)`, 2773 SHIFT_WORD_TAC \\ ASM_SIMP_TAC arith_ss [MOD_TIMES_COMM,DIMINDEX_GT_0]) 2774 2775val ROR_MOD = Q.store_thm("ROR_MOD", 2776 `!w:'a word n. (w #>> (n MOD ^WL) = w #>> n)`, 2777 SHIFT_WORD_TAC) 2778 2779val ROL_MOD = Q.store_thm("ROL_MOD", 2780 `!w:'a word n. w #<< (n MOD dimindex (:'a)) = w #<< n`, 2781 SRW_TAC [] [word_rol_def, DIMINDEX_GT_0]) 2782 2783val SPEC1_RULE = (GEN_ALL o REWRITE_RULE [EXP_1] o 2784 ONCE_REWRITE_RULE [MULT_COMM] o Q.SPECL [`i`,`x`,`1`]) 2785 2786val LSL_ONE = Q.store_thm("LSL_ONE", 2787 `!w:'a word. w << 1 = w + w`, 2788 Cases \\ REWRITE_TAC [word_add_def,w2n_n2w,dimword_def] 2789 \\ SHIFT_WORD_TAC \\ Cases_on `1 <= i` 2790 \\ ASM_SIMP_TAC arith_ss [SPEC1_RULE BIT_SHIFT_THM2, 2791 SPEC1_RULE BIT_SHIFT_THM3] 2792 \\ STRIP_ASSUME_TAC EXISTS_HB \\ POP_ASSUM SUBST_ALL_TAC 2793 \\ ASM_SIMP_TAC arith_ss [BIT_def,GSYM BITS_ZERO3,BITS_COMP_THM2,MIN_DEF]) 2794 2795val ROR_UINT_MAX = Q.store_thm("ROR_UINT_MAX", 2796 `!n. Tw #>> n = Tw`, SHIFT_WORD_TAC) 2797 2798val ROR_ROL = Q.store_thm("ROR_ROL", 2799 `!w n. (w #>> n #<< n = w) /\ (w #<< n #>> n = w)`, 2800 SHIFT_WORD_TAC 2801 \\ Q.SPECL_THEN [`n`,`^WL`] 2802 (STRIP_ASSUME_TAC o SIMP_RULE std_ss [DIMINDEX_GT_0]) DA 2803 >- ASM_SIMP_TAC std_ss [MOD_TIMES,GSYM ADD_ASSOC,DIMINDEX_GT_0,LESS_MOD, 2804 DECIDE ``!a:num b c. a < c ==> (a + (b + (c - a)) = b + c)``, 2805 ADD_MODULUS_LEFT] 2806 \\ ONCE_REWRITE_TAC [ADD_COMM] 2807 \\ ASM_SIMP_TAC std_ss [MOD_PLUS_RIGHT,MOD_TIMES,DIMINDEX_GT_0,LESS_MOD, 2808 DECIDE ``!a:num b c d. a < c ==> ((c - a + b + d + a) = c + b + d)``, 2809 ADD_MODULUS_RIGHT,ONCE_REWRITE_RULE [ADD_COMM] MOD_TIMES,ADD_ASSOC]) 2810 2811val MOD_MULT_ = SIMP_RULE arith_ss [] MOD_MULT 2812val MOD_EQ_0_ = ONCE_REWRITE_RULE [MULT_COMM] MOD_EQ_0 2813 2814val lem = Q.prove( 2815 `!a b. 0 < a /\ 1n < b ==> 2 * a <= a * b`, 2816 SRW_TAC [] [] 2817 \\ POP_ASSUM (fn th => STRIP_ASSUME_TAC (MATCH_MP LESS_ADD_1 th)) 2818 \\ ASM_SIMP_TAC arith_ss []) 2819 2820val MOD_SUM_N = Q.prove( 2821 `!n a b. 0 < n /\ ~(a MOD n + b MOD n = 0) /\ ((a + b) MOD n = 0) ==> 2822 (a MOD n + b MOD n = n)`, 2823 NTAC 3 STRIP_TAC \\ Cases_on `0 < n` \\ ASM_REWRITE_TAC [] 2824 \\ IMP_RES_TAC DA 2825 \\ POP_ASSUM (fn th => MAP_EVERY (fn v => (STRIP_ASSUME_TAC o Q.SPEC v) th) 2826 [`a`, `b`, `r + r'`]) 2827 \\ ASM_SIMP_TAC std_ss [MOD_MULT, 2828 DECIDE ``a * n + r + (b * n + s) = (a + b) * n + (r + s:num)``] 2829 \\ Cases_on `q'' = 0` >- FULL_SIMP_TAC arith_ss [MOD_MULT_] 2830 \\ Cases_on `q'' = 1` 2831 >- FULL_SIMP_TAC arith_ss [MOD_MULT_, 2832 DECIDE ``n + (r + n * (a + b)) = r + n * (a + b + 1n)``] 2833 \\ `1 < q''` by DECIDE_TAC \\ IMP_RES_TAC lem 2834 \\ FULL_SIMP_TAC arith_ss []) 2835 2836val lem = Q.prove( 2837 `!a b. 0 < b /\ (a MOD b = 0) ==> ?k. a = k * b`, 2838 REPEAT STRIP_TAC 2839 \\ IMP_RES_TAC DA 2840 \\ POP_ASSUM (Q.SPEC_THEN `a` STRIP_ASSUME_TAC) 2841 \\ Q.EXISTS_TAC `q` 2842 \\ FULL_SIMP_TAC arith_ss [MOD_MULT_]) 2843 2844val MOD_COMPLEMENT = Q.store_thm("MOD_COMPLEMENT", 2845 `!n q a. 0 < n /\ 0 < q /\ a < q * n ==> 2846 ((q * n - a) MOD n = (n - a MOD n) MOD n)`, 2847 SRW_TAC [] [] \\ Cases_on `a MOD n = 0` 2848 >| [ 2849 ASM_SIMP_TAC std_ss [] \\ IMP_RES_TAC lem 2850 \\ FULL_SIMP_TAC arith_ss [MOD_EQ_0_, 2851 DECIDE ``n * a - b * n = n * (a - b):num``], 2852 SRW_TAC [ARITH_ss] [DECIDE ``a < b ==> ((c = b - a) = (c + a = b:num))``] 2853 \\ MATCH_MP_TAC MOD_SUM_N 2854 \\ SRW_TAC [ARITH_ss] [MOD_EQ_0_]]) 2855 2856val ROR_lem = 2857 METIS_PROVE [ROR_MOD] 2858 ``!w:'a word a b. (a MOD dimindex(:'a) = b MOD dimindex(:'a)) ==> 2859 (w #>> a = w #>> b)`` 2860 2861val ROL_ADD = Q.store_thm("ROL_ADD", 2862 `!w m n. w #<< m #<< n = w #<< (m + n)`, 2863 SRW_TAC [] [word_rol_def, ROR_ADD] 2864 \\ MATCH_MP_TAC ROR_lem 2865 \\ `m MOD dimindex (:'a) + n MOD dimindex (:'a) < 2 * dimindex(:'a)` 2866 by SRW_TAC [ARITH_ss] 2867 [DECIDE ``a < c /\ b < c ==> a + b < 2n * c``, DIMINDEX_GT_0] 2868 \\ SRW_TAC [ARITH_ss] [DIMINDEX_GT_0, MOD_PLUS, MOD_COMPLEMENT, 2869 DECIDE ``a < c /\ b < c ==> (c - a + (c - b) = 2n * c - (a + b))``]) 2870 2871val ZERO_SHIFT = Q.store_thm("ZERO_SHIFT", 2872 `(!n. 0w:'a word << n = 0w) /\ 2873 (!n. 0w:'a word >> n = 0w) /\ 2874 (!n. 0w:'a word >>> n = 0w) /\ 2875 (!n. 0w:'a word #<< n = 0w) /\ 2876 (!n. 0w:'a word #>> n = 0w)`, 2877 SHIFT_WORD_TAC \\ Cases_on `i + n < ^WL` 2878 \\ ASM_SIMP_TAC fcp_ss []) 2879 2880val ROL_ZERO = Q.prove( 2881 `!w:'a word. w #<< 0 = w`, 2882 SRW_TAC [ARITH_ss] [DIMINDEX_GT_0, word_rol_def, 2883 (REWRITE_RULE [MULT_LEFT_1] o Q.SPECL [`w`,`1`]) ROR_CYCLE]) 2884 2885val SHIFT_ZERO = Q.store_thm("SHIFT_ZERO", 2886 `(!a. a << 0 = a) /\ (!a. a >> 0 = a) /\ 2887 (!a. a >>> 0 = a) /\ (!a. a #<< 0 = a) /\ (!a. a #>> 0 = a)`, 2888 REWRITE_TAC [ROL_ZERO] \\ SHIFT_WORD_TAC) 2889 2890val word_lsl_n2w = Q.store_thm("word_lsl_n2w", 2891 `!n m. (n2w m):'a word << n = 2892 if ^HB < n then 0w else n2w (m * 2 ** n)`, 2893 Induct >- SIMP_TAC arith_ss [SHIFT_ZERO] 2894 \\ ASM_REWRITE_TAC [ADD1,GSYM LSL_ADD] 2895 \\ Cases_on `dimindex (:'a) - 1 < n` 2896 \\ ASM_SIMP_TAC arith_ss [ZERO_SHIFT] 2897 \\ RW_TAC arith_ss [LSL_ONE,EXP_ADD,word_add_n2w] 2898 \\ `n = dimindex (:'a) - 1` by DECIDE_TAC 2899 \\ ONCE_REWRITE_TAC [GSYM n2w_mod] 2900 \\ ASM_SIMP_TAC (std_ss++numSimps.ARITH_AC_ss) [GSYM EXP,SUB1_SUC, 2901 MOD_EQ_0,ZERO_MOD,ZERO_LT_TWOEXP,DIMINDEX_GT_0,dimword_def]) 2902 2903val word_1_lsl = Q.store_thm("word_1_lsl", 2904 `!n. 1w << n = n2w (2 ** n)`, 2905 lrw [word_lsl_n2w, dimword_def] 2906 \\ `dimindex (:'a) <= n` by decide_tac 2907 \\ imp_res_tac arithmeticTheory.LESS_EQUAL_ADD 2908 \\ simp [arithmeticTheory.EXP_ADD, arithmeticTheory.MOD_EQ_0] 2909 ) 2910 2911val word_lsr_n2w = Q.store_thm("word_lsr_n2w", 2912 `!w:'a word n. w >>> n = (^HB -- n) w`, 2913 SIMP_TAC arith_ss [word_lsr_def,word_bits_def,MIN_IDEM,DIMINDEX_GT_0, 2914 DECIDE ``0 < m ==> (a <= m - 1 = a < m)``]) 2915 2916val word_asr_n2w = Q.prove( 2917 `!n w. w:'a word >> n = 2918 if word_msb w then 2919 Tw << (^WL - MIN n ^WL) || w >>> n 2920 else 2921 w >>> n`, 2922 NTAC 2 STRIP_TAC \\ Cases_on `^WL < n` 2923 >- RW_TAC arith_ss [MIN_DEF,SHIFT_ZERO,LSR_LIMIT,ASR_LIMIT,WORD_OR_CLAUSES] 2924 \\ SHIFT_WORD_TAC \\ Cases_on `^WL <= i + n` 2925 \\ FULL_SIMP_TAC arith_ss [MIN_DEF]) 2926 2927val lem = (GEN_ALL o REWRITE_RULE [MATCH_MP (DECIDE ``0 < n ==> 1 <= n``) 2928 (SPEC_ALL ZERO_LT_TWOEXP),MULT_LEFT_1] o Q.SPECL [`1`,`2 ** n`]) 2929 LESS_MONO_MULT 2930 2931val LSL_UINT_MAX = Q.store_thm("LSL_UINT_MAX", 2932 `!n. Tw << n = n2w (dimword(:'a) - 2 ** n):'a word`, 2933 RW_TAC arith_ss [n2w_11,word_T_def,word_lsl_n2w,dimword_def,UINT_MAX_def] 2934 \\ FULL_SIMP_TAC arith_ss [NOT_LESS,RIGHT_SUB_DISTRIB] 2935 \\ `n < ^WL` by DECIDE_TAC \\ IMP_RES_TAC TWOEXP_MONO 2936 \\ `2 ** n * ^dimword_ML - 2 ** n = 2937 (2 ** n - 1) * ^dimword_ML + (^dimword_ML - 2 ** n)` 2938 by (`^dimword_ML <= 2 ** n * ^dimword_ML` by ASM_SIMP_TAC arith_ss [lem] 2939 \\ ASM_SIMP_TAC std_ss [MULT_LEFT_1,RIGHT_SUB_DISTRIB, 2940 GSYM LESS_EQ_ADD_SUB,LESS_IMP_LESS_OR_EQ,SUB_ADD] 2941 \\ PROVE_TAC [MULT_COMM]) 2942 \\ ASM_SIMP_TAC std_ss [MOD_TIMES,ZERO_LT_TWOEXP]) 2943 2944val word_asr_n2w = save_thm("word_asr_n2w", 2945 REWRITE_RULE [LSL_UINT_MAX] word_asr_n2w) 2946 2947val BITS_SUM1 = 2948 (GEN_ALL o REWRITE_RULE [MULT_LEFT_1] o 2949 Q.INST [`a` |-> `1`] o SPEC_ALL) BITS_SUM 2950 2951val lem = (GSYM o SIMP_RULE arith_ss [] o 2952 Q.SPECL [`p`,`SUC m - n MOD SUC m + p`, 2953 `SUC m - n MOD SUC m`]) BIT_OF_BITS_THM 2954 2955val lem2 = (GSYM o REWRITE_RULE [ADD] o 2956 Q.SPECL [`p`,`n MOD SUC m - 1`,`0`]) BIT_OF_BITS_THM 2957 2958val word_ror_n2w = Q.store_thm("word_ror_n2w", 2959 `!n a. (n2w a):'a word #>> n = 2960 let x = n MOD ^WL in 2961 n2w (BITS ^HB x a + (BITS (x - 1) 0 a) * 2 ** (^WL - x))`, 2962 SIMP_TAC (bool_ss++boolSimps.LET_ss) [Once (GSYM ROR_MOD)] 2963 \\ RW_TAC fcp_ss [word_ror_def,n2w_def,DIVISION,DIMINDEX_GT_0] 2964 \\ STRIP_ASSUME_TAC EXISTS_HB 2965 \\ FULL_SIMP_TAC arith_ss [] \\ ONCE_REWRITE_TAC [MULT_COMM] 2966 \\ Cases_on `i < SUC m - n MOD SUC m` 2967 >| [ 2968 `i + n MOD SUC m < SUC m` by DECIDE_TAC 2969 \\ Q.PAT_X_ASSUM `i < y - z` (fn th => (STRIP_ASSUME_TAC o REWRITE_RULE 2970 [DECIDE ``a + (b + 1) = b + SUC a``]) (MATCH_MP LESS_ADD_1 th)) 2971 \\ ASM_SIMP_TAC std_ss [BITS_SUM2,EXP_ADD,BIT_def,MULT_ASSOC] 2972 \\ ASM_SIMP_TAC arith_ss [GSYM BIT_def,BIT_OF_BITS_THM], 2973 RULE_ASSUM_TAC (REWRITE_RULE [NOT_LESS]) 2974 \\ IMP_RES_TAC LESS_EQUAL_ADD 2975 \\ ASSUME_TAC (Q.SPECL [`m`,`n MOD SUC m`,`a`] BITSLT_THM) 2976 \\ ASM_SIMP_TAC std_ss [lem,BITS_SUM] 2977 \\ REWRITE_TAC [GSYM lem] 2978 \\ ASM_SIMP_TAC std_ss [ONCE_REWRITE_RULE [ADD_COMM] BIT_SHIFT_THM] 2979 \\ `p < SUC m /\ p <= n MOD SUC m - 1` by DECIDE_TAC 2980 \\ `SUC m - n MOD SUC m + p + n MOD SUC m = SUC m + p` 2981 by SIMP_TAC arith_ss [DIVISION, 2982 DECIDE ``b < a ==> (a - b + c + b = a + c:num)``] 2983 \\ ASM_SIMP_TAC std_ss [LESS_MOD,prim_recTheory.LESS_0, 2984 ADD_MODULUS,lem2]]) 2985 2986val word_rrx_n2w = Q.store_thm("word_rrx_n2w", 2987 `!c a. word_rrx(c, (n2w a):'a word) = 2988 (ODD a, (n2w (BITS ^HB 1 a + SBIT c ^HB)):'a word)`, 2989 SHIFT_WORD_TAC 2990 \\ RW_TAC arith_ss [BIT0_ODD,SBIT_def,BIT_OF_BITS_THM] 2991 \\ STRIP_ASSUME_TAC EXISTS_HB \\ FULL_SIMP_TAC arith_ss [] 2992 >| [ 2993 METIS_TAC [BITSLT_THM,SUC_SUB1,BITS_SUM1,BIT_def,BIT_B], 2994 SIMP_TAC arith_ss [BIT_def,BITS_COMP_THM2,MIN_lem,BITS_ZERO], 2995 `i < m` by DECIDE_TAC 2996 \\ POP_ASSUM (fn th => (STRIP_ASSUME_TAC o REWRITE_RULE 2997 [DECIDE ``a + (b + 1) = b + SUC a``]) (MATCH_MP LESS_ADD_1 th)) 2998 \\ ASM_SIMP_TAC std_ss [EXP_ADD,BIT_def,BITS_SUM2,BITS_COMP_THM2] 2999 \\ SIMP_TAC std_ss [ADD1,ONCE_REWRITE_RULE [ADD_COMM] MIN_lem]]) 3000 3001val word_ror = Q.store_thm("word_ror", 3002 `!w:'a word n. w #>> n = 3003 let x = n MOD dimindex(:'a) in 3004 (dimindex(:'a) - 1 -- x) w || (x - 1 -- 0) w << (dimindex (:'a) - x)`, 3005 SRW_TAC [fcpLib.FCP_ss, boolSimps.LET_ss, ARITH_ss] 3006 [word_ror_def, word_or_def, word_lsl_def, word_bits_def] 3007 \\ Q.SPECL_THEN [`n`,`dimindex(:'a)`] 3008 (STRIP_ASSUME_TAC o SIMP_RULE std_ss [DIMINDEX_GT_0]) DA 3009 \\ SRW_TAC [] [MOD_TIMES, DIMINDEX_GT_0, 3010 DECIDE ``a + (b * c + d) = b * c + (a + d:num)``] 3011 \\ Cases_on `i + r < dimindex (:'a)` 3012 \\ SRW_TAC [ARITH_ss] [] 3013 \\ Q.SPECL_THEN [`i + r`,`dimindex(:'a)`] 3014 (STRIP_ASSUME_TAC o SIMP_RULE std_ss [DIMINDEX_GT_0]) DA 3015 \\ SRW_TAC [] [MOD_TIMES, DIMINDEX_GT_0] 3016 \\ Cases_on `q = 0` \\ FULL_SIMP_TAC arith_ss [] 3017 \\ Cases_on `q = 1` \\ FULL_SIMP_TAC arith_ss [] 3018 \\ `1 < q` by DECIDE_TAC 3019 \\ POP_ASSUM (fn th => STRIP_ASSUME_TAC (MATCH_MP LESS_ADD_1 th)) 3020 \\ FULL_SIMP_TAC arith_ss []) 3021 3022val word_asr = Q.store_thm("word_asr", 3023 `!w:'a word n. w >> n = 3024 if word_msb w then 3025 (dimindex (:'a) - 1 '' dimindex (:'a) - n) UINT_MAXw || w >>> n 3026 else 3027 w >>> n`, 3028 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 3029 [word_asr_def, word_lsr_def, word_or_def, n2w_def, word_T, 3030 word_slice_def] 3031 \\ Cases_on `i + n < dimindex (:'a)` 3032 \\ SRW_TAC [ARITH_ss] []) 3033 3034val w2n_lsr = Q.store_thm ("w2n_lsr", 3035 `!w m. w2n (w >>> m) = (w2n w) DIV (2**m)`, 3036 Cases THEN 3037 SIMP_TAC std_ss [ONCE_REWRITE_RULE [GSYM w2n_11] word_lsr_n2w, 3038 simpLib.SIMP_PROVE arith_ss [MIN_DEF] ``MIN a (a + b) = a``, 3039 word_bits_n2w,w2n_n2w,MOD_DIMINDEX,bitTheory.BITS_COMP_THM2] THEN 3040 SIMP_TAC std_ss [bitTheory.BITS_THM2]) 3041 3042val WORD_MUL_LSL = Q.store_thm("WORD_MUL_LSL", 3043 `!a n. a << n = n2w (2 ** n) * a`, 3044 Cases 3045 \\ SRW_TAC [ARITH_ss] [word_lsl_n2w, word_mul_n2w, dimword_def] 3046 \\ `dimindex (:'a) <= n'` by DECIDE_TAC 3047 \\ IMP_RES_TAC LESS_EQUAL_ADD 3048 \\ SRW_TAC [ARITH_ss] [EXP_ADD, MOD_EQ_0, ZERO_LT_TWOEXP]) 3049 3050val WORD_ADD_LSL = Q.store_thm("WORD_ADD_LSL", 3051 `!n a b. (a + b) << n = a << n + b << n`, 3052 SRW_TAC [] [WORD_MUL_LSL, WORD_LEFT_ADD_DISTRIB]) 3053 3054val WORD_DIV_LSR = Q.store_thm("WORD_DIV_LSR", 3055 `!m:'a word n. n < dimindex (:'a) ==> (m >>> n = m // (n2w (2 ** n)))`, 3056 RW_TAC arith_ss [GSYM w2n_11, w2n_lsr, word_div_def, w2n_n2w] 3057 \\ `2 ** n < dimword (:'a)` by METIS_TAC [TWOEXP_MONO, dimword_def] 3058 \\ Cases_on `n = 0` 3059 \\ Cases_on `w2n m = 0` 3060 \\ ASM_SIMP_TAC arith_ss [w2n_lt, ZERO_DIV, ZERO_LT_TWOEXP] 3061 \\ `0 < n /\ 0 < w2n m` by DECIDE_TAC 3062 \\ `1 < 2 ** n` by ASM_SIMP_TAC std_ss [ONE_LT_EXP] 3063 \\ `w2n m DIV 2 ** n < w2n m` by METIS_TAC [DIV_LESS] 3064 \\ METIS_TAC [LESS_TRANS, w2n_lt]) 3065 3066val WORD_MOD_1 = Q.store_thm("WORD_MOD_1", 3067 `!m. word_mod m 1w = 0w`, 3068 SRW_TAC [] [word_mod_def]) 3069 3070val WORD_MOD_POW2 = Q.store_thm("WORD_MOD_POW2", 3071 `!m:'a word v. 3072 v < dimindex(:'a) - 1 ==> (word_mod m (n2w (2 ** SUC v)) = (v -- 0) m)`, 3073 Cases 3074 \\ SRW_TAC [ARITH_ss] 3075 [BITS_ZERO3, word_mod_def, word_bits_n2w, arithmeticTheory.MIN_DEF] 3076 \\ `2 ** SUC v < dimword(:'a)` by SRW_TAC [ARITH_ss] [dimword_def] 3077 \\ SRW_TAC [ARITH_ss] []) 3078 3079val SHIFT_1_SUB_1 = Q.store_thm("SHIFT_1_SUB_1", 3080 `!i n. i < dimindex (:'a) ==> 3081 (((1w : 'a word) << n - 1w) ' i = i < n)`, 3082 SRW_TAC [] [WORD_MUL_LSL, word_mul_n2w, GSYM n2w_sub] 3083 \\ SRW_TAC [fcpLib.FCP_ss] [word_index, bitTheory.BIT_EXP_SUB1]) 3084 3085val LSR_BITWISE = Q.store_thm("LSR_BITWISE", 3086 `(!n v:'a word w:'a word. w >>> n && v >>> n = ((w && v) >>> n)) /\ 3087 (!n v:'a word w:'a word. w >>> n || v >>> n = ((w || v) >>> n)) /\ 3088 (!n v:'a word w:'a word. w >>> n ?? v >>> n = ((w ?? v) >>> n))`, 3089 SHIFT_WORD_TAC \\ Cases_on `i + n < dimindex(:'a)` 3090 \\ ASM_SIMP_TAC fcp_ss []) 3091 3092val LSL_BITWISE = Q.store_thm("LSL_BITWISE", 3093 `(!n v:'a word w:'a word. w << n && v << n = ((w && v) << n)) /\ 3094 (!n v:'a word w:'a word. w << n || v << n = ((w || v) << n)) /\ 3095 (!n v:'a word w:'a word. w << n ?? v << n = ((w ?? v) << n))`, 3096 SHIFT_WORD_TAC >| [PROVE_TAC [], PROVE_TAC [], ALL_TAC] 3097 \\ Cases_on `n <= i` \\ ASM_SIMP_TAC arith_ss []) 3098 3099val ROR_BITWISE = Q.store_thm("ROR_BITWISE", 3100 `(!n v:'a word w:'a word. w #>> n && v #>> n = ((w && v) #>> n)) /\ 3101 (!n v:'a word w:'a word. w #>> n || v #>> n = ((w || v) #>> n)) /\ 3102 (!n v:'a word w:'a word. w #>> n ?? v #>> n = ((w ?? v) #>> n))`, 3103 SHIFT_WORD_TAC) 3104 3105val ROL_BITWISE = Q.store_thm("ROL_BITWISE", 3106 `(!n v w. w #<< n && v #<< n = (w && v) #<< n) /\ 3107 (!n v w. w #<< n || v #<< n = (w || v) #<< n) /\ 3108 !n v w. w #<< n ?? v #<< n = (w ?? v) #<< n`, 3109 SRW_TAC [] [word_rol_def, ROR_BITWISE]) 3110 3111val WORD_2COMP_LSL = Q.store_thm("WORD_2COMP_LSL", 3112 `!n a. (- a) << n = - (a << n)`, 3113 SRW_TAC [] [WORD_MUL_LSL, WORD_NEG_RMUL]) 3114 3115val w2w_LSL = Q.store_thm("w2w_LSL", 3116 `!w:'a word n. 3117 w2w (w << n):'b word = 3118 if n < dimindex (:'a) then 3119 (w2w ((dimindex (:'a) - 1 - n -- 0) w)) << n 3120 else 3121 0w`, 3122 SRW_TAC [] [] 3123 \\ FULL_SIMP_TAC arith_ss [NOT_LESS, LSL_LIMIT, ZERO_SHIFT, w2w_0] 3124 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 3125 [w2w, word_0, word_lsl_def, word_bits_def] 3126 \\ Cases_on `i < dimindex (:'a)` 3127 \\ Cases_on `i - n < dimindex (:'a)` 3128 \\ FULL_SIMP_TAC (fcp_ss++ARITH_ss) 3129 [DIMINDEX_GT_0, NOT_LESS, NOT_LESS_EQUAL]) 3130 3131val n2w_DIV = Q.store_thm("n2w_DIV", 3132 `!a n. a < dimword (:'a) ==> (n2w (a DIV (2 ** n)) :'a word = n2w a >>> n)`, 3133 REPEAT strip_tac 3134 \\ Cases_on `n < dimindex(:'a)` 3135 >- (RW_TAC std_ss [WORD_DIV_LSR, word_div_def, w2n_n2w, n2w_11] 3136 \\ `2 ** n < dimword (:'a)` by METIS_TAC [TWOEXP_MONO, dimword_def] 3137 \\ ASM_SIMP_TAC arith_ss 3138 [DIV_MOD_MOD_DIV, ZERO_LT_TWOEXP, ZERO_LT_dimword]) 3139 \\ `a DIV 2 ** n = 0` 3140 by metis_tac [arithmeticTheory.LESS_DIV_EQ_ZERO, arithmeticTheory.NOT_LESS, 3141 dimword_def, bitTheory.TWOEXP_MONO2, 3142 arithmeticTheory.LESS_LESS_EQ_TRANS] 3143 \\ fs [LSR_LIMIT, arithmeticTheory.NOT_LESS] 3144 ) 3145 3146val WORD_BITS_LSL = Q.store_thm("WORD_BITS_LSL", 3147 `!h l n w:'a word. h < dimindex(:'a) ==> 3148 ((h -- l) (w << n) = 3149 if n <= h then 3150 (h - n -- l - n) w << (n - l) 3151 else 3152 0w)`, 3153 REPEAT STRIP_TAC \\ Cases_on `h < l` 3154 \\ RW_TAC arith_ss [LSL_LIMIT, WORD_BITS_ZERO] 3155 \\ FULL_SIMP_TAC arith_ss 3156 [NOT_LESS, NOT_LESS_EQUAL, LSL_LIMIT, WORD_BITS_ZERO2, ZERO_SHIFT] 3157 >| [ 3158 Cases_on `n <= l` 3159 >| [`n - l = 0` by DECIDE_TAC, 3160 FULL_SIMP_TAC std_ss [NOT_LESS_EQUAL] \\ `l - n = 0` by DECIDE_TAC] 3161 \\ ASM_REWRITE_TAC [SHIFT_ZERO], 3162 Cases_on `dimindex (:'a) <= n` 3163 \\ FULL_SIMP_TAC std_ss [NOT_LESS_EQUAL, LSL_LIMIT, WORD_BITS_ZERO2]] 3164 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_bits_def, word_lsl_def, word_0] 3165 \\ Cases_on `i + l <= h /\ i + l <= dimindex (:'a) - 1` 3166 \\ FULL_SIMP_TAC (fcp_ss++ARITH_ss) []) 3167 3168val WORD_EXTRACT_LSL = Q.store_thm("WORD_EXTRACT_LSL", 3169 `!h l n w:'a word. h < dimindex(:'a) ==> 3170 ((h >< l) (w << n) = 3171 if n <= h then 3172 (h - n >< l - n) w << (n - l) 3173 else 3174 0w)`, 3175 SRW_TAC [] [DIMINDEX_GT_0, w2w_LSL, word_extract_def, 3176 WORD_BITS_LSL, w2w_n2w, BITS_ZERO2] 3177 \\ SRW_TAC [] [WORD_BITS_COMP_THM] 3178 >| [ 3179 `h - n <= dimindex (:'a) - 1 - (n - l) + (l - n)` by DECIDE_TAC 3180 \\ ASM_SIMP_TAC std_ss [MIN_FST], 3181 FULL_SIMP_TAC arith_ss [NOT_LESS]]) 3182 3183val WORD_EXTRACT_LSL2 = Q.store_thm("WORD_EXTRACT_LSL2", 3184 `!h l n w:'a word. dimindex(:'b) + l <= h + n ==> 3185 ((h >< l) w << n = 3186 (((dimindex(:'b) + l - (n + 1)) >< l) w << n) : 'b word)`, 3187 SRW_TAC [ARITH_ss, fcpLib.FCP_ss] 3188 [DIMINDEX_GT_0, word_lsl_def, word_extract_def, w2w, word_bits_def] 3189 THEN Cases_on `i < n + dimindex(:'a)` 3190 THEN SRW_TAC [ARITH_ss, fcpLib.FCP_ss,boolSimps.CONJ_ss] [DIMINDEX_GT_0]) 3191 3192val EXTRACT_JOIN_LSL = Q.store_thm("EXTRACT_JOIN_LSL", 3193 `!h m m' l s n w:'a word. 3194 l <= m /\ m' <= h /\ (m' = m + 1) /\ (s = m' - l + n) ==> 3195 ((h >< m') w << s || (m >< l) w << n = 3196 ((MIN h (MIN (dimindex(:'b) + l - 1) 3197 (dimindex(:'a) - 1)) >< l) w << n) :'b word)`, 3198 SRW_TAC [] [GSYM LSL_ADD, LSL_BITWISE] 3199 \\ Q.ABBREV_TAC `m' = m + 1` 3200 \\ Q.ABBREV_TAC `s' = m' - l` 3201 \\ ASM_SIMP_TAC std_ss [EXTRACT_JOIN]) 3202 3203val EXTRACT_JOIN_ADD_LSL = Q.store_thm("EXTRACT_JOIN_ADD_LSL", 3204 `!h m m' l s n w:'a word. 3205 l <= m /\ m' <= h /\ (m' = m + 1) /\ (s = m' - l + n) ==> 3206 ((h >< m') w << s + (m >< l) w << n = 3207 ((MIN h (MIN (dimindex(:'b) + l - 1) 3208 (dimindex(:'a) - 1)) >< l) w << n) :'b word)`, 3209 SRW_TAC [] [GSYM LSL_ADD, GSYM WORD_ADD_LSL] 3210 \\ Q.ABBREV_TAC `m' = m + 1` 3211 \\ Q.ABBREV_TAC `s' = m' - l` 3212 \\ ASM_SIMP_TAC std_ss [EXTRACT_JOIN_ADD]) 3213 3214val word_extract_mask1 = Q.prove( 3215 `!h l a. 3216 (h >< l) a = 3217 if l <= h then a >>> l && (1w << (1 + (h - l)) - 1w) else 0w`, 3218 rw_tac (arith_ss++fcpLib.FCP_ss) 3219 [SHIFT_1_SUB_1, word_and_def, word_extract_def, word_lsr_def, 3220 word_bits_def, w2w, word_0, 3221 DECIDE ``l <= h ==> (i + l <= h = i < h + 1 - l)``] 3222 \\ Cases_on `i + l < dimindex (:'a)` 3223 \\ lrw [] 3224 \\ decide_tac 3225 ) 3226 3227val word_bits_mask1 = SIMP_RULE std_ss [GSYM WORD_BITS_EXTRACT] 3228 word_extract_mask1 3229 3230val word_extract_w2w_mask1 = Q.prove( 3231 `!h l a. 3232 (h >< l) a = 3233 w2w (if l <= h then a >>> l && (1w << (1 + (h - l)) - 1w) else 0w)`, 3234 SRW_TAC [] [word_extract_def, word_bits_mask1]) 3235 3236val word_extract_mask = save_thm("word_extract_mask", 3237 SIMP_RULE std_ss [word_add_n2w, GSYM LSL_ADD, LSL_ONE] word_extract_mask1) 3238 3239val word_bits_mask = save_thm("word_bits_mask", 3240 SIMP_RULE std_ss [word_add_n2w, GSYM LSL_ADD, LSL_ONE] word_bits_mask1) 3241 3242val word_extract_w2w_mask = save_thm("word_extract_w2w_mask", 3243 SIMP_RULE std_ss [word_add_n2w, GSYM LSL_ADD, LSL_ONE] word_extract_w2w_mask1) 3244 3245val word_shift_bv = Q.store_thm("word_shift_bv", 3246 `(!w:'a word n. n < dimword (:'a) ==> (w << n = w <<~ n2w n)) /\ 3247 (!w:'a word n. n < dimword (:'a) ==> (w >> n = w >>~ n2w n)) /\ 3248 (!w:'a word n. n < dimword (:'a) ==> (w >>> n = w >>>~ n2w n)) /\ 3249 (!w:'a word n. (w #>> n = w #>>~ n2w (n MOD dimindex(:'a)))) /\ 3250 (!w:'a word n. (w #<< n = w #<<~ n2w (n MOD dimindex(:'a))))`, 3251 SRW_TAC [] 3252 [word_lsl_bv_def, word_lsr_bv_def, word_asr_bv_def, 3253 word_ror_bv_def, word_rol_bv_def] 3254 \\ `n MOD dimindex(:'a) < dimword(:'a)` 3255 by METIS_TAC [DIMINDEX_GT_0, arithmeticTheory.MOD_LESS, 3256 arithmeticTheory.LESS_TRANS, dimindex_lt_dimword] 3257 \\ SRW_TAC [ARITH_ss] [ROR_MOD, ROL_MOD] 3258 ) 3259 3260val lsl_lsr = Q.store_thm("lsl_lsr", 3261 `!w: 'a word n. 3262 w2n (w : 'a word) * 2 ** n < dimword (:'a) ==> (w << n >>> n = w)`, 3263 Cases 3264 \\ strip_tac 3265 \\ qmatch_assum_rename_tac `n < dimword _` 3266 \\ simp [] 3267 \\ rewrite_tac [GSYM w2n_11, w2n_lsr] 3268 \\ rw [word_lsl_n2w, MULT_DIV, ZERO_DIV] 3269 \\ Cases_on `n` 3270 \\ fs [dimword_def, bitTheory.LT_TWOEXP, bitTheory.LOG2_def] 3271 \\ qmatch_asmsub_rename_tac `SUC n * 2 ** a` 3272 \\ qspecl_then [`a`, `2`, `SUC n`] mp_tac logrootTheory.LOG_EXP 3273 \\ simp[] 3274 ) 3275 3276(* ------------------------------------------------------------------------- 3277 Orderings : theorems 3278 ------------------------------------------------------------------------- *) 3279 3280val EQUAL_THEN_SUB_ZERO = GEN_ALL (PROVE [WORD_SUB_REFL,WORD_LCANCEL_SUB] 3281 ``((a - b) = 0w) = (a = b)``) 3282 3283val order_rule = 3284 SIMP_RULE (std_ss++boolSimps.LET_ss) 3285 [nzcv_def,GSYM word_add_n2w,n2w_w2n,GSYM word_sub_def,EQUAL_THEN_SUB_ZERO] 3286 3287val word_lt = order_rule word_lt_def 3288val word_gt = order_rule word_gt_def 3289val word_le = order_rule word_le_def 3290val word_ge = order_rule word_ge_def 3291val word_ls = order_rule word_ls_def 3292val word_hi = order_rule word_hi_def 3293val word_lo = order_rule word_lo_def 3294val word_hs = order_rule word_hs_def 3295 3296val SPEC_LESS_EXP_SUC_MONO = Q.prove( 3297 `2 ** ^HB < 2 ** dimindex (:'a)`, 3298 SRW_TAC [][DIMINDEX_GT_0]) 3299 3300val SPLIT_2_EXP_WL = Q.prove( 3301 `^dimword_ML = ^INT_MIN_ML + ^INT_MIN_ML`, 3302 STRIP_ASSUME_TAC EXISTS_HB 3303 \\ ASM_SIMP_TAC arith_ss [EXP]) 3304 3305val WORD_NEG_L = Q.store_thm("WORD_NEG_L", 3306 `- word_L = word_L`, 3307 SRW_TAC [][word_2comp_n2w, word_L_def, LESS_MOD, DIMINDEX_GT_0, dimword_def, 3308 INT_MIN_def, SUB_RIGHT_EQ, SPLIT_2_EXP_WL]) 3309 3310val word_L_MULT_NEG = Q.store_thm("word_L_MULT_NEG", 3311 `!n. - (n2w n) * INT_MINw = if EVEN n then 0w else INT_MINw`, 3312 ONCE_REWRITE_TAC [WORD_NEG_MUL] 3313 \\ SRW_TAC [] [GSYM WORD_MULT_ASSOC, word_L_MULT, WORD_MULT_CLAUSES] 3314 \\ SRW_TAC [] [GSYM WORD_NEG_MUL, WORD_NEG_L]) 3315 3316val word_L2_MULT = Q.store_thm("word_L2_MULT", 3317 `(word_L2 * word_L2 = word_L2) /\ 3318 (INT_MINw * word_L2 = word_L2) /\ 3319 (!n. n2w n * word_L2 = if EVEN n then 0w else word_L2) /\ 3320 (!n. - (n2w n) * word_L2 = if EVEN n then 0w else word_L2)`, 3321 RW_TAC std_ss ([word_L2_def, word_L_def, WORD_MULT_CLAUSES] @ 3322 map (ONCE_REWRITE_RULE [word_L_def]) 3323 [word_L_MULT, word_L_MULT_NEG])); 3324 3325(* ------------------------------------------------------------------------- *) 3326 3327val BITS_COMP_MSB = (SIMP_RULE arith_ss [] o 3328 Q.SPECL [`m`,`0`,`m - 1`,`0`]) BITS_COMP_THM 3329 3330val SLICE_COMP_MSB = Q.prove( 3331 `!b n. ~(b = 0) ==> (SLICE b b n + SLICE (b - 1) 0 n = SLICE b 0 n)`, 3332 REPEAT STRIP_TAC 3333 \\ POP_ASSUM (fn th => REWRITE_TAC [(SIMP_RULE arith_ss [SUB_SUC1,th] o 3334 Q.SPECL [`b`,`b - 1`,`0`,`n`]) SLICE_COMP_THM])) 3335 3336val MSB_THM1 = Q.prove( 3337 `!a:'a word. ~(^HB = 0) /\ word_msb a ==> 3338 (w2n a = ^INT_MIN_ML + BITS (^HB - 1) 0 (w2n a))`, 3339 Cases \\ POP_ASSUM (K ALL_TAC) \\ STRIP_ASSUME_TAC EXISTS_HB 3340 \\ RW_TAC arith_ss [word_msb_n2w,w2n_n2w,GSYM BITS_ZERO3,BITS_COMP_MSB, 3341 dimword_def] 3342 \\ IMP_RES_TAC BIT_SLICE_THM2 \\ POP_ASSUM (SUBST1_TAC o SYM) 3343 \\ ASM_SIMP_TAC arith_ss [SLICE_COMP_MSB,GSYM SLICE_ZERO_THM]) 3344 3345val MSB_THM2 = Q.prove( 3346 `!a:'a word. ~(^HB = 0) /\ word_msb a ==> 3347 (w2n (- a) = ^INT_MIN_ML - BITS (^HB - 1) 0 (w2n a))`, 3348 Cases \\ POP_ASSUM (K ALL_TAC) \\ REPEAT STRIP_TAC \\ IMP_RES_TAC MSB_THM1 3349 \\ STRIP_ASSUME_TAC EXISTS_HB 3350 \\ FULL_SIMP_TAC arith_ss [word_msb_n2w,word_2comp_n2w,w2n_n2w, 3351 BITS_COMP_MSB,GSYM BITS_ZERO3, dimword_def] 3352 \\ ASM_SIMP_TAC arith_ss [BITS_ZERO3,GSYM ADD1,ADD_MODULUS,MOD_MOD, 3353 ZERO_LT_TWOEXP,SUB_SUC1] 3354 \\ REWRITE_TAC [EXP,TIMES2,SUB_PLUS,ADD_SUB] 3355 \\ `2 ** m - n MOD 2 ** m < 2 ** SUC m` by METIS_TAC 3356 [DECIDE ``a - b <= a /\ a < SUC a``,TWOEXP_MONO,LESS_EQ_LESS_TRANS] 3357 \\ ASM_SIMP_TAC arith_ss [GSYM EXP,LESS_MOD]) 3358 3359val MSB_THM3 = Q.prove( 3360 `!a:'a word. ~(^HB = 0) /\ ~word_msb a ==> 3361 (w2n a = BITS (^HB - 1) 0 (w2n a))`, 3362 Cases \\ POP_ASSUM (K ALL_TAC) \\ STRIP_ASSUME_TAC EXISTS_HB 3363 \\ RW_TAC arith_ss [word_msb_n2w,w2n_n2w,GSYM BITS_ZERO3,BITS_COMP_MSB, 3364 dimword_def] 3365 \\ `~(m = 0)` by DECIDE_TAC 3366 \\ MAP_EVERY IMP_RES_TAC [BIT_SLICE_THM3,SLICE_COMP_MSB] 3367 \\ POP_ASSUM (Q.SPEC_THEN `n` ASSUME_TAC) 3368 \\ Q.PAT_X_ASSUM `SLICE m m n = 0` (fn th => 3369 FULL_SIMP_TAC arith_ss [th,GSYM SLICE_ZERO_THM])) 3370 3371val MSB_THM4 = Q.prove( 3372 `!a:'a word. ~(^HB = 0) /\ ~(a = 0w) /\ ~word_msb a ==> 3373 (w2n (- a) = ^dimword_ML - BITS (^HB - 1) 0 (w2n a)) /\ 3374 ~(BITS (^HB - 1) 0 (w2n a) = 0)`, 3375 Cases \\ POP_ASSUM (K ALL_TAC) \\ REPEAT STRIP_TAC \\ IMP_RES_TAC MSB_THM3 3376 \\ STRIP_ASSUME_TAC EXISTS_HB 3377 \\ FULL_SIMP_TAC arith_ss [word_msb_n2w,word_2comp_n2w,w2n_n2w,n2w_11, 3378 GSYM BITS_ZERO3,BITS_ZERO2,BITS_COMP_MSB,dimword_def] 3379 \\ FULL_SIMP_TAC arith_ss [BITS_COMP_THM2,MIN_DEF] 3380 \\ `2 ** SUC m - BITS (m - 1) 0 n < 2 ** SUC m` 3381 by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3382 \\ ASM_SIMP_TAC bool_ss [BITS_ZEROL]) 3383 3384val HB_0_MSB = Q.prove( 3385 `!a:'a word. (^HB = 0) /\ word_msb a ==> (a = 1w)`, 3386 Cases \\ POP_ASSUM (K ALL_TAC) \\ STRIP_ASSUME_TAC EXISTS_HB 3387 \\ RW_TAC bool_ss [word_msb_n2w,w2n_n2w,n2w_11,BIT_def,SUC_SUB1,dimword_def] 3388 \\ FULL_SIMP_TAC arith_ss [BITS_ZERO3]) 3389 3390val HB_0_NOT_MSB = Q.prove( 3391 `!a:'a word. (^HB = 0) /\ ~word_msb a ==> (a = 0w)`, 3392 Cases \\ POP_ASSUM (K ALL_TAC) \\ STRIP_ASSUME_TAC EXISTS_HB 3393 \\ RW_TAC fcp_ss [word_msb_n2w,n2w_11,ZERO_MOD,ZERO_LT_TWOEXP, 3394 GSYM BITS_ZERO3,dimword_def] 3395 \\ METIS_TAC [DECIDE ``SUC m <= 1 = (m = 0)``,BIT_def,NOT_BITS2]) 3396 3397val DIMINDEX_1 = Q.prove( 3398 `(^WL - 1 = 0) ==> (^WL = 1)`, 3399 STRIP_ASSUME_TAC EXISTS_HB \\ ASM_SIMP_TAC arith_ss []) 3400 3401val MSB_THM1b = Q.prove( 3402 `!a:'a word. (^HB = 0) /\ word_msb a ==> (w2n a = 1)`, 3403 METIS_TAC [HB_0_MSB,DIMINDEX_1,EXP_1,LESS_MOD,DECIDE ``1 < 2``,w2n_n2w, 3404 dimword_def]) 3405 3406val MSB_THM2b = Q.prove( 3407 `!a:'a word. (^HB = 0) /\ word_msb a ==> (w2n (word_2comp a) = 1)`, 3408 REPEAT STRIP_TAC \\ MAP_EVERY IMP_RES_TAC [HB_0_MSB,DIMINDEX_1] 3409 \\ ASM_SIMP_TAC arith_ss [w2n_n2w,word_2comp_n2w,dimword_def]) 3410 3411val MSB_THM3b = Q.prove( 3412 `!a:'a word. (^HB = 0) /\ ~word_msb a ==> (w2n a = 0)`, 3413 REPEAT STRIP_TAC \\ MAP_EVERY IMP_RES_TAC [HB_0_NOT_MSB,DIMINDEX_1] 3414 \\ ASM_SIMP_TAC arith_ss [w2n_n2w,dimword_def]) 3415 3416val MSB_THM4b = Q.prove( 3417 `!a:'a word. (^HB = 0) /\ ~word_msb a ==> (w2n (word_2comp a) = 0)`, 3418 REPEAT STRIP_TAC \\ MAP_EVERY IMP_RES_TAC [HB_0_NOT_MSB,DIMINDEX_1] 3419 \\ ASM_SIMP_TAC arith_ss [w2n_n2w,WORD_NEG_0,dimword_def]) 3420 3421(* ------------------------------------------------------------------------- *) 3422 3423val w2n_mod = PROVE [n2w_w2n,n2w_mod,dimword_def] 3424 ``(w2n (a:'a word) = n) ==> (a = n2w (n MOD ^dimword_ML))`` 3425 3426val BITS_MSB_LT = (GEN_ALL o SIMP_RULE arith_ss [SUB_SUC1] o 3427 Q.DISCH `~(b = 0)` o Q.SPECL [`b - 1`,`0`,`a`]) BITSLT_THM 3428 3429val SLICE_MSB_LT = REWRITE_RULE [GSYM SLICE_ZERO_THM] BITS_MSB_LT 3430 3431val BITS_MSB_LTEQ = Q.prove( 3432 `!b a. ~(b = 0) ==> BITS (b - 1) 0 a <= 2 ** b`, 3433 PROVE_TAC [LESS_IMP_LESS_OR_EQ,BITS_MSB_LT]) 3434 3435val TWO_COMP_POS = Q.prove( 3436 `!a:'a word. ~word_msb a ==> 3437 (if a = 0w then ~word_msb (- a) else word_msb (- a))`, 3438 Cases 3439 \\ STRIP_ASSUME_TAC EXISTS_HB 3440 \\ RW_TAC bool_ss [WORD_NEG_0] 3441 \\ Cases_on `^HB = 0` >- PROVE_TAC [HB_0_NOT_MSB] 3442 \\ `~(m = 0)` by DECIDE_TAC 3443 \\ MAP_EVERY IMP_RES_TAC [MSB_THM4,w2n_mod] 3444 \\ Q.PAT_X_ASSUM `dimindex(:'a) = SUC m` (fn t => 3445 FULL_SIMP_TAC arith_ss [word_msb_n2w,BITS_COMP_THM2,MIN_DEF,BIT_def,t]) 3446 \\ `2 ** SUC m - BITS (m - 1) 0 (w2n ((n2w n):'a word)) < 2 ** SUC m /\ 3447 2 ** m - BITS (m - 1) 0 (w2n ((n2w n):'a word)) < 2 ** m` 3448 by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3449 \\ ASM_SIMP_TAC std_ss [LESS_MOD] \\ IMP_RES_TAC BITS_MSB_LTEQ 3450 \\ ASM_SIMP_TAC bool_ss [Q.SPECL [`m`,`m`] BITS_THM,SUC_SUB,EXP_1,EXP, 3451 TIMES2,LESS_EQ_ADD_SUB,DIV_MULT_1] \\ numLib.REDUCE_TAC) 3452 3453val TWO_COMP_NEG_lem = Q.prove( 3454 `!n. ~(^HB = 0) /\ ~((n2w n):'a word = word_L) /\ 3455 word_msb ((n2w n):'a word) ==> 3456 ~(BITS (^WL - 2) 0 (w2n ((n2w n):'a word)) = 0)`, 3457 REPEAT STRIP_TAC \\ STRIP_ASSUME_TAC EXISTS_HB 3458 \\ FULL_SIMP_TAC arith_ss [BITS_COMP_THM2,MIN_DEF,GSYM BITS_ZERO3, 3459 word_msb_n2w,w2n_n2w,dimword_def] 3460 \\ IMP_RES_TAC BIT_SLICE_THM2 3461 \\ RULE_ASSUM_TAC (REWRITE_RULE [GSYM SLICE_ZERO_THM]) 3462 \\ `~(m = 0)` by DECIDE_TAC \\ IMP_RES_TAC SLICE_COMP_MSB 3463 \\ POP_ASSUM (Q.SPEC_THEN `n` ASSUME_TAC) 3464 \\ FULL_SIMP_TAC arith_ss [word_L_def,n2w_11,LESS_MOD, 3465 SUC_SUB1,SUC_SUB2,TWOEXP_MONO,dimword_def,INT_MIN_def] 3466 \\ FULL_SIMP_TAC bool_ss [GSYM BITS_ZERO3,GSYM SLICE_ZERO_THM] 3467 \\ PROVE_TAC [ADD_0]) 3468 3469val TWO_COMP_NEG = Q.store_thm("TWO_COMP_NEG", 3470 `!a:'a word. word_msb a ==> 3471 if (^HB = 0) \/ (a = word_L) then 3472 word_msb (word_2comp a) 3473 else 3474 ~word_msb (word_2comp a)`, 3475 RW_TAC bool_ss [] >| [ 3476 IMP_RES_TAC HB_0_MSB 3477 \\ ASM_SIMP_TAC arith_ss [word_msb_n2w,word_T_def,WORD_NEG_1, 3478 DIMINDEX_GT_0,ONE_COMP_0_THM,UINT_MAX_def,dimword_def], 3479 ASM_REWRITE_TAC [WORD_NEG_L], 3480 FULL_SIMP_TAC bool_ss [] \\ Cases_on `a` 3481 \\ MAP_EVERY IMP_RES_TAC [MSB_THM2,w2n_mod,TWO_COMP_NEG_lem] 3482 \\ STRIP_ASSUME_TAC EXISTS_HB \\ `~(m = 0)` by DECIDE_TAC 3483 \\ FULL_SIMP_TAC arith_ss [BITS_COMP_THM2,MIN_DEF,BIT_def, 3484 word_msb_n2w,w2n_n2w,GSYM BITS_ZERO3,SUC_SUB2,dimword_def] 3485 \\ `2 ** m - BITS (m - 1) 0 n < 2 ** m` 3486 by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3487 \\ ASM_SIMP_TAC arith_ss [BITS_THM,SUC_SUB,EXP_1,LESS_DIV_EQ_ZERO]]) 3488 3489val TWO_COMP_POS_NEG = Q.store_thm("TWO_COMP_POS_NEG", 3490 `!a:'a word. 3491 a <> 0w /\ a <> word_L ==> (~word_msb a = word_msb (word_2comp a))`, 3492 REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC 3493 >- METIS_TAC [TWO_COMP_POS] 3494 \\ `^HB <> 0` 3495 by (spose_not_then assume_tac 3496 \\ `dimindex(:'a) = 1n` 3497 by metis_tac [DIMINDEX_GT_0, DECIDE ``0 < i /\ (i - 1 = 0n) ==> (i = 1)``] 3498 \\ strip_assume_tac (Q.SPEC `a` ranged_word_nchotomy) 3499 \\ fs [word_L_def, INT_MIN_def, dimword_def] 3500 \\ rfs [] 3501 \\ fs []) 3502 \\ METIS_TAC [WORD_NEG_L,WORD_NEG_EQ,WORD_NEG_NEG,TWO_COMP_NEG]) 3503 3504val WORD_0_POS = Q.store_thm("WORD_0_POS", 3505 `~word_msb 0w`, REWRITE_TAC [word_msb_n2w,BIT_ZERO]) 3506 3507val TWO_COMP_POS = save_thm("TWO_COMP_POS", 3508 METIS_PROVE [TWO_COMP_POS, WORD_NEG_0, WORD_0_POS] 3509 ``!a. ~word_msb a ==> (a = 0w) \/ word_msb (- a)``) 3510 3511val WORD_H_POS = Q.store_thm("WORD_H_POS", 3512 `~word_msb word_H`, 3513 `^INT_MIN_ML - 1 < ^INT_MIN_ML` by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3514 \\ ASM_SIMP_TAC bool_ss [word_H_def,word_msb_n2w,BIT_def,BITS_THM, 3515 LESS_DIV_EQ_ZERO,ZERO_MOD,ZERO_LT_TWOEXP,INT_MIN_def,INT_MAX_def] 3516 \\ DECIDE_TAC) 3517 3518val WORD_L_NEG = Q.store_thm("WORD_L_NEG", 3519 `word_msb word_L`, 3520 REWRITE_TAC [word_L_def,word_msb_n2w,BIT_ZERO,BIT_B,INT_MIN_def]) 3521 3522(* ------------------------------------------------------------------------- *) 3523 3524val NOT_EQUAL_THEN_NOT = 3525 PROVE [EQUAL_THEN_SUB_ZERO] ``!a b. ~(a = b) = ~(b - a = 0w)`` 3526 3527val SUB_EQUAL_WORD_L_INT_MIN = Q.prove( 3528 `!a:'a word b:'a word. ~(^HB = 0) /\ (a - b = word_L) ==> 3529 ~(word_msb a = word_msb b)`, 3530 RW_TAC bool_ss [WORD_EQ_SUB_RADD] \\ STRIP_ASSUME_TAC EXISTS_HB 3531 \\ `~(m = 0)` by DECIDE_TAC \\ Cases_on `b` 3532 \\ ASM_REWRITE_TAC [word_msb_n2w,word_L_def,SUC_SUB1,INT_MIN_def] 3533 \\ SUBST1_TAC ((SYM o Q.SPEC `n`) n2w_mod) 3534 \\ ASM_REWRITE_TAC [word_msb_n2w,word_add_n2w,SUC_SUB1, 3535 GSYM BITS_ZERO3,GSYM SLICE_ZERO_THM,dimword_def] 3536 \\ `SLICE m 0 n = SLICE m m n + SLICE (m - 1) 0 n` 3537 by METIS_TAC [SLICE_COMP_MSB,SUC_SUB2] 3538 \\ Cases_on `BIT m n` 3539 >| [IMP_RES_TAC BIT_SLICE_THM2,IMP_RES_TAC BIT_SLICE_THM3] 3540 \\ ASM_SIMP_TAC arith_ss [BIT_def,BITS_THM,SUC_SUB,EXP_1,SLICE_MSB_LT, 3541 DIV_MULT,DIV_MULT_1]) 3542 3543val LEM1_TAC = 3544 REPEAT STRIP_TAC 3545 \\ MAP_EVERY Cases_on [`word_msb a`,`word_msb b`,`a = b`] 3546 \\ FULL_SIMP_TAC bool_ss [word_lt,word_gt,word_le,word_ge, 3547 WORD_SUB_REFL,WORD_0_POS,DECIDE (Term `~(a = ~a)`)] 3548 \\ GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) 3549 empty_rewrites [GSYM WORD_NEG_SUB] 3550 \\ IMP_RES_TAC NOT_EQUAL_THEN_NOT \\ Cases_on `b - a = word_L` 3551 \\ PROVE_TAC [SUB_EQUAL_WORD_L_INT_MIN,TWO_COMP_POS_NEG] 3552 3553val LEM2_TAC = 3554 REPEAT STRIP_TAC \\ MAP_EVERY Cases_on [`word_msb a`,`word_msb b`] 3555 \\ MAP_EVERY IMP_RES_TAC [MSB_THM1b,MSB_THM2b,MSB_THM3b,MSB_THM4b] 3556 \\ ASM_SIMP_TAC arith_ss [word_lt,word_gt,word_le,word_ge,word_sub_def, 3557 word_add_def,word_add_n2w,word_msb_n2w,n2w_11,BITS_ZERO2,BIT_def, 3558 dimword_def] 3559 \\ ASM_SIMP_TAC arith_ss [BITS_ZERO3] 3560 \\ PROVE_TAC [w2n_11] 3561 3562val WORD_GREATER = Q.store_thm("WORD_GREATER", 3563 `!a:'a word b. a > b = b < a`, 3564 Cases_on `^HB = 0` >| [LEM2_TAC,LEM1_TAC]) 3565 3566val WORD_GREATER_EQ = Q.store_thm("WORD_GREATER_EQ", 3567 `!a:'a word b. a >= b = b <= a`, 3568 Cases_on `^HB = 0` >| [LEM2_TAC,LEM1_TAC]) 3569 3570val WORD_NOT_LESS = Q.store_thm("WORD_NOT_LESS", 3571 `!a:'a word b. ~(a < b) = b <= a`, 3572 Cases_on `^HB = 0` >| [LEM2_TAC,LEM1_TAC]) 3573 3574(* ------------------------------------------------------------------------- *) 3575 3576val LESS_EQ_ADD2 = DECIDE (Term `!a:num b c. a + b <= a + c ==> b <= c`) 3577val LESS_ADD2 = DECIDE (Term `!a:num b c. a + b < a + c ==> b < c`) 3578val LESS_EQ_ADD_SUB2 = 3579 DECIDE (Term `!m:num n p. p <= n ==> (m + p - n = m - (n - p))`) 3580 3581val start_tac = 3582 REWRITE_TAC [word_sub_def,word_add_def] \\ RW_TAC bool_ss [word_msb_n2w] 3583 \\ POP_ASSUM MP_TAC \\ Cases_on `w2n a < w2n b` 3584 \\ ASM_REWRITE_TAC [] \\ IMP_RES_TAC MSB_THM1 3585 \\ `w2n (- b) = ^INT_MIN_ML - BITS (^HB - 1) 0 (w2n b)` 3586 by IMP_RES_TAC MSB_THM2 3587 \\ Q.ABBREV_TAC `x = BITS (^HB - 1) 0 (w2n a)` 3588 \\ Q.ABBREV_TAC `y = BITS (^HB - 1) 0 (w2n b)` 3589 \\ FULL_SIMP_TAC bool_ss [NOT_LESS,GSYM LESS_EQ_ADD_SUB,BITS_MSB_LT, 3590 DECIDE (Term `!a b. a + b + a = 2 * a + b`)] 3591 3592val WORD_LT_lem = Q.prove( 3593 `!a:'a word b. ~(^HB = 0) /\ word_msb a /\ 3594 word_msb b /\ word_msb (a - b) ==> w2n a < w2n b`, 3595 start_tac \\ IMP_RES_TAC LESS_EQ_ADD2 3596 \\ ASM_SIMP_TAC bool_ss [Abbr`x`,Abbr`y`,LESS_EQ_ADD_SUB2,BIT_def, 3597 BITS_THM,SUC_SUB,EXP_1,DIV_1,SUB_0,CONJUNCT1 EXP,LESS_EQ_ADD_SUB, 3598 NOT_MOD2_LEM2,SUB_SUC1] 3599 \\ SIMP_TAC arith_ss [MOD_2EXP_LT,SUB_LEFT_ADD, 3600 DECIDE ``a < b ==> ~(b <= a:num)``] 3601 \\ Q.PAT_X_ASSUM `~(x = 0)` ASSUME_TAC \\ STRIP_ASSUME_TAC EXISTS_HB 3602 \\ FULL_SIMP_TAC bool_ss [SUC_SUB1,BITS_ZERO3,LESS_EQ_ADD_SUB,SUB_SUC1, 3603 DECIDE ``a < c /\ b < c ==> (a - b) < c:num``,MOD_2EXP_LT,DIV_MULT, 3604 DIVMOD_ID,DECIDE ``0 < 2``]) 3605 3606val WORD_LT_lem2 = Q.prove( 3607 `!a:'a word b. ~(^HB = 0) /\ word_msb a /\ word_msb b /\ 3608 ~word_msb (a - b) ==> ~(w2n a < w2n b)`, 3609 start_tac 3610 \\ ONCE_REWRITE_TAC [DECIDE (Term `!a b c. (a:num) + b + c = a + c + b`)] 3611 \\ Q.PAT_X_ASSUM `2 ** N + _ < 2 ** N + _` 3612 (ASSUME_TAC o (MATCH_MP LESS_ADD2)) 3613 \\ IMP_RES_TAC LESS_ADD_1 3614 \\ `y < ^INT_MIN_ML` by METIS_TAC [BITS_MSB_LT] 3615 \\ `p + 1 <= ^INT_MIN_ML` by DECIDE_TAC 3616 \\ ASM_SIMP_TAC arith_ss [SUB_LEFT_ADD] \\ IMP_RES_TAC LESS_EQUAL_ADD 3617 \\ ASM_SIMP_TAC std_ss [TIMES2,DECIDE ``x + (y + p) = x + p + y:num``, 3618 DECIDE ``a + b + c - (c + b) = a:num``] 3619 \\ `p' < p + 1 + p'` by DECIDE_TAC 3620 \\ ASM_SIMP_TAC bool_ss [BIT_def,BITS_THM,SUC_SUB,EXP_1,DIV_MULT_1] 3621 \\ numLib.REDUCE_TAC) 3622 3623val w2n_0 = 3624 SIMP_CONV arith_ss [w2n_n2w,ZERO_MOD,ZERO_LT_TWOEXP,dimword_def] ``w2n 0w`` 3625 3626val start_tac = REWRITE_TAC [word_sub_def,word_add_def] 3627 \\ NTAC 2 STRIP_TAC 3628 \\ Cases_on `b = 0w` 3629 >- (ASM_REWRITE_TAC [WORD_NEG_0,w2n_0,ADD_0,n2w_w2n] 3630 \\ PROVE_TAC [prim_recTheory.NOT_LESS_0]) 3631 \\ RW_TAC bool_ss [word_msb_n2w] 3632 \\ POP_ASSUM MP_TAC 3633 \\ Cases_on `w2n a < w2n b` \\ ASM_REWRITE_TAC [] 3634 \\ IMP_RES_TAC MSB_THM3 3635 \\ `w2n (- b) = ^dimword_ML - BITS (^HB - 1) 0 (w2n b)` 3636 by IMP_RES_TAC MSB_THM4 3637 \\ Q.ABBREV_TAC `x = BITS (^HB - 1) 0 (w2n a)` 3638 \\ Q.ABBREV_TAC `y = BITS (^HB - 1) 0 (w2n b)` 3639 \\ `y <= ^INT_MIN_ML` by METIS_TAC [BITS_MSB_LTEQ] 3640 \\ `y <= ^dimword_ML` by METIS_TAC [SPEC_LESS_EXP_SUC_MONO, 3641 LESS_IMP_LESS_OR_EQ,LESS_EQ_TRANS] 3642 \\ FULL_SIMP_TAC bool_ss [NOT_LESS,GSYM LESS_EQ_ADD_SUB] 3643 \\ ONCE_REWRITE_TAC [ADD_COMM] 3644 3645val WORD_LT_lem3 = Q.prove( 3646 `!a:'a word b. ~(^HB = 0) /\ ~word_msb a /\ ~word_msb b /\ 3647 word_msb (a - b) ==> w2n a < w2n b`, 3648 start_tac \\ `x < ^INT_MIN_ML` by METIS_TAC [BITS_MSB_LT] 3649 \\ `x - y < ^INT_MIN_ML` by DECIDE_TAC 3650 \\ STRIP_ASSUME_TAC EXISTS_HB 3651 \\ FULL_SIMP_TAC bool_ss [BIT_def,BITS_THM,SUC_SUB,EXP_1, 3652 LESS_EQ_ADD_SUB,EXP,DIV_MULT,SUC_SUB1] 3653 \\ numLib.REDUCE_TAC) 3654 3655val WORD_LT_lem4 = Q.prove( 3656 `!a:'a word b. ~(^HB = 0) /\ ~word_msb a /\ ~word_msb b /\ 3657 ~word_msb (a - b) ==> ~(w2n a < w2n b)`, 3658 start_tac 3659 \\ `y <= ^INT_MIN_ML + x` by DECIDE_TAC 3660 \\ ASM_SIMP_TAC bool_ss [SPLIT_2_EXP_WL,GSYM ADD_ASSOC,LESS_EQ_ADD_SUB] 3661 \\ IMP_RES_TAC LESS_IMP_LESS_OR_EQ 3662 \\ `^INT_MIN_ML - (y - x) < ^INT_MIN_ML` by DECIDE_TAC 3663 \\ STRIP_ASSUME_TAC EXISTS_HB 3664 \\ FULL_SIMP_TAC bool_ss [LESS_EQ_ADD_SUB2,DIV_MULT_1,BIT_def, 3665 BITS_THM,SUC_SUB,EXP_1] 3666 \\ numLib.REDUCE_TAC) 3667 3668val WORD_LT = Q.store_thm("WORD_LT", 3669 `!a b. word_lt a b = (word_msb a = word_msb b) /\ w2n a < w2n b \/ 3670 word_msb a /\ ~word_msb b`, 3671 Tactical.REVERSE (Cases_on `^HB = 0`) \\ REPEAT STRIP_TAC 3672 >- METIS_TAC [word_lt,WORD_LT_lem,WORD_LT_lem2,WORD_LT_lem3,WORD_LT_lem4] 3673 \\ MAP_EVERY Cases_on [`word_msb a`,`word_msb b`, 3674 `word_msb (n2w (w2n a + w2n (- b)):'a word)`] 3675 \\ ASM_REWRITE_TAC [word_lt] \\ POP_ASSUM MP_TAC 3676 \\ Cases_on `w2n a < w2n b` 3677 \\ ASM_REWRITE_TAC [word_msb_n2w,word_sub_def,word_add_def] 3678 \\ MAP_EVERY IMP_RES_TAC [MSB_THM1b,MSB_THM2b,MSB_THM3b,MSB_THM4b] 3679 \\ ASM_SIMP_TAC arith_ss [BIT_def,BITS_THM]) 3680 3681val WORD_GT = save_thm("WORD_GT", 3682 (Q.GEN `a` o Q.GEN `b` o REWRITE_CONV [WORD_GREATER,WORD_LT,GSYM GREATER_DEF]) 3683 ``a:'a word > b``) 3684 3685val WORD_LE = Q.store_thm("WORD_LE", 3686 `!a:'a word b. a <= b = (word_msb a = word_msb b) /\ (w2n a <= w2n b) \/ 3687 word_msb a /\ ~word_msb b`, 3688 SIMP_TAC bool_ss [WORD_LT,GSYM WORD_NOT_LESS,NOT_LESS] \\ DECIDE_TAC) 3689 3690val WORD_GE = save_thm("WORD_GE", 3691 (Q.GEN `a` o Q.GEN `b` o 3692 REWRITE_CONV [WORD_GREATER_EQ,WORD_LE,GSYM GREATER_EQ]) ``a:'a word >= b``) 3693 3694val w2n_2comp = Q.prove( 3695 `!a:'a word. w2n (- a) = if a = 0w then 0 else ^dimword_ML - w2n a`, 3696 RW_TAC bool_ss [WORD_NEG_0,w2n_0] \\ Cases_on `a` \\ POP_ASSUM (K ALL_TAC) 3697 \\ FULL_SIMP_TAC bool_ss 3698 [GSYM w2n_11,w2n_0,w2n_n2w,word_2comp_n2w,dimword_def] 3699 \\ `^dimword_ML - n MOD ^dimword_ML < ^dimword_ML` 3700 by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3701 \\ ASM_SIMP_TAC bool_ss [LESS_MOD]) 3702 3703val WORD_LO = Q.store_thm("WORD_LO", 3704 `!a b. a <+ b = w2n a < w2n b`, 3705 RW_TAC bool_ss [word_lo] \\ Cases_on `b = 0w` 3706 \\ ASM_SIMP_TAC arith_ss [w2n_2comp,w2n_0,GSYM LESS_EQ_ADD_SUB, 3707 REWRITE_RULE [dimword_def] 3708 (MATCH_MP LESS_IMP_LESS_OR_EQ (Q.SPEC `b` w2n_lt))] 3709 \\ Cases_on `a = b` >- ASM_SIMP_TAC arith_ss [BIT_B] 3710 \\ Cases_on `w2n a < w2n b` \\ ASM_REWRITE_TAC [] 3711 \\ ONCE_REWRITE_TAC [ADD_COMM] 3712 \\ RULE_ASSUM_TAC (REWRITE_RULE [GSYM w2n_11,w2n_0,w2n_n2w]) >| [ 3713 IMP_RES_TAC LESS_IMP_LESS_OR_EQ 3714 \\ `~(w2n b - w2n a = 0)` by DECIDE_TAC 3715 \\ POP_ASSUM (fn th => `^dimword_ML - (w2n b - w2n a) < ^dimword_ML` 3716 by SIMP_TAC arith_ss [th,ZERO_LT_TWOEXP]) 3717 \\ ASM_SIMP_TAC arith_ss [GSYM SUB_SUB,BIT_def,BITS_THM,SUC_SUB, 3718 EXP_1,LESS_DIV_EQ_ZERO], 3719 RULE_ASSUM_TAC (REWRITE_RULE [NOT_LESS]) 3720 \\ ASSUME_TAC (REWRITE_RULE [dimword_def] (Q.SPEC `a` w2n_lt)) 3721 \\ `w2n a - w2n b < ^dimword_ML` 3722 by ASM_SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3723 \\ ASM_SIMP_TAC bool_ss [LESS_EQ_ADD_SUB,BIT_def,BITS_THM,SUC_SUB, 3724 EXP_1,DIV_MULT_1] 3725 \\ numLib.REDUCE_TAC]) 3726 3727val WORD_LS_LO_EQ = PROVE [word_ls,word_lo] ``a <=+ b = a <+ b \/ (a = b)`` 3728val WORD_HI_NOT_LS = PROVE [word_ls,word_hi] ``a >+ b = ~(a <=+ b)`` 3729val WORD_HS_NOT_LO = PROVE [word_hs,word_lo] ``a >=+ b = ~(a <+ b)`` 3730 3731val WORD_LS = Q.store_thm("WORD_LS", 3732 `!a b. a <=+ b = w2n a <= w2n b`, 3733 PROVE_TAC [w2n_11,WORD_LO,WORD_LS_LO_EQ,LESS_OR_EQ]) 3734 3735val WORD_HI = Q.store_thm("WORD_HI", 3736 `!a b. a >+ b = w2n a > w2n b`, 3737 REWRITE_TAC [WORD_HI_NOT_LS,WORD_LS,GSYM NOT_GREATER]) 3738 3739val WORD_HS = Q.store_thm("WORD_HS", 3740 `!a b. a >=+ b = w2n a >= w2n b`, 3741 REWRITE_TAC [WORD_HS_NOT_LO,WORD_LO,DECIDE ``~(a < b) = a >= b:num``]) 3742 3743(* ------------------------------------------------------------------------- *) 3744 3745val WORD_NOT_LESS_EQUAL = Q.store_thm("WORD_NOT_LESS_EQUAL", 3746 `!a:'a word b. ~(a <= b) = b < a`, PROVE_TAC [WORD_NOT_LESS]) 3747 3748val WORD_LESS_OR_EQ = Q.store_thm("WORD_LESS_OR_EQ", 3749 `!a:'a word b. a <= b = a < b \/ (a = b)`, LEM1_TAC) 3750 3751val WORD_GREATER_OR_EQ = Q.store_thm("WORD_GREATER_OR_EQ", 3752 `!a:'a word b. a >= b = a > b \/ (a = b)`, 3753 PROVE_TAC [WORD_GREATER,WORD_GREATER_EQ,WORD_LESS_OR_EQ]) 3754 3755val WORD_LESS_TRANS = Q.store_thm("WORD_LESS_TRANS", 3756 `!a:'a word b c. a < b /\ b < c ==> a < c`, 3757 RW_TAC bool_ss [WORD_LT] \\ IMP_RES_TAC LESS_TRANS 3758 \\ ASM_REWRITE_TAC [] \\ PROVE_TAC []) 3759 3760val WORD_LESS_EQ_TRANS = Q.store_thm("WORD_LESS_EQ_TRANS", 3761 `!a:'a word b c. a <= b /\ b <= c ==> a <= c`, 3762 RW_TAC bool_ss [WORD_LE] \\ IMP_RES_TAC LESS_EQ_TRANS 3763 \\ ASM_REWRITE_TAC [] \\ PROVE_TAC []) 3764 3765val WORD_LESS_EQ_LESS_TRANS = Q.store_thm("WORD_LESS_EQ_LESS_TRANS", 3766 `!a:'a word b c. a <= b /\ b < c ==> a < c`, 3767 RW_TAC bool_ss [WORD_LE,WORD_LT] \\ IMP_RES_TAC LESS_EQ_LESS_TRANS 3768 \\ ASM_REWRITE_TAC [] \\ PROVE_TAC []) 3769 3770val WORD_LESS_LESS_EQ_TRANS = Q.store_thm("WORD_LESS_LESS_EQ_TRANS", 3771 `!a:'a word b c. a < b /\ b <= c ==> a < c`, 3772 RW_TAC bool_ss [WORD_LE,WORD_LT] \\ IMP_RES_TAC LESS_LESS_EQ_TRANS 3773 \\ ASM_REWRITE_TAC [] \\ PROVE_TAC []) 3774 3775val WORD_LESS_EQ_CASES = Q.store_thm("WORD_LESS_EQ_CASES", 3776 `!a:'a word b. a <= b \/ b <= a`, 3777 RW_TAC bool_ss [WORD_LE] \\ PROVE_TAC [LESS_EQ_CASES]) 3778 3779val WORD_LESS_CASES = Q.store_thm("WORD_LESS_CASES", 3780 `!a:'a word b. a < b \/ b <= a`, 3781 PROVE_TAC [WORD_LESS_OR_EQ,WORD_LESS_EQ_CASES]) 3782 3783val WORD_LESS_CASES_IMP = Q.store_thm("WORD_LESS_CASES_IMP", 3784 `!a:'a word b. ~(a < b) /\ ~(a = b) ==> b < a`, 3785 PROVE_TAC [WORD_NOT_LESS,WORD_LESS_OR_EQ]) 3786 3787val WORD_LESS_ANTISYM = Q.store_thm("WORD_LESS_ANTISYM", 3788 `!a:'a word b. ~(a < b /\ b < a)`, 3789 PROVE_TAC [WORD_NOT_LESS,WORD_LESS_EQ_CASES]) 3790 3791val WORD_LESS_EQ_ANTISYM = Q.store_thm("WORD_LESS_EQ_ANTISYM", 3792 `!a:'a word b. ~(a < b /\ b <= a)`, 3793 PROVE_TAC [WORD_NOT_LESS]) 3794 3795val WORD_LESS_EQ_REFL = Q.store_thm("WORD_LESS_EQ_REFL", 3796 `!a:'a word. a <= a`, 3797 REWRITE_TAC [WORD_LESS_OR_EQ]) 3798 3799val WORD_LESS_EQUAL_ANTISYM = Q.store_thm("WORD_LESS_EQUAL_ANTISYM", 3800 `!a:'a word b. a <= b /\ b <= a ==> (a = b)`, 3801 PROVE_TAC [WORD_LESS_OR_EQ,WORD_LESS_ANTISYM]) 3802 3803val WORD_LESS_IMP_LESS_OR_EQ = Q.store_thm("WORD_LESS_IMP_LESS_OR_EQ", 3804 `!a:'a word b. a < b ==> a <= b`, 3805 PROVE_TAC [WORD_LESS_OR_EQ]) 3806 3807val WORD_LESS_REFL = Q.store_thm("WORD_LESS_REFL", 3808 `!a:'a word. ~(a < a)`, 3809 RW_TAC bool_ss [WORD_NOT_LESS,WORD_LESS_OR_EQ]) 3810 3811val WORD_LESS_LESS_CASES = Q.store_thm("WORD_LESS_LESS_CASES", 3812 `!a:'a word b. (a = b) \/ a < b \/ b < a`, 3813 PROVE_TAC [WORD_LESS_CASES,WORD_LESS_OR_EQ]) 3814 3815val WORD_NOT_GREATER = Q.store_thm("WORD_NOT_GREATER", 3816 `!a:'a word b. ~(a > b) = a <= b`, 3817 PROVE_TAC [WORD_GREATER,WORD_NOT_LESS]) 3818 3819val WORD_LESS_NOT_EQ = Q.store_thm("WORD_LESS_NOT_EQ", 3820 `!a:'a word b. a < b ==> ~(a = b)`, 3821 PROVE_TAC [WORD_LESS_REFL,WORD_LESS_OR_EQ]) 3822 3823val WORD_NOT_LESS_EQ = Q.store_thm("WORD_NOT_LESS_EQ", 3824 `!a:'a word b. (a = b) ==> ~(a < b)`, 3825 PROVE_TAC [WORD_LESS_REFL]) 3826 3827val WORD_HIGHER = Q.store_thm("WORD_HIGHER", 3828 `!a b. a >+ b = b <+ a`, 3829 RW_TAC arith_ss [WORD_HI,WORD_LO]) 3830 3831val WORD_HIGHER_EQ = Q.store_thm("WORD_HIGHER_EQ", 3832 `!a b. a >=+ b = b <=+ a`, 3833 RW_TAC arith_ss [WORD_HS,WORD_LS]) 3834 3835val WORD_NOT_LOWER = Q.store_thm("WORD_NOT_LOWER", 3836 `!a b. ~(a <+ b) = b <=+ a`, 3837 RW_TAC arith_ss [WORD_LO,WORD_LS]) 3838 3839val WORD_NOT_LOWER_EQUAL = Q.store_thm("WORD_NOT_LOWER_EQUAL", 3840 `!a b. ~(a <=+ b) = b <+ a`, 3841 PROVE_TAC [WORD_NOT_LOWER]) 3842 3843val WORD_LOWER_OR_EQ = Q.store_thm("WORD_LOWER_OR_EQ", 3844 `!a b. a <=+ b = a <+ b \/ (a = b)`, 3845 REWRITE_TAC [LESS_OR_EQ,WORD_LS,WORD_LO,w2n_11]) 3846 3847val WORD_HIGHER_OR_EQ = Q.store_thm("WORD_HIGHER_OR_EQ", 3848 `!a b. a >=+ b = a >+ b \/ (a = b)`, 3849 REWRITE_TAC [GREATER_OR_EQ,WORD_HS,WORD_HI,w2n_11]) 3850 3851val WORD_LOWER_TRANS = Q.store_thm("WORD_LOWER_TRANS", 3852 `!a b c. a <+ b /\ b <+ c ==> a <+ c`, 3853 PROVE_TAC [WORD_LO,LESS_TRANS]) 3854 3855val WORD_LOWER_EQ_TRANS = Q.store_thm("WORD_LOWER_EQ_TRANS", 3856 `!a b c. a <=+ b /\ b <=+ c ==> a <=+ c`, 3857 PROVE_TAC [WORD_LS,LESS_EQ_TRANS]) 3858 3859val WORD_LOWER_EQ_LOWER_TRANS = Q.store_thm("WORD_LOWER_EQ_LOWER_TRANS", 3860 `!a b c. a <=+ b /\ b <+ c ==> a <+ c`, 3861 PROVE_TAC [WORD_LS,WORD_LO,LESS_EQ_LESS_TRANS]) 3862 3863val WORD_LOWER_LOWER_EQ_TRANS = Q.store_thm("WORD_LOWER_LOWER_EQ_TRANS", 3864 `!a b c. a <+ b /\ b <=+ c ==> a <+ c`, 3865 PROVE_TAC [WORD_LS,WORD_LO,LESS_LESS_EQ_TRANS]) 3866 3867val WORD_LOWER_EQ_CASES = Q.store_thm("WORD_LOWER_EQ_CASES", 3868 `!a b. a <=+ b \/ b <=+ a`, 3869 RW_TAC bool_ss [WORD_LS,LESS_EQ_CASES]) 3870 3871val WORD_LOWER_CASES = Q.store_thm("WORD_LOWER_CASES", 3872 `!a b. a <+ b \/ b <=+ a`, 3873 PROVE_TAC [WORD_LOWER_OR_EQ,WORD_LOWER_EQ_CASES]) 3874 3875val WORD_LOWER_CASES_IMP = Q.store_thm("WORD_LOWER_CASES_IMP", 3876 `!a b. ~(a <+ b) /\ ~(a = b) ==> b <+ a`, 3877 PROVE_TAC [WORD_NOT_LOWER,WORD_LOWER_OR_EQ]) 3878 3879val WORD_LOWER_ANTISYM = Q.store_thm("WORD_LOWER_ANTISYM", 3880 `!a b. ~(a <+ b /\ b <+ a)`, 3881 PROVE_TAC [WORD_NOT_LOWER,WORD_LOWER_EQ_CASES]) 3882 3883val WORD_LOWER_EQ_ANTISYM = Q.store_thm("WORD_LOWER_EQ_ANTISYM", 3884 `!a b. ~(a <+ b /\ b <=+ a)`, 3885 PROVE_TAC [WORD_NOT_LOWER]) 3886 3887val WORD_LOWER_EQ_REFL = Q.store_thm("WORD_LOWER_EQ_REFL", 3888 `!a. a <=+ a`, 3889 REWRITE_TAC [WORD_LOWER_OR_EQ]) 3890 3891val WORD_LOWER_EQUAL_ANTISYM = Q.store_thm("WORD_LOWER_EQUAL_ANTISYM", 3892 `!a b. a <=+ b /\ b <=+ a ==> (a = b)`, 3893 PROVE_TAC [WORD_LOWER_OR_EQ,WORD_LOWER_ANTISYM]) 3894 3895val WORD_LOWER_IMP_LOWER_OR_EQ = Q.store_thm("WORD_LOWER_IMP_LOWER_OR_EQ", 3896 `!a b. a <+ b ==> a <=+ b`, 3897 PROVE_TAC [WORD_LOWER_OR_EQ]) 3898 3899val WORD_LOWER_REFL = Q.store_thm("WORD_LOWER_REFL", 3900 `!a. ~(a <+ a)`, 3901 RW_TAC bool_ss [WORD_NOT_LOWER,WORD_LOWER_OR_EQ]) 3902 3903val WORD_LOWER_LOWER_CASES = Q.store_thm("WORD_LOWER_LOWER_CASES", 3904 `!a b. (a = b) \/ a <+ b \/ b <+ a`, 3905 PROVE_TAC [WORD_LOWER_CASES,WORD_LOWER_OR_EQ]) 3906 3907val WORD_NOT_HIGHER = Q.store_thm("WORD_NOT_HIGHER", 3908 `!a b. ~(a >+ b) = a <=+ b`, 3909 PROVE_TAC [WORD_HIGHER,WORD_NOT_LOWER]) 3910 3911val WORD_LOWER_NOT_EQ = Q.store_thm("WORD_LOWER_NOT_EQ", 3912 `!a b. a <+ b ==> ~(a = b)`, 3913 PROVE_TAC [WORD_LOWER_REFL,WORD_LOWER_OR_EQ]) 3914 3915val WORD_NOT_LOWER_EQ = Q.store_thm("WORD_NOT_LOWER_EQ", 3916 `!a b. (a = b) ==> ~(a <+ b)`, 3917 PROVE_TAC [WORD_LOWER_REFL]) 3918 3919(* ------------------------------------------------------------------------- *) 3920 3921val w2n_word_L = SIMP_CONV arith_ss [word_L_def,w2n_n2w,LESS_MOD, 3922 SPEC_LESS_EXP_SUC_MONO,INT_MIN_def,dimword_def] ``w2n word_L`` 3923 3924val w2n_word_H = Q.prove( 3925 `w2n (word_H:'a word) = ^INT_MIN_ML - 1`, 3926 `^INT_MIN_ML - 1 < ^INT_MIN_ML` by SIMP_TAC arith_ss [ZERO_LT_TWOEXP] 3927 \\ ASSUME_TAC SPEC_LESS_EXP_SUC_MONO \\ IMP_RES_TAC LESS_TRANS 3928 \\ ASM_SIMP_TAC arith_ss [word_H_def,w2n_n2w,LESS_MOD, 3929 INT_MAX_def,INT_MIN_def,dimword_def]) 3930 3931val WORD_L_PLUS_H = Q.store_thm("WORD_L_PLUS_H", 3932 `word_L + word_H = word_T`, 3933 REWRITE_TAC [word_add_def,w2n_word_L,w2n_word_H,n2w_def] 3934 \\ RW_TAC (fcp_ss++ARITH_ss) 3935 [word_T,GSYM EXP,DIMINDEX_GT_0, SUB1_SUC, ONE_COMP_0_THM]) 3936 3937fun bound_tac th1 th2 = 3938 RW_TAC bool_ss [WORD_LE,WORD_L_NEG,WORD_LE,WORD_H_POS,w2n_word_H,w2n_word_L] 3939 \\ Cases_on `word_msb a` \\ ASM_REWRITE_TAC [] 3940 \\ Cases_on `^HB = 0` 3941 >- (IMP_RES_TAC th1 \\ ASM_SIMP_TAC arith_ss []) 3942 \\ Cases_on `a` \\ POP_ASSUM (K ALL_TAC) 3943 \\ FULL_SIMP_TAC bool_ss [w2n_n2w,word_msb_n2w,dimword_def] 3944 \\ MAP_EVERY IMP_RES_TAC [th2,SLICE_COMP_MSB] 3945 \\ POP_ASSUM (Q.SPEC_THEN `n` ASSUME_TAC) 3946 \\ STRIP_ASSUME_TAC EXISTS_HB 3947 \\ FULL_SIMP_TAC arith_ss [GSYM SLICE_ZERO_THM,GSYM BITS_ZERO3] 3948 3949val WORD_L_LESS_EQ = Q.store_thm("WORD_L_LESS_EQ", 3950 `!a:'a word. word_L <= a`, 3951 bound_tac MSB_THM1b BIT_SLICE_THM2) 3952 3953val WORD_LESS_EQ_H = Q.store_thm("WORD_LESS_EQ_H", 3954 `!a:'a word. a <= word_H`, 3955 bound_tac MSB_THM3b BIT_SLICE_THM3 3956 \\ `~(m = 0)` by DECIDE_TAC 3957 \\ METIS_TAC [SUB_LESS_OR,SLICE_MSB_LT,ADD]) 3958 3959val WORD_NOT_L_EQ_H = Q.prove( 3960 `~(word_L = word_H)`, 3961 SIMP_TAC arith_ss [GSYM w2n_11,w2n_word_L,w2n_word_H, 3962 GSYM ADD_EQ_SUB,ONE_LT_EQ_TWOEXP]) 3963 3964val WORD_L_LESS_H = Q.store_thm("WORD_L_LESS_H", 3965 `word_L < word_H`, 3966 PROVE_TAC [WORD_L_LESS_EQ,WORD_LESS_EQ_H,WORD_LESS_EQ_TRANS, 3967 WORD_NOT_L_EQ_H,WORD_LESS_OR_EQ]) 3968 3969val NOT_INT_MIN_ZERO = save_thm("NOT_INT_MIN_ZERO", 3970 METIS_PROVE [WORD_L_NEG, WORD_0_POS] ``~(INT_MINw = 0w)``) 3971 3972val ZERO_LO_INT_MIN = save_thm("ZERO_LO_INT_MIN", 3973 EQT_ELIM (SIMP_CONV arith_ss [WORD_LO, word_0_n2w, 3974 REWRITE_RULE [GSYM w2n_11] NOT_INT_MIN_ZERO] 3975 ``0w <+ INT_MINw``)) 3976 3977val WORD_0_LS = Q.store_thm("WORD_0_LS", 3978 `!w. 0w <=+ w`, SRW_TAC [] [WORD_LS]) 3979 3980val WORD_LS_T = Q.store_thm("WORD_LS_T", 3981 `!w. w <=+ UINT_MAXw`, 3982 SRW_TAC [] [WORD_LS, word_T_def, UINT_MAX_def, w2n_lt, 3983 DECIDE ``a < b ==> a <= b - 1``]) 3984 3985val tac = 3986 RW_TAC (std_ss++boolSimps.LET_ss) [WORD_LO, WORD_LS, w2n_n2w] 3987 \\ MAP_EVERY Cases_on [`a`,`b`,`c`] 3988 \\ FULL_SIMP_TAC std_ss [word_add_n2w, w2n_n2w, word_2comp_n2w] 3989 \\ IMP_RES_TAC (DECIDE ``~(a <= b) ==> (b <= a:num)``) 3990 \\ Cases_on `n + n' < dimword (:'a)` 3991 \\ SRW_TAC [ARITH_ss] [SUB_LEFT_LESS, SUB_RIGHT_ADD] 3992 >- (Cases_on `n' = 0` \\ SRW_TAC [ARITH_ss] []) 3993 \\ FULL_SIMP_TAC bool_ss [NOT_LESS] 3994 \\ `?p. p < dimword (:'a) /\ (n + n' = dimword (:'a) + p)` 3995 by (Q.EXISTS_TAC `(n + n') MOD dimword (:'a)` 3996 \\ IMP_RES_TAC LESS_EQUAL_ADD 3997 \\ SRW_TAC [ARITH_ss] [ZERO_LT_dimword, ADD_MODULUS]) 3998 \\ SRW_TAC [ARITH_ss] [ZERO_LT_dimword, ADD_MODULUS] 3999 4000val WORD_ADD_LEFT_LO = Q.store_thm("WORD_ADD_LEFT_LO", 4001 `!b c a. a + b <+ c = 4002 if b <=+ c then 4003 let x = n2w (w2n c - w2n b) in 4004 a <+ x \/ ~(b = 0w) /\ - c + x <=+ a 4005 else 4006 -b <=+ a /\ a <+ - b + c`, tac) 4007 4008val WORD_ADD_LEFT_LS = Q.store_thm("WORD_ADD_LEFT_LS", 4009 `!b c a. a + b <=+ c = 4010 if b <=+ c then 4011 let x = n2w (w2n c - w2n b) in 4012 a <=+ x \/ ~(b = 0w) /\ - c + x <=+ a 4013 else 4014 -b <=+ a /\ a <=+ - b + c`, tac) 4015 4016val WORD_ADD_RIGHT_LS = save_thm("WORD_ADD_RIGHT_LS", 4017 (Q.GEN `c` o Q.GEN `a` o Q.GEN `b`) 4018 ((SIMP_CONV std_ss [COND_RAND, LET_RAND, WORD_ADD_LEFT_LO, 4019 GSYM WORD_NOT_LOWER] THENC SIMP_CONV std_ss [WORD_NOT_LOWER]) 4020 ``a <=+ b + c``)) 4021 4022val WORD_ADD_RIGHT_LO = save_thm("WORD_ADD_RIGHT_LO", 4023 (Q.GEN `c` o Q.GEN `a` o Q.GEN `b`) 4024 ((SIMP_CONV std_ss [GSYM WORD_NOT_LOWER_EQUAL, COND_RAND, LET_RAND, 4025 Once WORD_ADD_LEFT_LS] THENC SIMP_CONV std_ss [WORD_NOT_LOWER_EQUAL]) 4026 ``a <+ b + c``)) 4027 4028val WORD_LT_LO = Q.prove( 4029 `!a b. a < b = 4030 word_msb a /\ (~word_msb b \/ a <+ b) \/ 4031 ~word_msb a /\ ~word_msb b /\ a <+ b`, 4032 NTAC 2 STRIP_TAC \\ SIMP_TAC std_ss [WORD_LT, WORD_LO] 4033 \\ Cases_on `word_msb a` \\ Cases_on `word_msb b` 4034 \\ ASM_SIMP_TAC std_ss []) 4035 4036val WORD_LE_LS = Q.prove( 4037 `!a b. a <= b = 4038 word_msb a /\ (~word_msb b \/ a <=+ b) \/ 4039 ~word_msb a /\ ~word_msb b /\ a <=+ b`, 4040 NTAC 2 STRIP_TAC \\ SIMP_TAC std_ss [WORD_LE, WORD_LS] 4041 \\ Cases_on `word_msb a` \\ Cases_on `word_msb b` 4042 \\ ASM_SIMP_TAC std_ss []) 4043 4044val INT_MIN_LT_dimword = Q.prove( 4045 `INT_MIN (:'a) < dimword (:'a)`, 4046 SRW_TAC [] [INT_MIN_def, dimword_def, DIMINDEX_GT_0]) 4047 4048val WORD_MSB_INT_MIN_LS = Q.store_thm("WORD_MSB_INT_MIN_LS", 4049 `!a. word_msb a = INT_MINw <=+ a`, 4050 Cases_on `a` 4051 \\ SRW_TAC [] [word_L_def, word_msb_n2w_numeric, WORD_LS, 4052 INT_MIN_LT_dimword]) 4053 4054val WORD_LT_LO = save_thm("WORD_LT_LO", 4055 SIMP_RULE std_ss [WORD_MSB_INT_MIN_LS, WORD_NOT_LOWER_EQUAL] WORD_LT_LO) 4056 4057val WORD_LE_LS = save_thm("WORD_LE_LS", 4058 SIMP_RULE std_ss [WORD_MSB_INT_MIN_LS, WORD_NOT_LOWER_EQUAL] WORD_LE_LS) 4059 4060val WORD_LESS_NEG_LEFT = Q.store_thm("WORD_LESS_NEG_LEFT", 4061 `!a b. - a <+ b = ~(b = 0w) /\ ((a = 0w) \/ - b <+ a)`, 4062 SRW_TAC [ARITH_ss, boolSimps.LET_ss] [word_lo_def, nzcv_def] 4063 \\ Cases_on `a = 0w` \\ Cases_on `b = 0w` 4064 \\ SRW_TAC [] [WORD_NEG_0, word_0_n2w] 4065 \\ Q.SPEC_THEN `- b` ASSUME_TAC w2n_lt 4066 \\ FULL_SIMP_TAC std_ss [dimword_def, bitTheory.NOT_BIT_GT_TWOEXP]) 4067 4068val WORD_LESS_NEG_RIGHT = Q.store_thm("WORD_LESS_NEG_RIGHT", 4069 `!a b. a <+ - b = ~(b = 0w) /\ ((a = 0w) \/ b <+ - a)`, 4070 SRW_TAC [ARITH_ss, boolSimps.LET_ss] 4071 [WORD_NEG_NEG, WORD_NEG_EQ_0, word_lo_def, nzcv_def] 4072 \\ Cases_on `a = 0w` \\ Cases_on `b = 0w` 4073 \\ SRW_TAC [] [word_0_n2w] 4074 \\ Q.SPEC_THEN `b` ASSUME_TAC w2n_lt 4075 \\ FULL_SIMP_TAC std_ss [dimword_def, bitTheory.NOT_BIT_GT_TWOEXP]) 4076 4077val WORD_LS_word_0 = Q.store_thm("WORD_LS_word_0", 4078 `!n. n <=+ 0w = (n = 0w)`, 4079 REWRITE_TAC [WORD_LOWER_OR_EQ, GSYM WORD_NOT_LOWER_EQUAL, WORD_0_LS]) 4080 4081val WORD_LO_word_0 = Q.store_thm("WORD_LO_word_0", 4082 `(!n. 0w <+ n = ~(n = 0w)) /\ 4083 (!n. ~(n <+ 0w))`, 4084 REWRITE_TAC [WORD_NOT_LOWER, WORD_0_LS] 4085 \\ REWRITE_TAC [GSYM WORD_NOT_LOWER_EQUAL, WORD_LS_word_0]) 4086 4087val WORD_ADD_LEFT_LO2 = save_thm("WORD_ADD_LEFT_LO2", 4088 (GEN_ALL o SIMP_RULE (arith_ss++boolSimps.CONJ_ss++boolSimps.LET_ss) 4089 [WORD_LOWER_EQ_REFL, WORD_ADD_0, WORD_LO_word_0, 4090 WORD_LOWER_OR_EQ, WORD_NEG_EQ, Once WORD_LESS_NEG_LEFT] o 4091 Q.SPECL [`a`, `a`, `c`]) WORD_ADD_LEFT_LO) 4092 4093val WORD_ADD_LEFT_LS2 = save_thm("WORD_ADD_LEFT_LS2", 4094 (GEN_ALL o REWRITE_RULE [GSYM WORD_LOWER_OR_EQ] o 4095 SIMP_RULE (arith_ss++boolSimps.CONJ_ss++boolSimps.LET_ss) 4096 [WORD_LOWER_EQ_REFL, WORD_ADD_0, WORD_LS_word_0, 4097 WORD_LOWER_OR_EQ, WORD_NEG_EQ, Once WORD_LESS_NEG_LEFT, 4098 DECIDE ``a \/ b /\ (~a /\ c \/ d) = a \/ b /\ (c \/ d)``] o 4099 Q.SPECL [`a`, `a`, `c`]) WORD_ADD_LEFT_LS) 4100 4101val WORD_ADD_RIGHT_LO2 = save_thm("WORD_ADD_RIGHT_LO2", 4102 (GEN_ALL o SIMP_RULE (arith_ss++boolSimps.CONJ_ss++boolSimps.LET_ss) 4103 [WORD_LOWER_EQ_REFL, WORD_ADD_0, WORD_LO_word_0, 4104 WORD_LOWER_OR_EQ, WORD_NEG_EQ, Once WORD_LESS_NEG_RIGHT, 4105 DECIDE ``a \/ ~a /\ b = a \/ b``] o 4106 Q.SPECL [`a`, `a`, `c`]) WORD_ADD_RIGHT_LO) 4107 4108val WORD_ADD_RIGHT_LS2 = save_thm("WORD_ADD_RIGHT_LS2", 4109 (GEN_ALL o REWRITE_RULE [GSYM WORD_LOWER_OR_EQ] o 4110 SIMP_RULE (arith_ss++boolSimps.CONJ_ss++boolSimps.LET_ss) 4111 [WORD_LOWER_EQ_REFL, WORD_ADD_0, WORD_0_LS, 4112 WORD_LOWER_OR_EQ, WORD_NEG_EQ, Once WORD_LESS_NEG_RIGHT, 4113 DECIDE ``a \/ ~a /\ b = a \/ b``] o 4114 Q.SPECL [`a`, `a`, `c`]) WORD_ADD_RIGHT_LS) 4115 4116val word_msb_neg = Q.store_thm("word_msb_neg", 4117 `!w:'a word. word_msb w = w < 0w`, 4118 SIMP_TAC std_ss [WORD_MSB_INT_MIN_LS, WORD_LT_LO, ZERO_LO_INT_MIN, 4119 WORD_LO_word_0]) 4120 4121val word_abs = Q.store_thm("word_abs", 4122 `!w:'a word. 4123 word_abs w = (FCP i. ~word_msb w /\ w ' i \/ word_msb w /\ (-w) ' i)`, 4124 SRW_TAC [fcpLib.FCP_ss] [word_abs_def, word_msb_neg]) 4125 4126val word_abs_word_abs = Q.store_thm("word_abs_word_abs", 4127 `!w. word_abs (word_abs w) = word_abs w`, 4128 SRW_TAC [] [word_abs_def] 4129 \\ FULL_SIMP_TAC std_ss [GSYM word_msb_neg] 4130 \\ IMP_RES_TAC TWO_COMP_NEG 4131 \\ Cases_on `dimindex(:'a) = 1` 4132 \\ FULL_SIMP_TAC arith_ss [WORD_NEG_NEG, DIMINDEX_GT_0, word_2comp_dimindex_1] 4133 \\ Cases_on `w = INT_MINw` 4134 \\ FULL_SIMP_TAC arith_ss [WORD_NEG_L]) 4135 4136val word_abs_neg = Q.store_thm("word_abs_neg", 4137 `!w. word_abs (-w) = word_abs w`, 4138 SRW_TAC [] [word_abs_def] 4139 \\ FULL_SIMP_TAC std_ss [GSYM word_msb_neg] 4140 >| [ 4141 IMP_RES_TAC TWO_COMP_NEG 4142 \\ Cases_on `dimindex(:'a) = 1` 4143 \\ FULL_SIMP_TAC arith_ss 4144 [WORD_NEG_NEG, DIMINDEX_GT_0, word_2comp_dimindex_1] 4145 \\ Cases_on `w = INT_MINw` 4146 \\ FULL_SIMP_TAC arith_ss [WORD_NEG_L], 4147 IMP_RES_TAC TWO_COMP_POS 4148 \\ FULL_SIMP_TAC std_ss [WORD_NEG_EQ_0, WORD_NEG_NEG] 4149 ] 4150) 4151 4152val word_abs_diff = Q.store_thm("word_abs_diff", 4153 `!a b. word_abs (a - b) = word_abs (b - a)`, 4154 METIS_TAC [WORD_NEG_SUB, word_abs_neg]) 4155 4156(*---------------------------------------------------------------------------*) 4157 4158val FST_ADD_WITH_CARRY = Q.prove( 4159 `(!a b. FST (add_with_carry (a,b,F)) = a + b) /\ 4160 (!a b. FST (add_with_carry (a,~b,T)) = a - b) /\ 4161 (!a b. FST (add_with_carry (~a,b,T)) = b - a)`, 4162 SRW_TAC [boolSimps.LET_ss] 4163 [GSYM word_add_def, add_with_carry_def, 4164 GSYM word_add_n2w, word_sub_def, WORD_NOT] 4165 \\ METIS_TAC [WORD_ADD_LINV, WORD_ADD_RINV, WORD_ADD_0, 4166 WORD_ADD_ASSOC, WORD_ADD_COMM]) 4167 4168val FST_ADD_WITH_CARRY = save_thm("FST_ADD_WITH_CARRY", 4169 CONJ FST_ADD_WITH_CARRY 4170 (case CONJUNCTS (CONJUNCT2 FST_ADD_WITH_CARRY) of 4171 [thm1,thm2] => 4172 (CONJ (thm1 |> Q.SPECL [`a`,`~(n2w n)`] |> GEN_ALL) 4173 (thm2 |> Q.SPEC `~(n2w n)` |> GEN_ALL)) 4174 |> REWRITE_RULE [WORD_NOT_NOT] 4175 | _ => raise ERR "" "")) 4176 4177val ADD_WITH_CARRY_SUB = Q.store_thm("ADD_WITH_CARRY_SUB", 4178 `!x y. 4179 add_with_carry (x,~y,T) = 4180 (x - y, y <=+ x, 4181 ~(word_msb x = word_msb y) /\ ~(word_msb (x - y) = word_msb x))`, 4182 SIMP_TAC std_ss [add_with_carry_def,LET_DEF] 4183 \\ SIMP_TAC std_ss [pairTheory.PAIR_EQ] 4184 \\ NTAC 3 STRIP_TAC THEN1 (SIMP_TAC std_ss 4185 [GSYM word_add_n2w,n2w_w2n,WORD_NEG,word_sub_def,WORD_ADD_ASSOC]) 4186 \\ REVERSE STRIP_TAC 4187 THEN1 (SIMP_TAC std_ss [WORD_MSB_1COMP, GSYM word_add_n2w, 4188 n2w_w2n,WORD_NEG,word_sub_def,WORD_ADD_ASSOC] \\ METIS_TAC []) 4189 \\ SIMP_TAC std_ss [word_lo_def,nzcv_def,GSYM WORD_NOT_LOWER,LET_DEF] 4190 \\ Q.SPEC_TAC (`y`,`y`) \\ Q.SPEC_TAC (`x`,`x`) \\ Cases \\ Cases 4191 \\ ASSUME_TAC ZERO_LT_dimword 4192 \\ ASM_SIMP_TAC std_ss [w2n_n2w,n2w_11,word_1comp_n2w,word_2comp_n2w] 4193 \\ `dimword (:'a) - 1 - n' < dimword (:'a)` by DECIDE_TAC 4194 \\ ASM_SIMP_TAC std_ss [] 4195 \\ `n + (dimword (:'a) - 1 - n') + 1 = n + (dimword (:'a) - n')` by DECIDE_TAC 4196 \\ ASM_SIMP_TAC std_ss [BIT_def,BITS_THM,DECIDE ``SUC n - n = 1``, 4197GSYM dimword_def] 4198 \\ POP_ASSUM (K ALL_TAC) 4199 \\ Cases_on `n' = 0` \\ ASM_SIMP_TAC std_ss [DECIDE ``~(m + n < n:num)``] 4200 \\ `dimword (:'a) - n' < dimword (:'a)` by DECIDE_TAC 4201 \\ ASM_SIMP_TAC std_ss [] 4202 \\ Cases_on `n + (dimword (:'a) - n') < dimword (:'a)` 4203 \\ ASM_SIMP_TAC std_ss [LESS_DIV_EQ_ZERO] 4204 \\ Q.ABBREV_TAC `k = n + (dimword (:'a) - n')` 4205 \\ `k = dimword (:'a) + (k - dimword (:'a))` by DECIDE_TAC 4206 \\ POP_ASSUM (fn th => ONCE_REWRITE_TAC [th]) 4207 \\ `(k - dimword (:'a)) < dimword (:'a)` by (Q.UNABBREV_TAC `k` \\ DECIDE_TAC) 4208 \\ ASM_SIMP_TAC std_ss [DIV_MULT_1]) 4209 4210(* ------------------------------------------------------------------------- *) 4211 4212val word_eq_n2w = Q.store_thm("word_eq_n2w", 4213 `(!m n. (n2w m = n2w n : 'a word) = MOD_2EXP_EQ (dimindex (:'a)) m n) /\ 4214 (!n. (n2w n = - 1w : 'a word) = MOD_2EXP_MAX (dimindex (:'a)) n) /\ 4215 (!n. (- 1w = n2w n : 'a word) = MOD_2EXP_MAX (dimindex (:'a)) n)`, 4216 SRW_TAC [] [GSYM MOD_2EXP_EQ_def, MOD_2EXP_DIMINDEX] 4217 \\ SRW_TAC [] [WORD_NEG_1, MOD_2EXP_MAX_def, MOD_2EXP_def, UINT_MAX_def, 4218 word_T_def, dimword_def] \\ DECIDE_TAC) 4219 4220val WORD_ss = rewrites 4221 [WORD_LT,WORD_GT,WORD_LE,WORD_GE,WORD_LS,WORD_HI,WORD_LO,WORD_HS, 4222 word_msb_n2w,w2n_n2w,dimword_def] 4223 4224val ORDER_WORD_TAC = 4225 SIMP_TAC (bool_ss++boolSimps.LET_ss++WORD_ss) [] \\ DECIDE_TAC 4226 4227val word_lt_n2w = Q.store_thm("word_lt_n2w", 4228 `!a b. (n2w a):'a word < n2w b = 4229 let sa = BIT ^HB a and sb = BIT ^HB b 4230 in 4231 (sa = sb) /\ a MOD dimword(:'a) < b MOD dimword(:'a) \/ sa /\ ~sb`, 4232 ORDER_WORD_TAC) 4233 4234val word_gt_n2w = Q.store_thm("word_gt_n2w", 4235 `!a b. (n2w a):'a word > n2w b = let sa = BIT ^HB a and sb = BIT ^HB b in 4236 (sa = sb) /\ a MOD dimword(:'a) > b MOD dimword(:'a) \/ ~sa /\ sb`, 4237 ORDER_WORD_TAC) 4238 4239val word_le_n2w = Q.store_thm("word_le_n2w", 4240 `!a b. (n2w a):'a word <= n2w b = let sa = BIT ^HB a and sb = BIT ^HB b in 4241 (sa = sb) /\ a MOD dimword(:'a) <= b MOD dimword(:'a) \/ sa /\ ~sb`, 4242 ORDER_WORD_TAC) 4243 4244val word_ge_n2w = Q.store_thm("word_ge_n2w", 4245 `!a b. (n2w a):'a word >= n2w b = let sa = BIT ^HB a and sb = BIT ^HB b in 4246 (sa = sb) /\ a MOD dimword(:'a) >= b MOD dimword(:'a) \/ ~sa /\ sb`, 4247 ORDER_WORD_TAC) 4248 4249val word_ls_n2w = Q.store_thm("word_ls_n2w", 4250 `!a b. (n2w a):'a word <=+ n2w b = a MOD dimword(:'a) <= b MOD dimword(:'a)`, 4251 ORDER_WORD_TAC) 4252 4253val word_hi_n2w = Q.store_thm("word_hi_n2w", 4254 `!a b. (n2w a):'a word >+ n2w b = a MOD dimword(:'a) > b MOD dimword(:'a)`, 4255 ORDER_WORD_TAC) 4256 4257val word_lo_n2w = Q.store_thm("word_lo_n2w", 4258 `!a b. (n2w a):'a word <+ n2w b = a MOD dimword(:'a) < b MOD dimword(:'a)`, 4259 ORDER_WORD_TAC) 4260 4261val word_hs_n2w = Q.store_thm("word_hs_n2w", 4262 `!a b. (n2w a):'a word >=+ n2w b = a MOD dimword(:'a) >= b MOD dimword(:'a)`, 4263 ORDER_WORD_TAC) 4264 4265(* ------------------------------------------------------------------------- *) 4266 4267val lem = Q.prove( 4268 `!n a b. a < 2 ** n /\ b < 2 ** n ==> a + b < 2 ** (n + 1)`, 4269 SRW_TAC [ARITH_ss] [EXP, GSYM ADD1]) 4270 4271val w2n_add = Q.store_thm("w2n_add", 4272 `!a b. ~word_msb a /\ ~word_msb b ==> (w2n (a + b) = w2n a + w2n b)`, 4273 Cases \\ Cases 4274 \\ SRW_TAC [] [word_add_n2w, word_ls_n2w, w2n_n2w, word_L_def, dimword_def, 4275 INT_MIN_def, WORD_MSB_INT_MIN_LS, DIMINDEX_GT_0] 4276 \\ FULL_SIMP_TAC (srw_ss()) [NOT_LESS_EQUAL] 4277 \\ METIS_TAC [lem, DECIDE ``0n < n ==> ((n - 1) + 1 = n)``, DIMINDEX_GT_0]) 4278 4279(* ------------------------------------------------------------------------- *) 4280 4281val saturate_w2w_n2w = Q.store_thm("saturate_w2w_n2w", 4282 `!n. 4283 saturate_w2w (n2w n : 'a word) : 'b word = 4284 let m = n MOD dimword(:'a) in 4285 if dimindex(:'b) <= dimindex(:'a) /\ dimword(:'b) <= m then 4286 word_T 4287 else 4288 n2w m`, 4289 SRW_TAC [boolSimps.LET_ss] [saturate_w2w_def, saturate_n2w_def] 4290 \\ `dimword(:'a) < dimword(:'b)` 4291 by FULL_SIMP_TAC arith_ss [dimindex_dimword_lt_iso] 4292 \\ `dimword(:'a) < n MOD dimword (:'a)` by DECIDE_TAC 4293 \\ `n MOD dimword(:'a) < dimword(:'a)` by SRW_TAC [ARITH_ss] [] 4294 \\ FULL_SIMP_TAC arith_ss []) 4295 4296val saturate_w2w = Q.store_thm("saturate_w2w", 4297 `!w: 'a word. 4298 saturate_w2w w : 'b word = 4299 if dimindex(:'b) <= dimindex(:'a) /\ w2w (word_T: 'b word) <=+ w then 4300 word_T 4301 else 4302 w2w w`, 4303 Cases 4304 \\ `UINT_MAX (:'b) <= n /\ n < dimword(:'b) ==> (n = UINT_MAX (:'b))` 4305 by SRW_TAC [ARITH_ss] [UINT_MAX_def] 4306 \\ Cases_on `dimindex(:'b) <= dimindex(:'a)` 4307 \\ Cases_on `dimindex(:'b) = dimindex(:'a)` 4308 \\ IMP_RES_TAC dimindex_dimword_iso 4309 \\ SRW_TAC [boolSimps.LET_ss, ARITH_ss] 4310 [GSYM MOD_DIMINDEX, BOUND_ORDER, word_ls_n2w, word_T_def, 4311 w2w_n2w, saturate_w2w_n2w] 4312 \\ FULL_SIMP_TAC arith_ss [NOT_LESS_EQUAL] 4313 THEN1 (`UINT_MAX (:'b) < dimword(:'a)` by METIS_TAC [BOUND_ORDER] 4314 \\ FULL_SIMP_TAC arith_ss []) 4315 \\ `dimword (:'b) < dimword (:'a)` 4316 by SRW_TAC [ARITH_ss] [GSYM dimindex_dimword_lt_iso] 4317 \\ `UINT_MAX (:'b) < dimword (:'b)` by SRW_TAC [ARITH_ss] [BOUND_ORDER] 4318 \\ `UINT_MAX (:'b) < dimword (:'a)` by DECIDE_TAC 4319 \\ FULL_SIMP_TAC arith_ss [] 4320) 4321 4322val saturate_sub = Q.store_thm("saturate_sub", 4323 `!a b. saturate_sub a b = if a <=+ b then 0w else a - b`, 4324 RW_TAC arith_ss [WORD_LS, saturate_sub_def, n2w_sub_eq_0, n2w_w2n, n2w_sub]) 4325 4326val saturate_add = Q.store_thm("saturate_add", 4327 `!a b. 4328 saturate_add a b = 4329 if UINT_MAXw - a <=+ b then 4330 UINT_MAXw 4331 else 4332 a + b`, 4333 SRW_TAC [] [saturate_add_def, saturate_n2w_def, word_add_def, WORD_LS] 4334 \\ Cases_on `a` 4335 \\ Cases_on `b` 4336 \\ FULL_SIMP_TAC (srw_ss()++ARITH_ss) 4337 [word_T_def, UINT_MAX_def, GSYM n2w_sub]) 4338 4339val dimindex_dub = Q.prove( 4340 `FINITE (univ(:'a)) ==> dimindex(:'a) <= dimindex(:'a + 'a)`, 4341 SRW_TAC [] [fcpTheory.index_sum]) 4342 4343val dimword_dub = Q.prove( 4344 `FINITE (univ(:'a)) ==> (dimword(:'a + 'a) = dimword(:'a) * dimword(:'a))`, 4345 SRW_TAC [] [dimword_def, fcpTheory.index_sum, EXP_ADD]) 4346 4347val NOT_FINITE_IMP_dimword_2 = Q.store_thm("NOT_FINITE_IMP_dimword_2", 4348 `~FINITE (univ(:'a)) ==> (dimword(:'a) = 2)`, 4349 SRW_TAC [] [dimword_def, fcpTheory.NOT_FINITE_IMP_dimindex_1]) 4350 4351val lt_2_mul = Q.prove( 4352 `!a b. a < 2n /\ b < 2n ==> ~(2 <= a * b)`, 4353 SRW_TAC [] [NOT_LESS_EQUAL, DECIDE ``a < 2n = (a = 0) \/ (a = 1)``]) 4354 4355val saturate_mul = Q.store_thm("saturate_mul", 4356 `!a b. 4357 saturate_mul a b = 4358 if FINITE (univ(:'a)) /\ 4359 w2w (UINT_MAXw: 'a word) <=+ w2w a * w2w b : ('a + 'a) word 4360 then 4361 UINT_MAXw: 'a word 4362 else 4363 a * b`, 4364 Cases_on `FINITE (univ(:'a))` 4365 \\ SRW_TAC [] 4366 [dimindex_dub, dimword_dub, saturate_mul_def, saturate_n2w_def, 4367 word_mul_def, w2n_w2w, WORD_LS, NOT_FINITE_IMP_dimword_2] 4368 \\ Cases_on `a` 4369 \\ Cases_on `b` 4370 \\ FULL_SIMP_TAC (srw_ss()++ARITH_ss) 4371 [LESS_MULT_MONO2, word_T_def, UINT_MAX_def] 4372 \\ Q.PAT_X_ASSUM `~FINITE (univ(:'a))` ASSUME_TAC 4373 \\ FULL_SIMP_TAC std_ss [NOT_FINITE_IMP_dimword_2, lt_2_mul] 4374) 4375 4376(* ------------------------------------------------------------------------- *) 4377 4378val WORD_DIVISION = Q.store_thm("WORD_DIVISION", 4379 `!w. w <> 0w ==> 4380 !v. (v = (v // w) * w + word_mod v w) /\ word_mod v w <+ w`, 4381 Cases \\ ASM_SIMP_TAC std_ss [n2w_11,ZERO_LT_dimword] 4382 \\ STRIP_TAC \\ Cases 4383 \\ ASM_SIMP_TAC std_ss [word_mod_def,word_div_def,w2n_n2w] 4384 \\ ASM_SIMP_TAC std_ss [word_add_n2w,word_mul_n2w,WORD_LO,w2n_n2w] 4385 \\ FULL_SIMP_TAC bool_ss [NOT_ZERO_LT_ZERO] 4386 \\ IMP_RES_TAC (GSYM DIVISION) 4387 \\ REPEAT (Q.PAT_X_ASSUM `!k. bbb` (ASSUME_TAC o Q.SPEC `n'`)) 4388 \\ IMP_RES_TAC LESS_TRANS 4389 \\ ASM_SIMP_TAC std_ss []) 4390 4391(* ------------------------------------------------------------------------- *) 4392(* Theorems about 0w and -1w *) 4393(* ------------------------------------------------------------------------- *) 4394 4395val word_reverse_0 = Q.store_thm("word_reverse_0", 4396 `word_reverse 0w = 0w`, 4397 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_0, word_reverse_def]) 4398 4399val word_reverse_word_T = Q.store_thm("word_reverse_word_T", 4400 `word_reverse (- 1w) = (- 1w)`, 4401 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [word_T, WORD_NEG_1, word_reverse_def]) 4402 4403val sw2sw_0 = save_thm("sw2sw_0", 4404 SIMP_CONV (arith_ss++boolSimps.LET_ss) 4405 [word_0_n2w, sw2sw_def, BIT_ZERO, SIGN_EXTEND_def] ``sw2sw 0w``) 4406 4407val sw2sw_word_T = Q.store_thm("sw2sw_word_T", 4408 `sw2sw (- 1w) = - 1w`, 4409 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] [sw2sw, word_T, word_msb_def, WORD_NEG_1]) 4410 4411val word_div_1 = save_thm("word_div_1", 4412 GEN_ALL (SIMP_CONV std_ss [word_1_n2w, word_div_def, n2w_w2n] ``v // 1w``)) 4413 4414val word_bit_0 = save_thm("word_bit_0", 4415 GEN_ALL (EQF_ELIM 4416 (SIMP_CONV std_ss [word_bit_n2w, BIT_ZERO] ``word_bit h 0w``))) 4417 4418val word_lsb_word_T = Q.store_thm("word_lsb_word_T", 4419 `word_lsb (- 1w)`, 4420 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 4421 [word_T, word_lsb_def, WORD_NEG_1, DIMINDEX_GT_0]) 4422 4423val word_msb_word_T = Q.store_thm("word_msb_word_T", 4424 `word_msb (- 1w)`, 4425 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 4426 [word_T, word_msb_def, WORD_NEG_1, DIMINDEX_GT_0]) 4427 4428val word_bit_0_word_T = Q.store_thm("word_bit_0_word_T", 4429 `word_bit 0 (- 1w)`, 4430 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 4431 [word_T, word_bit_def, WORD_NEG_1, DIMINDEX_GT_0]) 4432 4433val word_log2_1 = Q.store_thm("word_log2_1", 4434 `word_log2 1w = 0w`, 4435 SRW_TAC [] [word_log2_def, word_1_n2w, LOG2_def, logrootTheory.LOG_1]) 4436 4437val word_join_0 = Q.store_thm("word_join_0", 4438 `!a. word_join 0w a = w2w a`, 4439 SRW_TAC [boolSimps.LET_ss] 4440 [word_join_def, w2w_0, ZERO_SHIFT, WORD_OR_CLAUSES]) 4441 4442val word_concat_0_0 = save_thm("word_concat_0_0", 4443 SIMP_CONV std_ss [word_join_0, w2w_0, word_concat_def] ``0w @@ 0w``) 4444 4445val w2w_eq_n2w = Q.store_thm("w2w_eq_n2w", 4446 `!x:'a word y. 4447 dimindex (:'a) <= dimindex (:'b) /\ y < dimword (:'a) ==> 4448 ((w2w x = n2w y :'b word) = (x = n2w y))`, 4449 Cases \\ SRW_TAC [] [w2w_n2w] 4450 >- FULL_SIMP_TAC arith_ss [dimindex_dimword_le_iso] 4451 \\ SRW_TAC [] [MOD_DIMINDEX, bitTheory.BITS_COMP_THM2, MIN_DEF] 4452 \\ FULL_SIMP_TAC arith_ss [dimword_def, DIMINDEX_GT_0, bitTheory.BITS_ZEROL, 4453 SUB1_SUC] 4454 \\ IMP_RES_TAC bitTheory.TWOEXP_MONO 4455 \\ `y < 2 ** dimindex (:'b)` by DECIDE_TAC 4456 \\ ASM_SIMP_TAC std_ss [DIMINDEX_GT_0, bitTheory.BITS_ZEROL, SUB1_SUC]) 4457 4458val word_extract_eq_n2w = Q.store_thm("word_extract_eq_n2w", 4459 `!x:'a word h y. 4460 dimindex (:'a) <= dimindex (:'b) /\ 4461 dimindex (:'a) - 1 <= h /\ y < dimword (:'a) ==> 4462 (((h >< 0) x = n2w y :'b word) = (x = n2w y))`, 4463 REPEAT STRIP_TAC 4464 \\ Cases_on `h = dimindex (:'a) - 1` 4465 \\ SRW_TAC [numSimps.ARITH_ss] 4466 [WORD_EXTRACT_MIN_HIGH, GSYM WORD_w2w_EXTRACT, w2w_eq_n2w]) 4467 4468val word_concat_0 = Q.store_thm("word_concat_0", 4469 `!x. FINITE univ(:'a) /\ x < dimword (:'b) ==> 4470 ((0w :'a word) @@ (n2w x :'b word) = (n2w x :'c word))`, 4471 Cases_on `FINITE univ(:'b)` 4472 >| [Cases_on `dimindex (:'b) <= dimindex (:'c)` 4473 >- SRW_TAC [numSimps.ARITH_ss] [fcpTheory.index_sum, word_concat_def, 4474 word_join_0, w2w_w2w, w2w_eq_n2w, WORD_ALL_BITS] 4475 \\ SRW_TAC [fcpLib.FCP_ss] [word_concat_def, word_join_0, n2w_def, w2w] 4476 \\ Cases_on `i < dimindex (:'a) + dimindex (:'b)` 4477 \\ SRW_TAC [fcpLib.FCP_ss, numSimps.ARITH_ss] [fcpTheory.index_sum, w2w], 4478 IMP_RES_TAC fcpTheory.NOT_FINITE_IMP_dimindex_1 4479 \\ FULL_SIMP_TAC std_ss [fcpTheory.index_sum, bitTheory.BITS_ZERO3, 4480 word_concat_def, dimword_def, word_join_0, w2w_w2w, w2w_n2w, 4481 word_bits_n2w]]) 4482 4483val word_concat_0_eq = Q.store_thm("word_concat_0_eq", 4484 `!x y. FINITE univ(:'a) /\ 4485 dimindex (:'b) <= dimindex (:'c) /\ y < dimword(:'b) ==> 4486 (((0w :'a word) @@ (x :'b word) = (n2w y :'c word)) <=> (x = n2w y))`, 4487 Cases 4488 \\ SRW_TAC [numSimps.ARITH_ss] [dimindex_dimword_le_iso, word_concat_0]) 4489 4490val word_concat_assoc = Q.store_thm("word_concat_assoc", 4491 `!a:'a word b:'b word c:'c word. 4492 FINITE univ(:'a) /\ 4493 FINITE univ(:'b) /\ 4494 FINITE univ(:'c) /\ 4495 (dimindex(:'d) = dimindex(:'a) + dimindex(:'b)) /\ 4496 (dimindex(:'e) = dimindex(:'b) + dimindex(:'c)) /\ 4497 (dimindex(:'f) = dimindex(:'d) + dimindex(:'c)) ==> 4498 (((a @@ b) : 'd word) @@ c = (a @@ ((b @@ c) : 'e word)) : 'f word)`, 4499 SRW_TAC [fcpLib.FCP_ss, boolSimps.LET_ss] [word_concat_def, w2w] 4500 \\ `FINITE univ(:'d) /\ FINITE univ(:'e)` 4501 by METIS_TAC [DIMINDEX_GT_0, fcpTheory.dimindex_def, 4502 DECIDE ``0n < a /\ 0 < b ==> ~(1 = a + b)``] 4503 \\ Cases_on `i < dimindex(:'d + 'c)` 4504 \\ Cases_on `i < dimindex(:'a + 'e)` 4505 \\ SRW_TAC [ARITH_ss] [word_join_index, w2w] 4506 \\ FULL_SIMP_TAC arith_ss [fcpTheory.index_sum, word_join_index] 4507 \\ REV_FULL_SIMP_TAC arith_ss [] 4508 ) 4509 4510val word_join_word_T = Q.store_thm("word_join_word_T", 4511 `word_join (- 1w) (- 1w) = - 1w`, 4512 SRW_TAC [boolSimps.LET_ss, fcpLib.FCP_ss] 4513 [word_join_def, w2w, word_T, word_or_def, word_lsl_def, WORD_NEG_1] 4514 \\ POP_ASSUM MP_TAC 4515 \\ Cases_on `i < dimindex (:'b)` 4516 \\ SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 4517 [fcpTheory.index_sum, w2w, word_T, DIMINDEX_GT_0] 4518 \\ FULL_SIMP_TAC std_ss [DECIDE ``i < 1 = (i = 0)``, DIMINDEX_GT_0]) 4519 4520val word_concat_word_T = save_thm("word_concat_word_T", 4521 (REWRITE_RULE [word_join_word_T] o Q.SPECL [`- 1w`,`- 1w`]) word_concat_def) 4522 4523val BIT0_CONV = SIMP_CONV std_ss [BIT0_ODD] 4524 4525val extract_00 = Q.prove( 4526 `(!a:'a word. (0 -- 0) a = if word_lsb a then 1w else 0w) /\ 4527 (!a:'a word. (0 '' 0) a = if word_lsb a then 1w else 0w) /\ 4528 (!a:'a word. (0 >< 0) a = if word_lsb a then 1w else 0w:'b word)`, 4529 SRW_TAC [fcpLib.FCP_ss] 4530 [n2w_def, w2w, word_bits_def, word_slice_def, word_extract_def, 4531 word_lsb_def, DIMINDEX_GT_0] 4532 \\ Cases_on `i = 0` 4533 \\ SRW_TAC [fcpLib.FCP_ss] 4534 [DIMINDEX_GT_0, BIT0_CONV ``BIT 0 1``, BIT0_CONV ``BIT 0 0``, 4535 (SIMP_RULE std_ss [] o Q.SPECL [`i`,`0`]) BIT_B_NEQ, BIT_ZERO] 4536 \\ Cases_on `i < dimindex (:'a)` 4537 \\ SRW_TAC [fcpLib.FCP_ss] []) 4538 4539val lsr_1_word_T = Q.store_thm("lsr_1_word_T", 4540 `- 1w >>> 1 = INT_MAXw`, 4541 SRW_TAC [fcpLib.FCP_ss] [WORD_NEG_1, word_lsr_def, word_T, word_H] 4542 \\ Cases_on `i < dimindex (:'a) - 1` 4543 \\ SRW_TAC [ARITH_ss] [word_T]) 4544 4545val word_rrx_0 = Q.store_thm("word_rrx_0", 4546 `(word_rrx(F, 0w) = (F, 0w)) /\ 4547 (word_rrx(T, 0w) = (F, INT_MINw))`, 4548 SRW_TAC [fcpLib.FCP_ss] 4549 [word_0, word_L, word_rrx_def, word_lsb_n2w, ZERO_SHIFT]) 4550 4551val word_rrx_word_T = Q.store_thm("word_rrx_word_T", 4552 `(word_rrx(F, - 1w) = (T, INT_MAXw)) /\ 4553 (word_rrx(T, - 1w) = (T, - 1w))`, 4554 SRW_TAC [fcpLib.FCP_ss, ARITH_ss] 4555 [word_T, word_rrx_def, word_lsb_word_T, lsr_1_word_T, word_H, ZERO_SHIFT, 4556 REWRITE_RULE [SYM WORD_NEG_1] word_T]) 4557 4558val word_T_not_zero = Q.store_thm("word_T_not_zero", 4559 `~(- 1w = 0w)`, 4560 SRW_TAC [fcpLib.FCP_ss] [REWRITE_RULE [SYM WORD_NEG_1] word_T, word_0]) 4561 4562val WORD_LS_word_T = Q.store_thm("WORD_LS_word_T", 4563 `(!n. - 1w <=+ n = (n = - 1w)) /\ 4564 (!n. n <=+ - 1w)`, 4565 REWRITE_TAC [WORD_NEG_1, WORD_LS_T] 4566 \\ REWRITE_TAC [WORD_LOWER_OR_EQ, METIS_PROVE 4567 [WORD_LS_T, WORD_NOT_LOWER] ``~(word_T <+ n)``] 4568 \\ METIS_TAC []) 4569 4570val WORD_LO_word_T = Q.store_thm("WORD_LO_word_T", 4571 `(!n. ~(- 1w <+ n)) /\ 4572 (!n. n <+ - 1w = ~(n = - 1w))`, 4573 REWRITE_TAC [WORD_NOT_LOWER, WORD_NEG_1, WORD_LS_T] 4574 \\ REWRITE_TAC [GSYM WORD_NOT_LOWER_EQUAL, 4575 GSYM WORD_NEG_1, WORD_LS_word_T]) 4576 4577val WORD_LESS_0_word_T = Q.store_thm("WORD_LESS_0_word_T", 4578 `~(0w < - 1w) /\ ~(0w <= - 1w) /\ - 1w < 0w /\ - 1w <= 0w`, 4579 REWRITE_TAC [WORD_LT, WORD_LE, word_msb_word_T, WORD_0_POS]) 4580 4581(* word_reverse *) 4582 4583val word_reverse_reverse = Q.prove( 4584 `!w. word_reverse (word_reverse w) = w:'a word`, 4585 FULL_SIMP_TAC std_ss [word_reverse_def,fcpTheory.CART_EQ,fcpTheory.FCP_BETA] 4586 THEN REPEAT STRIP_TAC 4587 THEN `(dimindex (:'a) - 1 - i) < dimindex (:'a)` by DECIDE_TAC 4588 THEN FULL_SIMP_TAC std_ss [word_reverse_def,fcpTheory.CART_EQ,fcpTheory.FCP_BETA] 4589 THEN AP_TERM_TAC THEN DECIDE_TAC) 4590 4591val word_reverse_lsl = Q.prove( 4592 `!w n. word_reverse (w << n) = (word_reverse w >>> n):'a word`, 4593 FULL_SIMP_TAC std_ss [word_reverse_def,word_lsl_def,word_lsr_def, 4594 fcpTheory.CART_EQ,fcpTheory.FCP_BETA] THEN REPEAT STRIP_TAC 4595 THEN `(dimindex (:'a) - 1 - i) < dimindex (:'a)` by DECIDE_TAC 4596 THEN Cases_on `i + n < dimindex (:'a)` 4597 THEN FULL_SIMP_TAC std_ss [fcpTheory.FCP_BETA] 4598 THEN `i + n < dimindex (:'a) = n <= dimindex (:'a) - 1 - i` by DECIDE_TAC 4599 THEN FULL_SIMP_TAC std_ss [fcpTheory.FCP_BETA,SUB_PLUS]) 4600 4601val word_reverse_lsr = Q.prove( 4602 `!w n. word_reverse (w >>> n) = (word_reverse w << n):'a word`, 4603 METIS_TAC [word_reverse_lsl,word_reverse_reverse]) 4604 4605val word_reverse_EQ_ZERO = Q.prove( 4606 `!w:'a word. (word_reverse w = 0w) = (w = 0w)`, 4607 FULL_SIMP_TAC std_ss [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_reverse_def,word_0] 4608 THEN REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC 4609 THEN `dimindex (:'a) - 1 - i < dimindex (:'a)` by DECIDE_TAC THEN RES_TAC 4610 THEN `dimindex (:'a) - 1 - (dimindex (:'a) - 1 - i) = i` by DECIDE_TAC 4611 THEN FULL_SIMP_TAC std_ss []) 4612 4613val word_reverse_EQ_ONE = Q.prove( 4614 `!w:'a word. (word_reverse w = - 1w) = (w = - 1w)`, 4615 FULL_SIMP_TAC std_ss [fcpTheory.CART_EQ,fcpTheory.FCP_BETA, 4616 word_reverse_def,WORD_NEG_1_T] 4617 THEN REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC 4618 THEN `dimindex (:'a) - 1 - i < dimindex (:'a)` by DECIDE_TAC THEN RES_TAC 4619 THEN `dimindex (:'a) - 1 - (dimindex (:'a) - 1 - i) = i` by DECIDE_TAC 4620 THEN FULL_SIMP_TAC std_ss []) 4621 4622val word_reverse_thm = Q.store_thm("word_reverse_thm", 4623 `!w (v:'a word) n. 4624 (word_reverse (word_reverse w) = w) /\ 4625 (word_reverse (w << n) = word_reverse w >>> n) /\ 4626 (word_reverse (w >>> n) = word_reverse w << n) /\ 4627 (word_reverse (w || v) = word_reverse w || word_reverse v) /\ 4628 (word_reverse (w && v) = word_reverse w && word_reverse v) /\ 4629 (word_reverse (w ?? v) = word_reverse w ?? word_reverse v) /\ 4630 (word_reverse (~w) = ~(word_reverse w)) /\ 4631 (word_reverse 0w = 0w:'a word) /\ 4632 (word_reverse (- 1w) = (- 1w):'a word) /\ 4633 ((word_reverse w = 0w) = (w = 0w)) /\ 4634 ((word_reverse w = - 1w) = (w = - 1w))`, 4635 SIMP_TAC std_ss [word_reverse_reverse,word_reverse_lsr,word_reverse_lsl, 4636 word_reverse_EQ_ZERO,word_reverse_word_T,word_reverse_0,word_reverse_EQ_ONE] 4637 THEN FULL_SIMP_TAC std_ss [word_reverse_def,word_or_def,word_and_def, 4638 word_xor_def,fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_1comp_def] 4639 THEN REPEAT STRIP_TAC 4640 THEN `(dimindex (:'a) - 1 - i) < dimindex (:'a)` by DECIDE_TAC 4641 THEN FULL_SIMP_TAC std_ss [fcpTheory.FCP_BETA]) 4642 4643(* ------------------------------------------------------------------------- *) 4644 4645val bit_count_upto_0 = Q.store_thm("bit_count_upto_0", 4646 `!w. bit_count_upto 0 w = 0`, 4647 SIMP_TAC std_ss [bit_count_upto_def, sum_numTheory.SUM_def]) 4648 4649val bit_count_upto_SUC = Q.store_thm("bit_count_upto_SUC", 4650 `!w n. bit_count_upto (SUC n) w = 4651 (if w ' n then 1 else 0) + bit_count_upto n w`, 4652 SRW_TAC [ARITH_ss] [bit_count_upto_def, sum_numTheory.SUM_def]) 4653 4654val bit_count_upto_is_zero = Q.store_thm("bit_count_upto_is_zero", 4655 `!n w. (bit_count_upto n w = 0) = (!i. i < n ==> ~w ' i)`, 4656 simp [bit_count_upto_def] 4657 \\ Induct 4658 \\ rw [sum_numTheory.SUM_def] 4659 >- metis_tac [prim_recTheory.LESS_SUC_REFL] 4660 \\ eq_tac 4661 \\ lrw [] 4662 \\ Cases_on `i < n` 4663 >- simp [] 4664 \\ `i = n` by decide_tac 4665 \\ simp []) 4666 4667val bit_count_is_zero = Q.store_thm("bit_count_is_zero", 4668 `!w. (bit_count w = 0) = (w = 0w)`, 4669 simp [bit_count_def, bit_count_upto_is_zero, word_eq_0]) 4670 4671(* ------------------------------------------------------------------------- 4672 Theorems: sets of words 4673 ------------------------------------------------------------------------- *) 4674 4675val WORD_FINITE = Q.store_thm("WORD_FINITE", 4676 `!s:'a word set. FINITE s`, 4677 STRIP_TAC 4678 \\ MATCH_MP_TAC ((ONCE_REWRITE_RULE [CONJ_COMM] o 4679 REWRITE_RULE [AND_IMP_INTRO] o GEN_ALL o DISCH_ALL o SPEC_ALL o 4680 UNDISCH_ALL o SPEC_ALL) SUBSET_FINITE) 4681 \\ Q.EXISTS_TAC `UNIV` 4682 \\ ASM_SIMP_TAC std_ss [SUBSET_UNIV] 4683 \\ MATCH_MP_TAC ((ONCE_REWRITE_RULE [CONJ_COMM] o 4684 REWRITE_RULE [AND_IMP_INTRO] o GEN_ALL o DISCH_ALL o SPEC_ALL o 4685 UNDISCH_ALL o SPEC_ALL) SUBSET_FINITE) 4686 \\ Q.EXISTS_TAC `{ n2w n | n < dimword(:'a) }` 4687 \\ STRIP_TAC 4688 THEN1 SIMP_TAC std_ss [SUBSET_DEF,IN_UNIV,GSPECIFICATION,ranged_word_nchotomy] 4689 \\ Q.SPEC_TAC (`dimword (:'a)`,`k`) 4690 \\ Induct \\ sg `{n2w n | n < 0} = {}` 4691 \\ ASM_SIMP_TAC std_ss [EXTENSION,GSPECIFICATION,NOT_IN_EMPTY,FINITE_EMPTY] 4692 \\ sg `{n2w n | n < SUC k} = n2w k INSERT {n2w n | n < k}` 4693 \\ ASM_SIMP_TAC std_ss [FINITE_INSERT] 4694 \\ ASM_SIMP_TAC std_ss [EXTENSION,GSPECIFICATION,NOT_IN_EMPTY,IN_INSERT] 4695 \\ REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC 4696 \\ FULL_SIMP_TAC std_ss [DECIDE ``n < SUC k = n < k \/ (n = k)``] 4697 \\ METIS_TAC []) 4698 4699val WORD_SET_INDUCT = save_thm("WORD_SET_INDUCT", 4700 REWRITE_RULE [WORD_FINITE] 4701 (Q.INST_TYPE [`:'a`|->`:'a word`] FINITE_INDUCT)) 4702 4703(* ------------------------------------------------------------------------- 4704 Support for termination proofs 4705 ------------------------------------------------------------------------- *) 4706 4707val SUC_WORD_PRED = Q.store_thm("SUC_WORD_PRED", 4708 `!x:'a word. ~(x = 0w) ==> (SUC (w2n (x - 1w)) = w2n x)`, 4709 Cases \\ Cases_on `n` 4710 \\ FULL_SIMP_TAC std_ss [ADD1,GSYM word_add_n2w,WORD_ADD_SUB] 4711 \\ REPEAT STRIP_TAC 4712 \\ CONV_TAC (RAND_CONV (REWRITE_CONV [word_add_n2w])) 4713 \\ `n' < dimword (:'a)` by DECIDE_TAC 4714 \\ ASM_SIMP_TAC std_ss [w2n_n2w]) 4715 4716val WORD_PRED_THM = Q.store_thm("WORD_PRED_THM", 4717 `!m:'a word. ~(m = 0w) ==> w2n (m - 1w) < w2n m`, 4718 REPEAT STRIP_TAC \\ IMP_RES_TAC SUC_WORD_PRED \\ DECIDE_TAC) 4719 4720val triv_exp = Q.prove 4721(`!m. 0 < 2 ** m`, 4722 Induct THEN RW_TAC arith_ss [EXP]) 4723 4724val ONE_LESS_TWO_EXP = Q.prove 4725(`!m. 0<m ==> 1 < 2 ** m`, 4726Cases THEN RW_TAC arith_ss [EXP] THEN 4727 `0 < 2 ** n` by METIS_TAC [triv_exp] THEN DECIDE_TAC) 4728 4729val LSR_LESS = Q.store_thm("LSR_LESS", 4730 `!m y. ~(y = 0w) /\ 0<m ==> w2n (y >>> m) < w2n y`, 4731 RW_TAC arith_ss [w2n_lsr] THEN 4732 `~(w2n y = 0)` by METIS_TAC [n2w_w2n] THEN 4733 METIS_TAC [DIV_LESS,ONE_LESS_TWO_EXP, DECIDE ``0<x = ~(x=0)``]) 4734 4735val word_sub_w2n = Q.store_thm("word_sub_w2n", 4736 `!x:'a word y:'a word. y <=+ x ==> (w2n (x - y) = w2n x - w2n y)`, 4737 Cases \\ Cases 4738 \\ FULL_SIMP_TAC std_ss [WORD_LS,w2n_n2w] 4739 \\ REPEAT STRIP_TAC 4740 \\ `?k. n = k + n'` by METIS_TAC [LESS_EQ_EXISTS,ADD_COMM] 4741 \\ `k < dimword (:'a)` by DECIDE_TAC 4742 \\ ASM_SIMP_TAC std_ss [GSYM word_add_n2w,ADD_SUB,WORD_ADD_SUB,w2n_n2w]) 4743 4744val ZERO_LE_TOP_FALSE = Q.prove( 4745 `!n. 0w <= ((n2w n):'a word) = (BIT (dimindex (:'a) - 1) n = F)`, 4746 SRW_TAC [] [word_le_n2w,LET_DEF] 4747 \\ FULL_SIMP_TAC std_ss 4748 [BIT_def,BITS_def,MOD_2EXP_def,DIV_2EXP_def,ZERO_DIV,ZERO_MOD, 4749 ZERO_LT_EXP,EVAL ``0 < 2``]) 4750 4751val WORD_LE_EQ_LS = Q.store_thm("WORD_LE_EQ_LS", 4752 `!x y. 0w <= x /\ 0w <= y ==> (x <= y = x <=+ y)`, 4753 Cases \\ Cases 4754 \\ FULL_SIMP_TAC std_ss 4755 [WORD_LS,w2n_n2w,word_le_n2w,LET_DEF,ZERO_LE_TOP_FALSE]) 4756 4757val WORD_LT_EQ_LO = Q.store_thm("WORD_LT_EQ_LO", 4758 `!x y. 0w <= x /\ 0w <= y ==> (x < y = x <+ y)`, 4759 Cases \\ Cases 4760 \\ FULL_SIMP_TAC std_ss 4761 [WORD_LO,w2n_n2w,word_lt_n2w,LET_DEF,ZERO_LE_TOP_FALSE]) 4762 4763val WORD_ZERO_LE = Q.store_thm("WORD_ZERO_LE", 4764 `!w:'a word. 0w <= w = w2n w < INT_MIN (:'a)`, 4765 Cases \\ REWRITE_TAC [ZERO_LE_TOP_FALSE,GSYM word_msb_n2w, 4766 word_msb_n2w_numeric,w2n_n2w,NOT_LESS_EQUAL]) 4767 4768val WORD_ZERO_LE_SUB_LEMMA = Q.prove( 4769 `!x:'a word y. 0w <= x /\ y <=+ x ==> 0w <= x - y`, 4770 `!m n k. m < n ==> m - k < n:num` by DECIDE_TAC 4771 \\ ASM_SIMP_TAC bool_ss [WORD_ZERO_LE,WORD_LS, 4772 REWRITE_RULE [WORD_LS] word_sub_w2n]) 4773 4774val WORD_ZERO_LE_SUB = Q.prove( 4775 `!x:'a word y. 0w <= y /\ y <= x ==> 0w <= x - y`, 4776 REPEAT STRIP_TAC 4777 \\ IMP_RES_TAC WORD_LESS_EQ_TRANS 4778 \\ MATCH_MP_TAC WORD_ZERO_LE_SUB_LEMMA 4779 \\ ASM_SIMP_TAC std_ss [GSYM WORD_LE_EQ_LS]) 4780 4781val WORD_ZERO_LT_SUB = Q.prove( 4782 `!x:'a word y. 0w < y /\ y < x ==> 0w < x - y`, 4783 REPEAT STRIP_TAC 4784 \\ IMP_RES_TAC WORD_LESS_IMP_LESS_OR_EQ 4785 \\ IMP_RES_TAC WORD_ZERO_LE_SUB 4786 \\ `(0w < x - y) \/ (0w = x - y)` by ASM_REWRITE_TAC [GSYM WORD_LESS_OR_EQ] 4787 \\ METIS_TAC [WORD_EQ_SUB_ZERO,WORD_LESS_NOT_EQ]) 4788 4789val WORD_LT_SUB_UPPER = Q.store_thm("WORD_LT_SUB_UPPER", 4790 `!x:'a word y. 0w < y /\ y < x ==> x - y < x`, 4791 REPEAT STRIP_TAC 4792 \\ IMP_RES_TAC WORD_LESS_TRANS 4793 \\ IMP_RES_TAC WORD_LESS_IMP_LESS_OR_EQ 4794 \\ IMP_RES_TAC WORD_ZERO_LE_SUB 4795 \\ ASM_SIMP_TAC bool_ss [WORD_LT_EQ_LO,WORD_LO] 4796 \\ IMP_RES_TAC WORD_LE_EQ_LS 4797 \\ ASM_SIMP_TAC bool_ss [word_sub_w2n] 4798 \\ MATCH_MP_TAC (DECIDE ``!m k. ~(k = 0) /\ ~(m = 0) ==> m - k < m:num``) 4799 \\ IMP_RES_TAC WORD_LESS_NOT_EQ 4800 \\ ASM_SIMP_TAC bool_ss [w2n_eq_0]) 4801 4802val WORD_LE_SUB_UPPER = Q.prove( 4803 `!x:'a word y. 0w <= y /\ y <= x ==> x - y <= x`, 4804 REPEAT STRIP_TAC 4805 \\ REWRITE_TAC [WORD_LESS_OR_EQ] 4806 \\ `(0w < y) \/ (0w = y)` by ASM_REWRITE_TAC [GSYM WORD_LESS_OR_EQ] 4807 \\ `(y < x) \/ (y = x)` by ASM_REWRITE_TAC [GSYM WORD_LESS_OR_EQ] 4808 \\ ASM_SIMP_TAC bool_ss [WORD_LT_SUB_UPPER,WORD_SUB_REFL] 4809 \\ METIS_TAC [WORD_SUB_RZERO]) 4810 4811val WORD_SUB_LT = Q.store_thm("WORD_SUB_LT", 4812 `!x:'a word y. 0w < y /\ y < x ==> 0w < x - y /\ x - y < x`, 4813 SIMP_TAC bool_ss [WORD_LT_SUB_UPPER,WORD_ZERO_LT_SUB]) 4814 4815val WORD_SUB_LE = Q.store_thm("WORD_SUB_LE", 4816 `!x:'a word y. 0w <= y /\ y <= x ==> 0w <= x - y /\ x - y <= x`, 4817 SIMP_TAC bool_ss [WORD_LE_SUB_UPPER,WORD_ZERO_LE_SUB]) 4818 4819(* ------------------------------------------------------------------------- 4820 Create a few word sizes 4821 ------------------------------------------------------------------------- *) 4822 4823val sizes = 4824 [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 4825 16, 20, 24, 28, 30, 32, 48, 64, 96, 128] 4826 4827fun mk_word_size n = 4828 let val N = Arbnum.fromInt n 4829 val SN = Int.toString n 4830 val typ = fcpLib.index_type N 4831 val TYPE = mk_type("cart", [bool, typ]) 4832 val dimindex = fcpLib.DIMINDEX N 4833 val finite = fcpLib.FINITE N 4834 fun save x = Feedback.trace ("Theory.save_thm_reporting", 0) save_thm x 4835 val _ = save ("dimindex_" ^ SN, dimindex) 4836 val _ = save ("finite_" ^ SN, finite) 4837 val INT_MIN = save ("INT_MIN_" ^ SN, 4838 (SIMP_RULE std_ss [dimindex] o 4839 Thm.INST_TYPE [``:'a`` |-> typ]) INT_MIN_def) 4840 val dimword = save ("dimword_" ^ SN, 4841 (SIMP_RULE std_ss [INT_MIN] o 4842 Thm.INST_TYPE [``:'a`` |-> typ]) dimword_IS_TWICE_INT_MIN) 4843 in 4844 type_abbrev("word" ^ SN, TYPE) 4845 end 4846 4847val _ = List.app mk_word_size sizes 4848 4849(* ------------------------------------------------------------------------- 4850 Write some code into wordsTheory.sml 4851 ------------------------------------------------------------------------- *) 4852 4853val _ = Theory.quote_adjoin_to_theory `none` 4854`val _ = TotalDefn.termination_simps := 4855 LSR_LESS :: WORD_PRED_THM :: !TotalDefn.termination_simps 4856 4857val _ = 4858 let 4859 open Lib boolSyntax numSyntax Drule 4860 val word_type = type_of (fst (dest_forall (concl word_nchotomy))) 4861 val w2n_tm = fst (strip_comb (lhs (snd (dest_forall (concl w2n_def))))) 4862 val w2n_abs = 4863 list_mk_abs ([mk_var ("v1", bool --> num), 4864 mk_var ("v2", alpha --> num), 4865 mk_var ("v3", word_type)], 4866 mk_comb (w2n_tm, mk_var("v3" ,word_type))) 4867 in 4868 TypeBase.write 4869 [TypeBasePure.mk_nondatatype_info 4870 (word_type, 4871 {nchotomy = SOME ranged_word_nchotomy, 4872 induction = NONE, 4873 size = SOME (w2n_abs, CONJUNCT1 (SPEC_ALL boolTheory.AND_CLAUSES)), 4874 encode = NONE})] 4875 end;` 4876 4877(* ------------------------------------------------------------------------- *) 4878(* For use with EmitML *) 4879(* ------------------------------------------------------------------------- *) 4880 4881val n2w_itself_def = Define `n2w_itself (n, (:'a)) = (n2w n): 'a word` 4882 4883val _ = export_theory() 4884