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