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