author | huffman |
Fri, 23 Dec 2011 16:37:27 +0100 | |
changeset 45958 | c28235388c43 |
parent 45957 | 43eac86bf006 |
child 45995 | b16070689726 |
permissions | -rw-r--r-- |
29628 | 1 |
(* Title: HOL/Word/Word.thy |
37660 | 2 |
Author: Jeremy Dawson and Gerwin Klein, NICTA |
24333 | 3 |
*) |
4 |
||
37660 | 5 |
header {* A type of finite bit strings *} |
24350 | 6 |
|
29628 | 7 |
theory Word |
41413
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
8 |
imports |
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
9 |
Type_Length |
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
10 |
Misc_Typedef |
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
11 |
"~~/src/HOL/Library/Boolean_Algebra" |
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
12 |
Bool_List_Representation |
41060
4199fdcfa3c0
moved smt_word.ML into the directory of the Word library
boehmes
parents:
40827
diff
changeset
|
13 |
uses ("~~/src/HOL/Word/Tools/smt_word.ML") |
37660 | 14 |
begin |
15 |
||
16 |
text {* see @{text "Examples/WordExamples.thy"} for examples *} |
|
17 |
||
18 |
subsection {* Type definition *} |
|
19 |
||
45694
4a8743618257
prefer typedef without extra definition and alternative name;
wenzelm
parents:
45620
diff
changeset
|
20 |
typedef (open) 'a word = "{(0::int) ..< 2^len_of TYPE('a::len0)}" |
37660 | 21 |
morphisms uint Abs_word by auto |
22 |
||
23 |
definition word_of_int :: "int \<Rightarrow> 'a\<Colon>len0 word" where |
|
24 |
-- {* representation of words using unsigned or signed bins, |
|
25 |
only difference in these is the type class *} |
|
26 |
"word_of_int w = Abs_word (bintrunc (len_of TYPE ('a)) w)" |
|
27 |
||
28 |
lemma uint_word_of_int [code]: "uint (word_of_int w \<Colon> 'a\<Colon>len0 word) = w mod 2 ^ len_of TYPE('a)" |
|
29 |
by (auto simp add: word_of_int_def bintrunc_mod2p intro: Abs_word_inverse) |
|
30 |
||
31 |
code_datatype word_of_int |
|
32 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
33 |
subsection {* Random instance *} |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
34 |
|
37751 | 35 |
notation fcomp (infixl "\<circ>>" 60) |
36 |
notation scomp (infixl "\<circ>\<rightarrow>" 60) |
|
37660 | 37 |
|
38 |
instantiation word :: ("{len0, typerep}") random |
|
39 |
begin |
|
40 |
||
41 |
definition |
|
37751 | 42 |
"random_word i = Random.range (max i (2 ^ len_of TYPE('a))) \<circ>\<rightarrow> (\<lambda>k. Pair ( |
37660 | 43 |
let j = word_of_int (Code_Numeral.int_of k) :: 'a word |
44 |
in (j, \<lambda>_::unit. Code_Evaluation.term_of j)))" |
|
45 |
||
46 |
instance .. |
|
47 |
||
48 |
end |
|
49 |
||
37751 | 50 |
no_notation fcomp (infixl "\<circ>>" 60) |
51 |
no_notation scomp (infixl "\<circ>\<rightarrow>" 60) |
|
37660 | 52 |
|
53 |
||
54 |
subsection {* Type conversions and casting *} |
|
55 |
||
56 |
definition sint :: "'a :: len word => int" where |
|
57 |
-- {* treats the most-significant-bit as a sign bit *} |
|
58 |
sint_uint: "sint w = sbintrunc (len_of TYPE ('a) - 1) (uint w)" |
|
59 |
||
60 |
definition unat :: "'a :: len0 word => nat" where |
|
61 |
"unat w = nat (uint w)" |
|
62 |
||
63 |
definition uints :: "nat => int set" where |
|
64 |
-- "the sets of integers representing the words" |
|
65 |
"uints n = range (bintrunc n)" |
|
66 |
||
67 |
definition sints :: "nat => int set" where |
|
68 |
"sints n = range (sbintrunc (n - 1))" |
|
69 |
||
70 |
definition unats :: "nat => nat set" where |
|
71 |
"unats n = {i. i < 2 ^ n}" |
|
72 |
||
73 |
definition norm_sint :: "nat => int => int" where |
|
74 |
"norm_sint n w = (w + 2 ^ (n - 1)) mod 2 ^ n - 2 ^ (n - 1)" |
|
75 |
||
76 |
definition scast :: "'a :: len word => 'b :: len word" where |
|
77 |
-- "cast a word to a different length" |
|
78 |
"scast w = word_of_int (sint w)" |
|
79 |
||
80 |
definition ucast :: "'a :: len0 word => 'b :: len0 word" where |
|
81 |
"ucast w = word_of_int (uint w)" |
|
82 |
||
83 |
instantiation word :: (len0) size |
|
84 |
begin |
|
85 |
||
86 |
definition |
|
87 |
word_size: "size (w :: 'a word) = len_of TYPE('a)" |
|
88 |
||
89 |
instance .. |
|
90 |
||
91 |
end |
|
92 |
||
93 |
definition source_size :: "('a :: len0 word => 'b) => nat" where |
|
94 |
-- "whether a cast (or other) function is to a longer or shorter length" |
|
95 |
"source_size c = (let arb = undefined ; x = c arb in size arb)" |
|
96 |
||
97 |
definition target_size :: "('a => 'b :: len0 word) => nat" where |
|
98 |
"target_size c = size (c undefined)" |
|
99 |
||
100 |
definition is_up :: "('a :: len0 word => 'b :: len0 word) => bool" where |
|
101 |
"is_up c \<longleftrightarrow> source_size c <= target_size c" |
|
102 |
||
103 |
definition is_down :: "('a :: len0 word => 'b :: len0 word) => bool" where |
|
104 |
"is_down c \<longleftrightarrow> target_size c <= source_size c" |
|
105 |
||
106 |
definition of_bl :: "bool list => 'a :: len0 word" where |
|
107 |
"of_bl bl = word_of_int (bl_to_bin bl)" |
|
108 |
||
109 |
definition to_bl :: "'a :: len0 word => bool list" where |
|
110 |
"to_bl w = bin_to_bl (len_of TYPE ('a)) (uint w)" |
|
111 |
||
112 |
definition word_reverse :: "'a :: len0 word => 'a word" where |
|
113 |
"word_reverse w = of_bl (rev (to_bl w))" |
|
114 |
||
115 |
definition word_int_case :: "(int => 'b) => ('a :: len0 word) => 'b" where |
|
116 |
"word_int_case f w = f (uint w)" |
|
117 |
||
118 |
syntax |
|
119 |
of_int :: "int => 'a" |
|
120 |
translations |
|
121 |
"case x of CONST of_int y => b" == "CONST word_int_case (%y. b) x" |
|
122 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
123 |
subsection {* Type-definition locale instantiations *} |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
124 |
|
45805 | 125 |
lemma word_size_gt_0 [iff]: "0 < size (w::'a::len word)" |
126 |
by (fact xtr1 [OF word_size len_gt_0]) |
|
127 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
128 |
lemmas lens_gt_0 = word_size_gt_0 len_gt_0 |
45604 | 129 |
lemmas lens_not_0 [iff] = lens_gt_0 [THEN gr_implies_not0] |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
130 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
131 |
lemma uints_num: "uints n = {i. 0 \<le> i \<and> i < 2 ^ n}" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
132 |
by (simp add: uints_def range_bintrunc) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
133 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
134 |
lemma sints_num: "sints n = {i. - (2 ^ (n - 1)) \<le> i \<and> i < 2 ^ (n - 1)}" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
135 |
by (simp add: sints_def range_sbintrunc) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
136 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
137 |
lemma mod_in_reps: "m > 0 \<Longrightarrow> y mod m : {0::int ..< m}" |
45805 | 138 |
by auto |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
139 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
140 |
lemma |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
141 |
uint_0:"0 <= uint x" and |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
142 |
uint_lt: "uint (x::'a::len0 word) < 2 ^ len_of TYPE('a)" |
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
143 |
by (auto simp: uint [unfolded atLeastLessThan_iff]) |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
144 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
145 |
lemma uint_mod_same: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
146 |
"uint x mod 2 ^ len_of TYPE('a) = uint (x::'a::len0 word)" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
147 |
by (simp add: int_mod_eq uint_lt uint_0) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
148 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
149 |
lemma td_ext_uint: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
150 |
"td_ext (uint :: 'a word => int) word_of_int (uints (len_of TYPE('a::len0))) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
151 |
(%w::int. w mod 2 ^ len_of TYPE('a))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
152 |
apply (unfold td_ext_def') |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
153 |
apply (simp add: uints_num word_of_int_def bintrunc_mod2p) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
154 |
apply (simp add: uint_mod_same uint_0 uint_lt |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
155 |
word.uint_inverse word.Abs_word_inverse int_mod_lem) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
156 |
done |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
157 |
|
45805 | 158 |
lemma int_word_uint: |
159 |
"uint (word_of_int x::'a::len0 word) = x mod 2 ^ len_of TYPE('a)" |
|
160 |
by (fact td_ext_uint [THEN td_ext.eq_norm]) |
|
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
161 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
162 |
interpretation word_uint: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
163 |
td_ext "uint::'a::len0 word \<Rightarrow> int" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
164 |
word_of_int |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
165 |
"uints (len_of TYPE('a::len0))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
166 |
"\<lambda>w. w mod 2 ^ len_of TYPE('a::len0)" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
167 |
by (rule td_ext_uint) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
168 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
169 |
lemmas td_uint = word_uint.td_thm |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
170 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
171 |
lemmas td_ext_ubin = td_ext_uint |
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
172 |
[unfolded len_gt_0 no_bintr_alt1 [symmetric]] |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
173 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
174 |
interpretation word_ubin: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
175 |
td_ext "uint::'a::len0 word \<Rightarrow> int" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
176 |
word_of_int |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
177 |
"uints (len_of TYPE('a::len0))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
178 |
"bintrunc (len_of TYPE('a::len0))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
179 |
by (rule td_ext_ubin) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
180 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
181 |
lemma split_word_all: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
182 |
"(\<And>x::'a::len0 word. PROP P x) \<equiv> (\<And>x. PROP P (word_of_int x))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
183 |
proof |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
184 |
fix x :: "'a word" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
185 |
assume "\<And>x. PROP P (word_of_int x)" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
186 |
hence "PROP P (word_of_int (uint x))" . |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
187 |
thus "PROP P x" by simp |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
188 |
qed |
37660 | 189 |
|
190 |
subsection "Arithmetic operations" |
|
191 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
192 |
definition |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
193 |
word_succ :: "'a :: len0 word => 'a word" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
194 |
where |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
195 |
"word_succ a = word_of_int (Int.succ (uint a))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
196 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
197 |
definition |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
198 |
word_pred :: "'a :: len0 word => 'a word" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
199 |
where |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
200 |
"word_pred a = word_of_int (Int.pred (uint a))" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
201 |
|
45547 | 202 |
instantiation word :: (len0) "{number, Divides.div, comm_monoid_mult, comm_ring}" |
37660 | 203 |
begin |
204 |
||
205 |
definition |
|
206 |
word_0_wi: "0 = word_of_int 0" |
|
207 |
||
208 |
definition |
|
209 |
word_1_wi: "1 = word_of_int 1" |
|
210 |
||
211 |
definition |
|
212 |
word_add_def: "a + b = word_of_int (uint a + uint b)" |
|
213 |
||
214 |
definition |
|
215 |
word_sub_wi: "a - b = word_of_int (uint a - uint b)" |
|
216 |
||
217 |
definition |
|
218 |
word_minus_def: "- a = word_of_int (- uint a)" |
|
219 |
||
220 |
definition |
|
221 |
word_mult_def: "a * b = word_of_int (uint a * uint b)" |
|
222 |
||
223 |
definition |
|
224 |
word_div_def: "a div b = word_of_int (uint a div uint b)" |
|
225 |
||
226 |
definition |
|
227 |
word_mod_def: "a mod b = word_of_int (uint a mod uint b)" |
|
228 |
||
229 |
definition |
|
230 |
word_number_of_def: "number_of w = word_of_int w" |
|
231 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
232 |
lemmas word_arith_wis = |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
233 |
word_add_def word_mult_def word_minus_def |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
234 |
word_succ_def word_pred_def word_0_wi word_1_wi |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
235 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
236 |
lemmas arths = |
45604 | 237 |
bintr_ariths [THEN word_ubin.norm_eq_iff [THEN iffD1], folded word_ubin.eq_norm] |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
238 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
239 |
lemma wi_homs: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
240 |
shows |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
241 |
wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)" and |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
242 |
wi_hom_mult: "word_of_int a * word_of_int b = word_of_int (a * b)" and |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
243 |
wi_hom_neg: "- word_of_int a = word_of_int (- a)" and |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
244 |
wi_hom_succ: "word_succ (word_of_int a) = word_of_int (Int.succ a)" and |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
245 |
wi_hom_pred: "word_pred (word_of_int a) = word_of_int (Int.pred a)" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
246 |
by (auto simp: word_arith_wis arths) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
247 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
248 |
lemmas wi_hom_syms = wi_homs [symmetric] |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
249 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
250 |
lemma word_of_int_sub_hom: |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
251 |
"(word_of_int a) - word_of_int b = word_of_int (a - b)" |
45805 | 252 |
by (simp add: word_sub_wi arths) |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
253 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
254 |
lemmas new_word_of_int_homs = |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
255 |
word_of_int_sub_hom wi_homs word_0_wi word_1_wi |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
256 |
|
45604 | 257 |
lemmas new_word_of_int_hom_syms = new_word_of_int_homs [symmetric] |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
258 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
259 |
lemmas word_of_int_hom_syms = |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
260 |
new_word_of_int_hom_syms [unfolded succ_def pred_def] |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
261 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
262 |
lemmas word_of_int_homs = |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
263 |
new_word_of_int_homs [unfolded succ_def pred_def] |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
264 |
|
45805 | 265 |
(* FIXME: provide only one copy of these theorems! *) |
266 |
lemmas word_of_int_add_hom = wi_hom_add |
|
267 |
lemmas word_of_int_mult_hom = wi_hom_mult |
|
268 |
lemmas word_of_int_minus_hom = wi_hom_neg |
|
269 |
lemmas word_of_int_succ_hom = wi_hom_succ [unfolded succ_def] |
|
270 |
lemmas word_of_int_pred_hom = wi_hom_pred [unfolded pred_def] |
|
271 |
lemmas word_of_int_0_hom = word_0_wi |
|
272 |
lemmas word_of_int_1_hom = word_1_wi |
|
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
273 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
274 |
instance |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
275 |
by default (auto simp: split_word_all word_of_int_homs algebra_simps) |
37660 | 276 |
|
277 |
end |
|
278 |
||
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
279 |
instance word :: (len) comm_ring_1 |
45810 | 280 |
proof |
281 |
have "0 < len_of TYPE('a)" by (rule len_gt_0) |
|
282 |
then show "(0::'a word) \<noteq> 1" |
|
283 |
unfolding word_0_wi word_1_wi |
|
284 |
by (auto simp add: word_ubin.norm_eq_iff [symmetric] gr0_conv_Suc) |
|
285 |
qed |
|
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
286 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
287 |
lemma word_of_nat: "of_nat n = word_of_int (int n)" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
288 |
by (induct n) (auto simp add : word_of_int_hom_syms) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
289 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
290 |
lemma word_of_int: "of_int = word_of_int" |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
291 |
apply (rule ext) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
292 |
apply (case_tac x rule: int_diff_cases) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
293 |
apply (simp add: word_of_nat word_of_int_sub_hom) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
294 |
done |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
295 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
296 |
instance word :: (len) number_ring |
45810 | 297 |
by (default, simp add: word_number_of_def word_of_int) |
37660 | 298 |
|
299 |
definition udvd :: "'a::len word => 'a::len word => bool" (infixl "udvd" 50) where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
300 |
"a udvd b = (EX n>=0. uint b = n * uint a)" |
37660 | 301 |
|
45547 | 302 |
|
303 |
subsection "Ordering" |
|
304 |
||
305 |
instantiation word :: (len0) linorder |
|
306 |
begin |
|
307 |
||
37660 | 308 |
definition |
309 |
word_le_def: "a \<le> b \<longleftrightarrow> uint a \<le> uint b" |
|
310 |
||
311 |
definition |
|
312 |
word_less_def: "x < y \<longleftrightarrow> x \<le> y \<and> x \<noteq> (y \<Colon> 'a word)" |
|
313 |
||
45547 | 314 |
instance |
315 |
by default (auto simp: word_less_def word_le_def) |
|
316 |
||
317 |
end |
|
318 |
||
37660 | 319 |
definition word_sle :: "'a :: len word => 'a word => bool" ("(_/ <=s _)" [50, 51] 50) where |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
320 |
"a <=s b = (sint a <= sint b)" |
37660 | 321 |
|
322 |
definition word_sless :: "'a :: len word => 'a word => bool" ("(_/ <s _)" [50, 51] 50) where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
323 |
"(x <s y) = (x <=s y & x ~= y)" |
37660 | 324 |
|
325 |
||
326 |
subsection "Bit-wise operations" |
|
327 |
||
328 |
instantiation word :: (len0) bits |
|
329 |
begin |
|
330 |
||
331 |
definition |
|
332 |
word_and_def: |
|
333 |
"(a::'a word) AND b = word_of_int (uint a AND uint b)" |
|
334 |
||
335 |
definition |
|
336 |
word_or_def: |
|
337 |
"(a::'a word) OR b = word_of_int (uint a OR uint b)" |
|
338 |
||
339 |
definition |
|
340 |
word_xor_def: |
|
341 |
"(a::'a word) XOR b = word_of_int (uint a XOR uint b)" |
|
342 |
||
343 |
definition |
|
344 |
word_not_def: |
|
345 |
"NOT (a::'a word) = word_of_int (NOT (uint a))" |
|
346 |
||
347 |
definition |
|
348 |
word_test_bit_def: "test_bit a = bin_nth (uint a)" |
|
349 |
||
350 |
definition |
|
351 |
word_set_bit_def: "set_bit a n x = |
|
352 |
word_of_int (bin_sc n (If x 1 0) (uint a))" |
|
353 |
||
354 |
definition |
|
355 |
word_set_bits_def: "(BITS n. f n) = of_bl (bl_of_nth (len_of TYPE ('a)) f)" |
|
356 |
||
357 |
definition |
|
358 |
word_lsb_def: "lsb a \<longleftrightarrow> bin_last (uint a) = 1" |
|
359 |
||
360 |
definition shiftl1 :: "'a word \<Rightarrow> 'a word" where |
|
361 |
"shiftl1 w = word_of_int (uint w BIT 0)" |
|
362 |
||
363 |
definition shiftr1 :: "'a word \<Rightarrow> 'a word" where |
|
364 |
-- "shift right as unsigned or as signed, ie logical or arithmetic" |
|
365 |
"shiftr1 w = word_of_int (bin_rest (uint w))" |
|
366 |
||
367 |
definition |
|
368 |
shiftl_def: "w << n = (shiftl1 ^^ n) w" |
|
369 |
||
370 |
definition |
|
371 |
shiftr_def: "w >> n = (shiftr1 ^^ n) w" |
|
372 |
||
373 |
instance .. |
|
374 |
||
375 |
end |
|
376 |
||
377 |
instantiation word :: (len) bitss |
|
378 |
begin |
|
379 |
||
380 |
definition |
|
381 |
word_msb_def: |
|
382 |
"msb a \<longleftrightarrow> bin_sign (sint a) = Int.Min" |
|
383 |
||
384 |
instance .. |
|
385 |
||
386 |
end |
|
387 |
||
37667 | 388 |
lemma [code]: |
389 |
"msb a \<longleftrightarrow> bin_sign (sint a) = (- 1 :: int)" |
|
390 |
by (simp only: word_msb_def Min_def) |
|
391 |
||
37660 | 392 |
definition setBit :: "'a :: len0 word => nat => 'a word" where |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
393 |
"setBit w n = set_bit w n True" |
37660 | 394 |
|
395 |
definition clearBit :: "'a :: len0 word => nat => 'a word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
396 |
"clearBit w n = set_bit w n False" |
37660 | 397 |
|
398 |
||
399 |
subsection "Shift operations" |
|
400 |
||
401 |
definition sshiftr1 :: "'a :: len word => 'a word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
402 |
"sshiftr1 w = word_of_int (bin_rest (sint w))" |
37660 | 403 |
|
404 |
definition bshiftr1 :: "bool => 'a :: len word => 'a word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
405 |
"bshiftr1 b w = of_bl (b # butlast (to_bl w))" |
37660 | 406 |
|
407 |
definition sshiftr :: "'a :: len word => nat => 'a word" (infixl ">>>" 55) where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
408 |
"w >>> n = (sshiftr1 ^^ n) w" |
37660 | 409 |
|
410 |
definition mask :: "nat => 'a::len word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
411 |
"mask n = (1 << n) - 1" |
37660 | 412 |
|
413 |
definition revcast :: "'a :: len0 word => 'b :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
414 |
"revcast w = of_bl (takefill False (len_of TYPE('b)) (to_bl w))" |
37660 | 415 |
|
416 |
definition slice1 :: "nat => 'a :: len0 word => 'b :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
417 |
"slice1 n w = of_bl (takefill False n (to_bl w))" |
37660 | 418 |
|
419 |
definition slice :: "nat => 'a :: len0 word => 'b :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
420 |
"slice n w = slice1 (size w - n) w" |
37660 | 421 |
|
422 |
||
423 |
subsection "Rotation" |
|
424 |
||
425 |
definition rotater1 :: "'a list => 'a list" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
426 |
"rotater1 ys = |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
427 |
(case ys of [] => [] | x # xs => last ys # butlast ys)" |
37660 | 428 |
|
429 |
definition rotater :: "nat => 'a list => 'a list" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
430 |
"rotater n = rotater1 ^^ n" |
37660 | 431 |
|
432 |
definition word_rotr :: "nat => 'a :: len0 word => 'a :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
433 |
"word_rotr n w = of_bl (rotater n (to_bl w))" |
37660 | 434 |
|
435 |
definition word_rotl :: "nat => 'a :: len0 word => 'a :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
436 |
"word_rotl n w = of_bl (rotate n (to_bl w))" |
37660 | 437 |
|
438 |
definition word_roti :: "int => 'a :: len0 word => 'a :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
439 |
"word_roti i w = (if i >= 0 then word_rotr (nat i) w |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
440 |
else word_rotl (nat (- i)) w)" |
37660 | 441 |
|
442 |
||
443 |
subsection "Split and cat operations" |
|
444 |
||
445 |
definition word_cat :: "'a :: len0 word => 'b :: len0 word => 'c :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
446 |
"word_cat a b = word_of_int (bin_cat (uint a) (len_of TYPE ('b)) (uint b))" |
37660 | 447 |
|
448 |
definition word_split :: "'a :: len0 word => ('b :: len0 word) * ('c :: len0 word)" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
449 |
"word_split a = |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
450 |
(case bin_split (len_of TYPE ('c)) (uint a) of |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
451 |
(u, v) => (word_of_int u, word_of_int v))" |
37660 | 452 |
|
453 |
definition word_rcat :: "'a :: len0 word list => 'b :: len0 word" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
454 |
"word_rcat ws = |
37660 | 455 |
word_of_int (bin_rcat (len_of TYPE ('a)) (map uint ws))" |
456 |
||
457 |
definition word_rsplit :: "'a :: len0 word => 'b :: len word list" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
458 |
"word_rsplit w = |
37660 | 459 |
map word_of_int (bin_rsplit (len_of TYPE ('b)) (len_of TYPE ('a), uint w))" |
460 |
||
461 |
definition max_word :: "'a::len word" -- "Largest representable machine integer." where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
462 |
"max_word = word_of_int (2 ^ len_of TYPE('a) - 1)" |
37660 | 463 |
|
464 |
primrec of_bool :: "bool \<Rightarrow> 'a::len word" where |
|
465 |
"of_bool False = 0" |
|
466 |
| "of_bool True = 1" |
|
467 |
||
45805 | 468 |
(* FIXME: only provide one theorem name *) |
37660 | 469 |
lemmas of_nth_def = word_set_bits_def |
470 |
||
471 |
lemma sint_sbintrunc': |
|
472 |
"sint (word_of_int bin :: 'a word) = |
|
473 |
(sbintrunc (len_of TYPE ('a :: len) - 1) bin)" |
|
474 |
unfolding sint_uint |
|
475 |
by (auto simp: word_ubin.eq_norm sbintrunc_bintrunc_lt) |
|
476 |
||
477 |
lemma uint_sint: |
|
478 |
"uint w = bintrunc (len_of TYPE('a)) (sint (w :: 'a :: len word))" |
|
479 |
unfolding sint_uint by (auto simp: bintrunc_sbintrunc_le) |
|
480 |
||
481 |
lemma bintr_uint': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
482 |
"n >= size w \<Longrightarrow> bintrunc n (uint w) = uint w" |
37660 | 483 |
apply (unfold word_size) |
484 |
apply (subst word_ubin.norm_Rep [symmetric]) |
|
485 |
apply (simp only: bintrunc_bintrunc_min word_size) |
|
486 |
apply (simp add: min_max.inf_absorb2) |
|
487 |
done |
|
488 |
||
489 |
lemma wi_bintr': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
490 |
"wb = word_of_int bin \<Longrightarrow> n >= size wb \<Longrightarrow> |
37660 | 491 |
word_of_int (bintrunc n bin) = wb" |
492 |
unfolding word_size |
|
493 |
by (clarsimp simp add: word_ubin.norm_eq_iff [symmetric] min_max.inf_absorb1) |
|
494 |
||
495 |
lemmas bintr_uint = bintr_uint' [unfolded word_size] |
|
496 |
lemmas wi_bintr = wi_bintr' [unfolded word_size] |
|
497 |
||
498 |
lemma td_ext_sbin: |
|
499 |
"td_ext (sint :: 'a word => int) word_of_int (sints (len_of TYPE('a::len))) |
|
500 |
(sbintrunc (len_of TYPE('a) - 1))" |
|
501 |
apply (unfold td_ext_def' sint_uint) |
|
502 |
apply (simp add : word_ubin.eq_norm) |
|
503 |
apply (cases "len_of TYPE('a)") |
|
504 |
apply (auto simp add : sints_def) |
|
505 |
apply (rule sym [THEN trans]) |
|
506 |
apply (rule word_ubin.Abs_norm) |
|
507 |
apply (simp only: bintrunc_sbintrunc) |
|
508 |
apply (drule sym) |
|
509 |
apply simp |
|
510 |
done |
|
511 |
||
512 |
lemmas td_ext_sint = td_ext_sbin |
|
513 |
[simplified len_gt_0 no_sbintr_alt2 Suc_pred' [symmetric]] |
|
514 |
||
515 |
(* We do sint before sbin, before sint is the user version |
|
516 |
and interpretations do not produce thm duplicates. I.e. |
|
517 |
we get the name word_sint.Rep_eqD, but not word_sbin.Req_eqD, |
|
518 |
because the latter is the same thm as the former *) |
|
519 |
interpretation word_sint: |
|
520 |
td_ext "sint ::'a::len word => int" |
|
521 |
word_of_int |
|
522 |
"sints (len_of TYPE('a::len))" |
|
523 |
"%w. (w + 2^(len_of TYPE('a::len) - 1)) mod 2^len_of TYPE('a::len) - |
|
524 |
2 ^ (len_of TYPE('a::len) - 1)" |
|
525 |
by (rule td_ext_sint) |
|
526 |
||
527 |
interpretation word_sbin: |
|
528 |
td_ext "sint ::'a::len word => int" |
|
529 |
word_of_int |
|
530 |
"sints (len_of TYPE('a::len))" |
|
531 |
"sbintrunc (len_of TYPE('a::len) - 1)" |
|
532 |
by (rule td_ext_sbin) |
|
533 |
||
45604 | 534 |
lemmas int_word_sint = td_ext_sint [THEN td_ext.eq_norm] |
37660 | 535 |
|
536 |
lemmas td_sint = word_sint.td |
|
537 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
538 |
lemma word_number_of_alt [code_unfold_post]: |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
539 |
"number_of b = word_of_int (number_of b)" |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
540 |
by (simp add: number_of_eq word_number_of_def) |
37660 | 541 |
|
542 |
lemma word_no_wi: "number_of = word_of_int" |
|
44762 | 543 |
by (auto simp: word_number_of_def) |
37660 | 544 |
|
545 |
lemma to_bl_def': |
|
546 |
"(to_bl :: 'a :: len0 word => bool list) = |
|
547 |
bin_to_bl (len_of TYPE('a)) o uint" |
|
44762 | 548 |
by (auto simp: to_bl_def) |
37660 | 549 |
|
45604 | 550 |
lemmas word_reverse_no_def [simp] = word_reverse_def [of "number_of w"] for w |
37660 | 551 |
|
45805 | 552 |
lemma uints_mod: "uints n = range (\<lambda>w. w mod 2 ^ n)" |
553 |
by (fact uints_def [unfolded no_bintr_alt1]) |
|
554 |
||
555 |
lemma uint_bintrunc [simp]: |
|
556 |
"uint (number_of bin :: 'a word) = |
|
37660 | 557 |
number_of (bintrunc (len_of TYPE ('a :: len0)) bin)" |
558 |
unfolding word_number_of_def number_of_eq |
|
559 |
by (auto intro: word_ubin.eq_norm) |
|
560 |
||
45805 | 561 |
lemma sint_sbintrunc [simp]: |
562 |
"sint (number_of bin :: 'a word) = |
|
37660 | 563 |
number_of (sbintrunc (len_of TYPE ('a :: len) - 1) bin)" |
564 |
unfolding word_number_of_def number_of_eq |
|
565 |
by (subst word_sbin.eq_norm) simp |
|
566 |
||
45805 | 567 |
lemma unat_bintrunc [simp]: |
37660 | 568 |
"unat (number_of bin :: 'a :: len0 word) = |
569 |
number_of (bintrunc (len_of TYPE('a)) bin)" |
|
570 |
unfolding unat_def nat_number_of_def |
|
571 |
by (simp only: uint_bintrunc) |
|
572 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
573 |
lemma size_0_eq: "size (w :: 'a :: len0 word) = 0 \<Longrightarrow> v = w" |
37660 | 574 |
apply (unfold word_size) |
575 |
apply (rule word_uint.Rep_eqD) |
|
576 |
apply (rule box_equals) |
|
577 |
defer |
|
578 |
apply (rule word_ubin.norm_Rep)+ |
|
579 |
apply simp |
|
580 |
done |
|
581 |
||
45805 | 582 |
lemma uint_ge_0 [iff]: "0 \<le> uint (x::'a::len0 word)" |
583 |
using word_uint.Rep [of x] by (simp add: uints_num) |
|
584 |
||
585 |
lemma uint_lt2p [iff]: "uint (x::'a::len0 word) < 2 ^ len_of TYPE('a)" |
|
586 |
using word_uint.Rep [of x] by (simp add: uints_num) |
|
587 |
||
588 |
lemma sint_ge: "- (2 ^ (len_of TYPE('a) - 1)) \<le> sint (x::'a::len word)" |
|
589 |
using word_sint.Rep [of x] by (simp add: sints_num) |
|
590 |
||
591 |
lemma sint_lt: "sint (x::'a::len word) < 2 ^ (len_of TYPE('a) - 1)" |
|
592 |
using word_sint.Rep [of x] by (simp add: sints_num) |
|
37660 | 593 |
|
594 |
lemma sign_uint_Pls [simp]: |
|
595 |
"bin_sign (uint x) = Int.Pls" |
|
596 |
by (simp add: sign_Pls_ge_0 number_of_eq) |
|
597 |
||
45805 | 598 |
lemma uint_m2p_neg: "uint (x::'a::len0 word) - 2 ^ len_of TYPE('a) < 0" |
599 |
by (simp only: diff_less_0_iff_less uint_lt2p) |
|
600 |
||
601 |
lemma uint_m2p_not_non_neg: |
|
602 |
"\<not> 0 \<le> uint (x::'a::len0 word) - 2 ^ len_of TYPE('a)" |
|
603 |
by (simp only: not_le uint_m2p_neg) |
|
37660 | 604 |
|
605 |
lemma lt2p_lem: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
606 |
"len_of TYPE('a) <= n \<Longrightarrow> uint (w :: 'a :: len0 word) < 2 ^ n" |
37660 | 607 |
by (rule xtr8 [OF _ uint_lt2p]) simp |
608 |
||
45805 | 609 |
lemma uint_le_0_iff [simp]: "uint x \<le> 0 \<longleftrightarrow> uint x = 0" |
610 |
by (fact uint_ge_0 [THEN leD, THEN linorder_antisym_conv1]) |
|
37660 | 611 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
612 |
lemma uint_nat: "uint w = int (unat w)" |
37660 | 613 |
unfolding unat_def by auto |
614 |
||
615 |
lemma uint_number_of: |
|
616 |
"uint (number_of b :: 'a :: len0 word) = number_of b mod 2 ^ len_of TYPE('a)" |
|
617 |
unfolding word_number_of_alt |
|
618 |
by (simp only: int_word_uint) |
|
619 |
||
620 |
lemma unat_number_of: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
621 |
"bin_sign b = Int.Pls \<Longrightarrow> |
37660 | 622 |
unat (number_of b::'a::len0 word) = number_of b mod 2 ^ len_of TYPE ('a)" |
623 |
apply (unfold unat_def) |
|
624 |
apply (clarsimp simp only: uint_number_of) |
|
625 |
apply (rule nat_mod_distrib [THEN trans]) |
|
626 |
apply (erule sign_Pls_ge_0 [THEN iffD1]) |
|
627 |
apply (simp_all add: nat_power_eq) |
|
628 |
done |
|
629 |
||
630 |
lemma sint_number_of: "sint (number_of b :: 'a :: len word) = (number_of b + |
|
631 |
2 ^ (len_of TYPE('a) - 1)) mod 2 ^ len_of TYPE('a) - |
|
632 |
2 ^ (len_of TYPE('a) - 1)" |
|
633 |
unfolding word_number_of_alt by (rule int_word_sint) |
|
634 |
||
45958 | 635 |
lemma word_of_int_0: "word_of_int 0 = 0" |
636 |
unfolding word_0_wi .. |
|
637 |
||
638 |
lemma word_of_int_1: "word_of_int 1 = 1" |
|
639 |
unfolding word_1_wi .. |
|
640 |
||
37660 | 641 |
lemma word_of_int_bin [simp] : |
642 |
"(word_of_int (number_of bin) :: 'a :: len0 word) = (number_of bin)" |
|
643 |
unfolding word_number_of_alt by auto |
|
644 |
||
645 |
lemma word_int_case_wi: |
|
646 |
"word_int_case f (word_of_int i :: 'b word) = |
|
647 |
f (i mod 2 ^ len_of TYPE('b::len0))" |
|
648 |
unfolding word_int_case_def by (simp add: word_uint.eq_norm) |
|
649 |
||
650 |
lemma word_int_split: |
|
651 |
"P (word_int_case f x) = |
|
652 |
(ALL i. x = (word_of_int i :: 'b :: len0 word) & |
|
653 |
0 <= i & i < 2 ^ len_of TYPE('b) --> P (f i))" |
|
654 |
unfolding word_int_case_def |
|
655 |
by (auto simp: word_uint.eq_norm int_mod_eq') |
|
656 |
||
657 |
lemma word_int_split_asm: |
|
658 |
"P (word_int_case f x) = |
|
659 |
(~ (EX n. x = (word_of_int n :: 'b::len0 word) & |
|
660 |
0 <= n & n < 2 ^ len_of TYPE('b::len0) & ~ P (f n)))" |
|
661 |
unfolding word_int_case_def |
|
662 |
by (auto simp: word_uint.eq_norm int_mod_eq') |
|
45805 | 663 |
|
45604 | 664 |
lemmas uint_range' = word_uint.Rep [unfolded uints_num mem_Collect_eq] |
665 |
lemmas sint_range' = word_sint.Rep [unfolded One_nat_def sints_num mem_Collect_eq] |
|
37660 | 666 |
|
667 |
lemma uint_range_size: "0 <= uint w & uint w < 2 ^ size w" |
|
668 |
unfolding word_size by (rule uint_range') |
|
669 |
||
670 |
lemma sint_range_size: |
|
671 |
"- (2 ^ (size w - Suc 0)) <= sint w & sint w < 2 ^ (size w - Suc 0)" |
|
672 |
unfolding word_size by (rule sint_range') |
|
673 |
||
45805 | 674 |
lemma sint_above_size: "2 ^ (size (w::'a::len word) - 1) \<le> x \<Longrightarrow> sint w < x" |
675 |
unfolding word_size by (rule less_le_trans [OF sint_lt]) |
|
676 |
||
677 |
lemma sint_below_size: |
|
678 |
"x \<le> - (2 ^ (size (w::'a::len word) - 1)) \<Longrightarrow> x \<le> sint w" |
|
679 |
unfolding word_size by (rule order_trans [OF _ sint_ge]) |
|
37660 | 680 |
|
681 |
lemma test_bit_eq_iff: "(test_bit (u::'a::len0 word) = test_bit v) = (u = v)" |
|
682 |
unfolding word_test_bit_def by (simp add: bin_nth_eq_iff) |
|
683 |
||
684 |
lemma test_bit_size [rule_format] : "(w::'a::len0 word) !! n --> n < size w" |
|
685 |
apply (unfold word_test_bit_def) |
|
686 |
apply (subst word_ubin.norm_Rep [symmetric]) |
|
687 |
apply (simp only: nth_bintr word_size) |
|
688 |
apply fast |
|
689 |
done |
|
690 |
||
691 |
lemma word_eqI [rule_format] : |
|
692 |
fixes u :: "'a::len0 word" |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
693 |
shows "(ALL n. n < size u --> u !! n = v !! n) \<Longrightarrow> u = v" |
37660 | 694 |
apply (rule test_bit_eq_iff [THEN iffD1]) |
695 |
apply (rule ext) |
|
696 |
apply (erule allE) |
|
697 |
apply (erule impCE) |
|
698 |
prefer 2 |
|
699 |
apply assumption |
|
700 |
apply (auto dest!: test_bit_size simp add: word_size) |
|
701 |
done |
|
702 |
||
45805 | 703 |
lemma word_eqD: "(u::'a::len0 word) = v \<Longrightarrow> u !! x = v !! x" |
704 |
by simp |
|
37660 | 705 |
|
706 |
lemma test_bit_bin': "w !! n = (n < size w & bin_nth (uint w) n)" |
|
707 |
unfolding word_test_bit_def word_size |
|
708 |
by (simp add: nth_bintr [symmetric]) |
|
709 |
||
710 |
lemmas test_bit_bin = test_bit_bin' [unfolded word_size] |
|
711 |
||
712 |
lemma bin_nth_uint_imp': "bin_nth (uint w) n --> n < size w" |
|
713 |
apply (unfold word_size) |
|
714 |
apply (rule impI) |
|
715 |
apply (rule nth_bintr [THEN iffD1, THEN conjunct1]) |
|
716 |
apply (subst word_ubin.norm_Rep) |
|
717 |
apply assumption |
|
718 |
done |
|
719 |
||
720 |
lemma bin_nth_sint': |
|
721 |
"n >= size w --> bin_nth (sint w) n = bin_nth (sint w) (size w - 1)" |
|
722 |
apply (rule impI) |
|
723 |
apply (subst word_sbin.norm_Rep [symmetric]) |
|
724 |
apply (simp add : nth_sbintr word_size) |
|
725 |
apply auto |
|
726 |
done |
|
727 |
||
728 |
lemmas bin_nth_uint_imp = bin_nth_uint_imp' [rule_format, unfolded word_size] |
|
729 |
lemmas bin_nth_sint = bin_nth_sint' [rule_format, unfolded word_size] |
|
730 |
||
731 |
(* type definitions theorem for in terms of equivalent bool list *) |
|
732 |
lemma td_bl: |
|
733 |
"type_definition (to_bl :: 'a::len0 word => bool list) |
|
734 |
of_bl |
|
735 |
{bl. length bl = len_of TYPE('a)}" |
|
736 |
apply (unfold type_definition_def of_bl_def to_bl_def) |
|
737 |
apply (simp add: word_ubin.eq_norm) |
|
738 |
apply safe |
|
739 |
apply (drule sym) |
|
740 |
apply simp |
|
741 |
done |
|
742 |
||
743 |
interpretation word_bl: |
|
744 |
type_definition "to_bl :: 'a::len0 word => bool list" |
|
745 |
of_bl |
|
746 |
"{bl. length bl = len_of TYPE('a::len0)}" |
|
747 |
by (rule td_bl) |
|
748 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
749 |
lemmas word_bl_Rep' = word_bl.Rep [unfolded mem_Collect_eq, iff] |
45538
1fffa81b9b83
eliminated slightly odd Rep' with dynamically-scoped [simplified];
wenzelm
parents:
45529
diff
changeset
|
750 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
751 |
lemma word_size_bl: "size w = size (to_bl w)" |
37660 | 752 |
unfolding word_size by auto |
753 |
||
754 |
lemma to_bl_use_of_bl: |
|
755 |
"(to_bl w = bl) = (w = of_bl bl \<and> length bl = length (to_bl w))" |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
756 |
by (fastforce elim!: word_bl.Abs_inverse [unfolded mem_Collect_eq]) |
37660 | 757 |
|
758 |
lemma to_bl_word_rev: "to_bl (word_reverse w) = rev (to_bl w)" |
|
759 |
unfolding word_reverse_def by (simp add: word_bl.Abs_inverse) |
|
760 |
||
761 |
lemma word_rev_rev [simp] : "word_reverse (word_reverse w) = w" |
|
762 |
unfolding word_reverse_def by (simp add : word_bl.Abs_inverse) |
|
763 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
764 |
lemma word_rev_gal: "word_reverse w = u \<Longrightarrow> word_reverse u = w" |
37660 | 765 |
by auto |
766 |
||
45805 | 767 |
lemma word_rev_gal': "u = word_reverse w \<Longrightarrow> w = word_reverse u" |
768 |
by simp |
|
769 |
||
770 |
lemma length_bl_gt_0 [iff]: "0 < length (to_bl (x::'a::len word))" |
|
771 |
unfolding word_bl_Rep' by (rule len_gt_0) |
|
772 |
||
773 |
lemma bl_not_Nil [iff]: "to_bl (x::'a::len word) \<noteq> []" |
|
774 |
by (fact length_bl_gt_0 [unfolded length_greater_0_conv]) |
|
775 |
||
776 |
lemma length_bl_neq_0 [iff]: "length (to_bl (x::'a::len word)) \<noteq> 0" |
|
777 |
by (fact length_bl_gt_0 [THEN gr_implies_not0]) |
|
37660 | 778 |
|
779 |
lemma hd_bl_sign_sint: "hd (to_bl w) = (bin_sign (sint w) = Int.Min)" |
|
780 |
apply (unfold to_bl_def sint_uint) |
|
781 |
apply (rule trans [OF _ bl_sbin_sign]) |
|
782 |
apply simp |
|
783 |
done |
|
784 |
||
785 |
lemma of_bl_drop': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
786 |
"lend = length bl - len_of TYPE ('a :: len0) \<Longrightarrow> |
37660 | 787 |
of_bl (drop lend bl) = (of_bl bl :: 'a word)" |
788 |
apply (unfold of_bl_def) |
|
789 |
apply (clarsimp simp add : trunc_bl2bin [symmetric]) |
|
790 |
done |
|
791 |
||
45805 | 792 |
lemma of_bl_no: "of_bl bl = number_of (bl_to_bin bl)" |
793 |
by (fact of_bl_def [folded word_number_of_def]) |
|
37660 | 794 |
|
795 |
lemma test_bit_of_bl: |
|
796 |
"(of_bl bl::'a::len0 word) !! n = (rev bl ! n \<and> n < len_of TYPE('a) \<and> n < length bl)" |
|
797 |
apply (unfold of_bl_def word_test_bit_def) |
|
798 |
apply (auto simp add: word_size word_ubin.eq_norm nth_bintr bin_nth_of_bl) |
|
799 |
done |
|
800 |
||
801 |
lemma no_of_bl: |
|
802 |
"(number_of bin ::'a::len0 word) = of_bl (bin_to_bl (len_of TYPE ('a)) bin)" |
|
803 |
unfolding word_size of_bl_no by (simp add : word_number_of_def) |
|
804 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
805 |
lemma uint_bl: "to_bl w = bin_to_bl (size w) (uint w)" |
37660 | 806 |
unfolding word_size to_bl_def by auto |
807 |
||
808 |
lemma to_bl_bin: "bl_to_bin (to_bl w) = uint w" |
|
809 |
unfolding uint_bl by (simp add : word_size) |
|
810 |
||
811 |
lemma to_bl_of_bin: |
|
812 |
"to_bl (word_of_int bin::'a::len0 word) = bin_to_bl (len_of TYPE('a)) bin" |
|
813 |
unfolding uint_bl by (clarsimp simp add: word_ubin.eq_norm word_size) |
|
814 |
||
45805 | 815 |
lemma to_bl_no_bin [simp]: |
816 |
"to_bl (number_of bin::'a::len0 word) = bin_to_bl (len_of TYPE('a)) bin" |
|
817 |
by (fact to_bl_of_bin [folded word_number_of_def]) |
|
37660 | 818 |
|
819 |
lemma to_bl_to_bin [simp] : "bl_to_bin (to_bl w) = uint w" |
|
820 |
unfolding uint_bl by (simp add : word_size) |
|
821 |
||
45604 | 822 |
lemmas uint_bl_bin [simp] = trans [OF bin_bl_bin word_ubin.norm_Rep] |
823 |
||
45805 | 824 |
(* FIXME: the next two lemmas should be unnecessary, because the lhs |
825 |
terms should never occur in practice *) |
|
826 |
lemma num_AB_u [simp]: "number_of (uint x) = x" |
|
827 |
unfolding word_number_of_def by (rule word_uint.Rep_inverse) |
|
828 |
||
829 |
lemma num_AB_s [simp]: "number_of (sint x) = x" |
|
830 |
unfolding word_number_of_def by (rule word_sint.Rep_inverse) |
|
37660 | 831 |
|
832 |
(* naturals *) |
|
833 |
lemma uints_unats: "uints n = int ` unats n" |
|
834 |
apply (unfold unats_def uints_num) |
|
835 |
apply safe |
|
836 |
apply (rule_tac image_eqI) |
|
837 |
apply (erule_tac nat_0_le [symmetric]) |
|
838 |
apply auto |
|
839 |
apply (erule_tac nat_less_iff [THEN iffD2]) |
|
840 |
apply (rule_tac [2] zless_nat_eq_int_zless [THEN iffD1]) |
|
841 |
apply (auto simp add : nat_power_eq int_power) |
|
842 |
done |
|
843 |
||
844 |
lemma unats_uints: "unats n = nat ` uints n" |
|
845 |
by (auto simp add : uints_unats image_iff) |
|
846 |
||
45604 | 847 |
lemmas bintr_num = word_ubin.norm_eq_iff [symmetric, folded word_number_of_def] |
848 |
lemmas sbintr_num = word_sbin.norm_eq_iff [symmetric, folded word_number_of_def] |
|
849 |
||
850 |
lemmas num_of_bintr = word_ubin.Abs_norm [folded word_number_of_def] |
|
851 |
lemmas num_of_sbintr = word_sbin.Abs_norm [folded word_number_of_def] |
|
37660 | 852 |
|
853 |
(* don't add these to simpset, since may want bintrunc n w to be simplified; |
|
854 |
may want these in reverse, but loop as simp rules, so use following *) |
|
855 |
||
856 |
lemma num_of_bintr': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
857 |
"bintrunc (len_of TYPE('a :: len0)) a = b \<Longrightarrow> |
37660 | 858 |
number_of a = (number_of b :: 'a word)" |
859 |
apply safe |
|
860 |
apply (rule_tac num_of_bintr [symmetric]) |
|
861 |
done |
|
862 |
||
863 |
lemma num_of_sbintr': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
864 |
"sbintrunc (len_of TYPE('a :: len) - 1) a = b \<Longrightarrow> |
37660 | 865 |
number_of a = (number_of b :: 'a word)" |
866 |
apply safe |
|
867 |
apply (rule_tac num_of_sbintr [symmetric]) |
|
868 |
done |
|
869 |
||
45604 | 870 |
lemmas num_abs_bintr = sym [THEN trans, OF num_of_bintr word_number_of_def] |
871 |
lemmas num_abs_sbintr = sym [THEN trans, OF num_of_sbintr word_number_of_def] |
|
37660 | 872 |
|
873 |
(** cast - note, no arg for new length, as it's determined by type of result, |
|
874 |
thus in "cast w = w, the type means cast to length of w! **) |
|
875 |
||
876 |
lemma ucast_id: "ucast w = w" |
|
877 |
unfolding ucast_def by auto |
|
878 |
||
879 |
lemma scast_id: "scast w = w" |
|
880 |
unfolding scast_def by auto |
|
881 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
882 |
lemma ucast_bl: "ucast w = of_bl (to_bl w)" |
37660 | 883 |
unfolding ucast_def of_bl_def uint_bl |
884 |
by (auto simp add : word_size) |
|
885 |
||
886 |
lemma nth_ucast: |
|
887 |
"(ucast w::'a::len0 word) !! n = (w !! n & n < len_of TYPE('a))" |
|
888 |
apply (unfold ucast_def test_bit_bin) |
|
889 |
apply (simp add: word_ubin.eq_norm nth_bintr word_size) |
|
890 |
apply (fast elim!: bin_nth_uint_imp) |
|
891 |
done |
|
892 |
||
893 |
(* for literal u(s)cast *) |
|
894 |
||
895 |
lemma ucast_bintr [simp]: |
|
896 |
"ucast (number_of w ::'a::len0 word) = |
|
897 |
number_of (bintrunc (len_of TYPE('a)) w)" |
|
898 |
unfolding ucast_def by simp |
|
899 |
||
900 |
lemma scast_sbintr [simp]: |
|
901 |
"scast (number_of w ::'a::len word) = |
|
902 |
number_of (sbintrunc (len_of TYPE('a) - Suc 0) w)" |
|
903 |
unfolding scast_def by simp |
|
904 |
||
905 |
lemmas source_size = source_size_def [unfolded Let_def word_size] |
|
906 |
lemmas target_size = target_size_def [unfolded Let_def word_size] |
|
907 |
lemmas is_down = is_down_def [unfolded source_size target_size] |
|
908 |
lemmas is_up = is_up_def [unfolded source_size target_size] |
|
909 |
||
45604 | 910 |
lemmas is_up_down = trans [OF is_up is_down [symmetric]] |
37660 | 911 |
|
45811 | 912 |
lemma down_cast_same [OF refl]: "uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc = scast" |
37660 | 913 |
apply (unfold is_down) |
914 |
apply safe |
|
915 |
apply (rule ext) |
|
916 |
apply (unfold ucast_def scast_def uint_sint) |
|
917 |
apply (rule word_ubin.norm_eq_iff [THEN iffD1]) |
|
918 |
apply simp |
|
919 |
done |
|
920 |
||
45811 | 921 |
lemma word_rev_tf: |
922 |
"to_bl (of_bl bl::'a::len0 word) = |
|
923 |
rev (takefill False (len_of TYPE('a)) (rev bl))" |
|
37660 | 924 |
unfolding of_bl_def uint_bl |
925 |
by (clarsimp simp add: bl_bin_bl_rtf word_ubin.eq_norm word_size) |
|
926 |
||
45811 | 927 |
lemma word_rep_drop: |
928 |
"to_bl (of_bl bl::'a::len0 word) = |
|
929 |
replicate (len_of TYPE('a) - length bl) False @ |
|
930 |
drop (length bl - len_of TYPE('a)) bl" |
|
931 |
by (simp add: word_rev_tf takefill_alt rev_take) |
|
37660 | 932 |
|
933 |
lemma to_bl_ucast: |
|
934 |
"to_bl (ucast (w::'b::len0 word) ::'a::len0 word) = |
|
935 |
replicate (len_of TYPE('a) - len_of TYPE('b)) False @ |
|
936 |
drop (len_of TYPE('b) - len_of TYPE('a)) (to_bl w)" |
|
937 |
apply (unfold ucast_bl) |
|
938 |
apply (rule trans) |
|
939 |
apply (rule word_rep_drop) |
|
940 |
apply simp |
|
941 |
done |
|
942 |
||
45811 | 943 |
lemma ucast_up_app [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
944 |
"uc = ucast \<Longrightarrow> source_size uc + n = target_size uc \<Longrightarrow> |
37660 | 945 |
to_bl (uc w) = replicate n False @ (to_bl w)" |
946 |
by (auto simp add : source_size target_size to_bl_ucast) |
|
947 |
||
45811 | 948 |
lemma ucast_down_drop [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
949 |
"uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> |
37660 | 950 |
to_bl (uc w) = drop n (to_bl w)" |
951 |
by (auto simp add : source_size target_size to_bl_ucast) |
|
952 |
||
45811 | 953 |
lemma scast_down_drop [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
954 |
"sc = scast \<Longrightarrow> source_size sc = target_size sc + n \<Longrightarrow> |
37660 | 955 |
to_bl (sc w) = drop n (to_bl w)" |
956 |
apply (subgoal_tac "sc = ucast") |
|
957 |
apply safe |
|
958 |
apply simp |
|
45811 | 959 |
apply (erule ucast_down_drop) |
960 |
apply (rule down_cast_same [symmetric]) |
|
37660 | 961 |
apply (simp add : source_size target_size is_down) |
962 |
done |
|
963 |
||
45811 | 964 |
lemma sint_up_scast [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
965 |
"sc = scast \<Longrightarrow> is_up sc \<Longrightarrow> sint (sc w) = sint w" |
37660 | 966 |
apply (unfold is_up) |
967 |
apply safe |
|
968 |
apply (simp add: scast_def word_sbin.eq_norm) |
|
969 |
apply (rule box_equals) |
|
970 |
prefer 3 |
|
971 |
apply (rule word_sbin.norm_Rep) |
|
972 |
apply (rule sbintrunc_sbintrunc_l) |
|
973 |
defer |
|
974 |
apply (subst word_sbin.norm_Rep) |
|
975 |
apply (rule refl) |
|
976 |
apply simp |
|
977 |
done |
|
978 |
||
45811 | 979 |
lemma uint_up_ucast [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
980 |
"uc = ucast \<Longrightarrow> is_up uc \<Longrightarrow> uint (uc w) = uint w" |
37660 | 981 |
apply (unfold is_up) |
982 |
apply safe |
|
983 |
apply (rule bin_eqI) |
|
984 |
apply (fold word_test_bit_def) |
|
985 |
apply (auto simp add: nth_ucast) |
|
986 |
apply (auto simp add: test_bit_bin) |
|
987 |
done |
|
45811 | 988 |
|
989 |
lemma ucast_up_ucast [OF refl]: |
|
990 |
"uc = ucast \<Longrightarrow> is_up uc \<Longrightarrow> ucast (uc w) = ucast w" |
|
37660 | 991 |
apply (simp (no_asm) add: ucast_def) |
992 |
apply (clarsimp simp add: uint_up_ucast) |
|
993 |
done |
|
994 |
||
45811 | 995 |
lemma scast_up_scast [OF refl]: |
996 |
"sc = scast \<Longrightarrow> is_up sc \<Longrightarrow> scast (sc w) = scast w" |
|
37660 | 997 |
apply (simp (no_asm) add: scast_def) |
998 |
apply (clarsimp simp add: sint_up_scast) |
|
999 |
done |
|
1000 |
||
45811 | 1001 |
lemma ucast_of_bl_up [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1002 |
"w = of_bl bl \<Longrightarrow> size bl <= size w \<Longrightarrow> ucast w = of_bl bl" |
37660 | 1003 |
by (auto simp add : nth_ucast word_size test_bit_of_bl intro!: word_eqI) |
1004 |
||
1005 |
lemmas ucast_up_ucast_id = trans [OF ucast_up_ucast ucast_id] |
|
1006 |
lemmas scast_up_scast_id = trans [OF scast_up_scast scast_id] |
|
1007 |
||
1008 |
lemmas isduu = is_up_down [where c = "ucast", THEN iffD2] |
|
1009 |
lemmas isdus = is_up_down [where c = "scast", THEN iffD2] |
|
1010 |
lemmas ucast_down_ucast_id = isduu [THEN ucast_up_ucast_id] |
|
1011 |
lemmas scast_down_scast_id = isdus [THEN ucast_up_ucast_id] |
|
1012 |
||
1013 |
lemma up_ucast_surj: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1014 |
"is_up (ucast :: 'b::len0 word => 'a::len0 word) \<Longrightarrow> |
37660 | 1015 |
surj (ucast :: 'a word => 'b word)" |
1016 |
by (rule surjI, erule ucast_up_ucast_id) |
|
1017 |
||
1018 |
lemma up_scast_surj: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1019 |
"is_up (scast :: 'b::len word => 'a::len word) \<Longrightarrow> |
37660 | 1020 |
surj (scast :: 'a word => 'b word)" |
1021 |
by (rule surjI, erule scast_up_scast_id) |
|
1022 |
||
1023 |
lemma down_scast_inj: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1024 |
"is_down (scast :: 'b::len word => 'a::len word) \<Longrightarrow> |
37660 | 1025 |
inj_on (ucast :: 'a word => 'b word) A" |
1026 |
by (rule inj_on_inverseI, erule scast_down_scast_id) |
|
1027 |
||
1028 |
lemma down_ucast_inj: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1029 |
"is_down (ucast :: 'b::len0 word => 'a::len0 word) \<Longrightarrow> |
37660 | 1030 |
inj_on (ucast :: 'a word => 'b word) A" |
1031 |
by (rule inj_on_inverseI, erule ucast_down_ucast_id) |
|
1032 |
||
1033 |
lemma of_bl_append_same: "of_bl (X @ to_bl w) = w" |
|
1034 |
by (rule word_bl.Rep_eqD) (simp add: word_rep_drop) |
|
45811 | 1035 |
|
1036 |
lemma ucast_down_no [OF refl]: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1037 |
"uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc (number_of bin) = number_of bin" |
37660 | 1038 |
apply (unfold word_number_of_def is_down) |
1039 |
apply (clarsimp simp add: ucast_def word_ubin.eq_norm) |
|
1040 |
apply (rule word_ubin.norm_eq_iff [THEN iffD1]) |
|
1041 |
apply (erule bintrunc_bintrunc_ge) |
|
1042 |
done |
|
45811 | 1043 |
|
1044 |
lemma ucast_down_bl [OF refl]: |
|
1045 |
"uc = ucast \<Longrightarrow> is_down uc \<Longrightarrow> uc (of_bl bl) = of_bl bl" |
|
37660 | 1046 |
unfolding of_bl_no by clarify (erule ucast_down_no) |
1047 |
||
1048 |
lemmas slice_def' = slice_def [unfolded word_size] |
|
1049 |
lemmas test_bit_def' = word_test_bit_def [THEN fun_cong] |
|
1050 |
||
1051 |
lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def |
|
1052 |
lemmas word_log_bin_defs = word_log_defs |
|
1053 |
||
1054 |
text {* Executable equality *} |
|
1055 |
||
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38527
diff
changeset
|
1056 |
instantiation word :: (len0) equal |
24333 | 1057 |
begin |
1058 |
||
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38527
diff
changeset
|
1059 |
definition equal_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool" where |
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38527
diff
changeset
|
1060 |
"equal_word k l \<longleftrightarrow> HOL.equal (uint k) (uint l)" |
37660 | 1061 |
|
1062 |
instance proof |
|
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38527
diff
changeset
|
1063 |
qed (simp add: equal equal_word_def) |
37660 | 1064 |
|
1065 |
end |
|
1066 |
||
1067 |
||
1068 |
subsection {* Word Arithmetic *} |
|
1069 |
||
1070 |
lemma word_less_alt: "(a < b) = (uint a < uint b)" |
|
1071 |
unfolding word_less_def word_le_def |
|
1072 |
by (auto simp del: word_uint.Rep_inject |
|
1073 |
simp: word_uint.Rep_inject [symmetric]) |
|
1074 |
||
1075 |
lemma signed_linorder: "class.linorder word_sle word_sless" |
|
1076 |
proof |
|
1077 |
qed (unfold word_sle_def word_sless_def, auto) |
|
1078 |
||
1079 |
interpretation signed: linorder "word_sle" "word_sless" |
|
1080 |
by (rule signed_linorder) |
|
1081 |
||
1082 |
lemma udvdI: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1083 |
"0 \<le> n \<Longrightarrow> uint b = n * uint a \<Longrightarrow> a udvd b" |
37660 | 1084 |
by (auto simp: udvd_def) |
1085 |
||
45604 | 1086 |
lemmas word_div_no [simp] = word_div_def [of "number_of a" "number_of b"] for a b |
1087 |
||
1088 |
lemmas word_mod_no [simp] = word_mod_def [of "number_of a" "number_of b"] for a b |
|
1089 |
||
1090 |
lemmas word_less_no [simp] = word_less_def [of "number_of a" "number_of b"] for a b |
|
1091 |
||
1092 |
lemmas word_le_no [simp] = word_le_def [of "number_of a" "number_of b"] for a b |
|
1093 |
||
1094 |
lemmas word_sless_no [simp] = word_sless_def [of "number_of a" "number_of b"] for a b |
|
1095 |
||
1096 |
lemmas word_sle_no [simp] = word_sle_def [of "number_of a" "number_of b"] for a b |
|
37660 | 1097 |
|
1098 |
(* following two are available in class number_ring, |
|
1099 |
but convenient to have them here here; |
|
1100 |
note - the number_ring versions, numeral_0_eq_0 and numeral_1_eq_1 |
|
1101 |
are in the default simpset, so to use the automatic simplifications for |
|
1102 |
(eg) sint (number_of bin) on sint 1, must do |
|
1103 |
(simp add: word_1_no del: numeral_1_eq_1) |
|
1104 |
*) |
|
45958 | 1105 |
lemma word_0_wi_Pls: "0 = word_of_int Int.Pls" |
1106 |
by (simp only: Pls_def word_0_wi) |
|
1107 |
||
1108 |
lemma word_0_no: "(0::'a::len0 word) = Numeral0" |
|
1109 |
by (simp add: word_number_of_alt word_0_wi) |
|
37660 | 1110 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1111 |
lemma int_one_bin: "(1 :: int) = (Int.Pls BIT 1)" |
37660 | 1112 |
unfolding Pls_def Bit_def by auto |
1113 |
||
1114 |
lemma word_1_no: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1115 |
"(1 :: 'a :: len0 word) = number_of (Int.Pls BIT 1)" |
37660 | 1116 |
unfolding word_1_wi word_number_of_def int_one_bin by auto |
1117 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1118 |
lemma word_m1_wi: "-1 = word_of_int -1" |
37660 | 1119 |
by (rule word_number_of_alt) |
1120 |
||
1121 |
lemma word_m1_wi_Min: "-1 = word_of_int Int.Min" |
|
1122 |
by (simp add: word_m1_wi number_of_eq) |
|
1123 |
||
45805 | 1124 |
lemma word_0_bl [simp]: "of_bl [] = 0" |
37660 | 1125 |
unfolding word_0_wi of_bl_def by (simp add : Pls_def) |
1126 |
||
1127 |
lemma word_1_bl: "of_bl [True] = 1" |
|
1128 |
unfolding word_1_wi of_bl_def |
|
1129 |
by (simp add : bl_to_bin_def Bit_def Pls_def) |
|
1130 |
||
1131 |
lemma uint_eq_0 [simp] : "(uint 0 = 0)" |
|
1132 |
unfolding word_0_wi |
|
1133 |
by (simp add: word_ubin.eq_norm Pls_def [symmetric]) |
|
1134 |
||
1135 |
lemma of_bl_0 [simp] : "of_bl (replicate n False) = 0" |
|
1136 |
by (simp add : word_0_wi of_bl_def bl_to_bin_rep_False Pls_def) |
|
1137 |
||
45805 | 1138 |
lemma to_bl_0 [simp]: |
37660 | 1139 |
"to_bl (0::'a::len0 word) = replicate (len_of TYPE('a)) False" |
1140 |
unfolding uint_bl |
|
1141 |
by (simp add : word_size bin_to_bl_Pls Pls_def [symmetric]) |
|
1142 |
||
1143 |
lemma uint_0_iff: "(uint x = 0) = (x = 0)" |
|
1144 |
by (auto intro!: word_uint.Rep_eqD) |
|
1145 |
||
1146 |
lemma unat_0_iff: "(unat x = 0) = (x = 0)" |
|
1147 |
unfolding unat_def by (auto simp add : nat_eq_iff uint_0_iff) |
|
1148 |
||
1149 |
lemma unat_0 [simp]: "unat 0 = 0" |
|
1150 |
unfolding unat_def by auto |
|
1151 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1152 |
lemma size_0_same': "size w = 0 \<Longrightarrow> w = (v :: 'a :: len0 word)" |
37660 | 1153 |
apply (unfold word_size) |
1154 |
apply (rule box_equals) |
|
1155 |
defer |
|
1156 |
apply (rule word_uint.Rep_inverse)+ |
|
1157 |
apply (rule word_ubin.norm_eq_iff [THEN iffD1]) |
|
1158 |
apply simp |
|
1159 |
done |
|
1160 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1161 |
lemmas size_0_same = size_0_same' [unfolded word_size] |
37660 | 1162 |
|
1163 |
lemmas unat_eq_0 = unat_0_iff |
|
1164 |
lemmas unat_eq_zero = unat_0_iff |
|
1165 |
||
1166 |
lemma unat_gt_0: "(0 < unat x) = (x ~= 0)" |
|
1167 |
by (auto simp: unat_0_iff [symmetric]) |
|
1168 |
||
45958 | 1169 |
lemma ucast_0 [simp]: "ucast 0 = 0" |
1170 |
unfolding ucast_def by (simp add: word_of_int_0) |
|
1171 |
||
1172 |
lemma sint_0 [simp]: "sint 0 = 0" |
|
1173 |
unfolding sint_uint by simp |
|
1174 |
||
1175 |
lemma scast_0 [simp]: "scast 0 = 0" |
|
1176 |
unfolding scast_def by (simp add: word_of_int_0) |
|
37660 | 1177 |
|
1178 |
lemma sint_n1 [simp] : "sint -1 = -1" |
|
45958 | 1179 |
unfolding word_m1_wi by (simp add: word_sbin.eq_norm) |
1180 |
||
1181 |
lemma scast_n1 [simp]: "scast -1 = -1" |
|
1182 |
unfolding scast_def by simp |
|
1183 |
||
1184 |
lemma uint_1 [simp]: "uint (1::'a::len word) = 1" |
|
37660 | 1185 |
unfolding word_1_wi |
45958 | 1186 |
by (simp add: word_ubin.eq_norm bintrunc_minus_simps) |
1187 |
||
1188 |
lemma unat_1 [simp]: "unat (1::'a::len word) = 1" |
|
1189 |
unfolding unat_def by simp |
|
1190 |
||
1191 |
lemma ucast_1 [simp]: "ucast (1::'a::len word) = 1" |
|
1192 |
unfolding ucast_def by (simp add: word_of_int_1) |
|
37660 | 1193 |
|
1194 |
(* now, to get the weaker results analogous to word_div/mod_def *) |
|
1195 |
||
1196 |
lemmas word_arith_alts = |
|
45604 | 1197 |
word_sub_wi [unfolded succ_def pred_def] |
1198 |
word_arith_wis [unfolded succ_def pred_def] |
|
37660 | 1199 |
|
1200 |
lemmas word_succ_alt = word_arith_alts (5) |
|
1201 |
lemmas word_pred_alt = word_arith_alts (6) |
|
1202 |
||
1203 |
subsection "Transferring goals from words to ints" |
|
1204 |
||
1205 |
lemma word_ths: |
|
1206 |
shows |
|
1207 |
word_succ_p1: "word_succ a = a + 1" and |
|
1208 |
word_pred_m1: "word_pred a = a - 1" and |
|
1209 |
word_pred_succ: "word_pred (word_succ a) = a" and |
|
1210 |
word_succ_pred: "word_succ (word_pred a) = a" and |
|
1211 |
word_mult_succ: "word_succ a * b = b + a * b" |
|
1212 |
by (rule word_uint.Abs_cases [of b], |
|
1213 |
rule word_uint.Abs_cases [of a], |
|
1214 |
simp add: pred_def succ_def add_commute mult_commute |
|
1215 |
ring_distribs new_word_of_int_homs)+ |
|
1216 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1217 |
lemma uint_cong: "x = y \<Longrightarrow> uint x = uint y" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1218 |
by simp |
37660 | 1219 |
|
1220 |
lemmas uint_word_ariths = |
|
45604 | 1221 |
word_arith_alts [THEN trans [OF uint_cong int_word_uint]] |
37660 | 1222 |
|
1223 |
lemmas uint_word_arith_bintrs = uint_word_ariths [folded bintrunc_mod2p] |
|
1224 |
||
1225 |
(* similar expressions for sint (arith operations) *) |
|
1226 |
lemmas sint_word_ariths = uint_word_arith_bintrs |
|
1227 |
[THEN uint_sint [symmetric, THEN trans], |
|
1228 |
unfolded uint_sint bintr_arith1s bintr_ariths |
|
45604 | 1229 |
len_gt_0 [THEN bin_sbin_eq_iff'] word_sbin.norm_Rep] |
1230 |
||
1231 |
lemmas uint_div_alt = word_div_def [THEN trans [OF uint_cong int_word_uint]] |
|
1232 |
lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]] |
|
37660 | 1233 |
|
1234 |
lemma word_pred_0_n1: "word_pred 0 = word_of_int -1" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
1235 |
unfolding word_pred_def uint_eq_0 pred_def by simp |
37660 | 1236 |
|
1237 |
lemma word_pred_0_Min: "word_pred 0 = word_of_int Int.Min" |
|
1238 |
by (simp add: word_pred_0_n1 number_of_eq) |
|
1239 |
||
1240 |
lemma word_m1_Min: "- 1 = word_of_int Int.Min" |
|
1241 |
unfolding Min_def by (simp only: word_of_int_hom_syms) |
|
1242 |
||
1243 |
lemma succ_pred_no [simp]: |
|
1244 |
"word_succ (number_of bin) = number_of (Int.succ bin) & |
|
1245 |
word_pred (number_of bin) = number_of (Int.pred bin)" |
|
1246 |
unfolding word_number_of_def by (simp add : new_word_of_int_homs) |
|
1247 |
||
1248 |
lemma word_sp_01 [simp] : |
|
1249 |
"word_succ -1 = 0 & word_succ 0 = 1 & word_pred 0 = -1 & word_pred 1 = 0" |
|
45847 | 1250 |
by (unfold word_0_no word_1_no) (auto simp: BIT_simps) |
37660 | 1251 |
|
1252 |
(* alternative approach to lifting arithmetic equalities *) |
|
1253 |
lemma word_of_int_Ex: |
|
1254 |
"\<exists>y. x = word_of_int y" |
|
1255 |
by (rule_tac x="uint x" in exI) simp |
|
1256 |
||
1257 |
||
1258 |
subsection "Order on fixed-length words" |
|
1259 |
||
1260 |
lemma word_zero_le [simp] : |
|
1261 |
"0 <= (y :: 'a :: len0 word)" |
|
1262 |
unfolding word_le_def by auto |
|
1263 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1264 |
lemma word_m1_ge [simp] : "word_pred 0 >= y" (* FIXME: delete *) |
37660 | 1265 |
unfolding word_le_def |
1266 |
by (simp only : word_pred_0_n1 word_uint.eq_norm m1mod2k) auto |
|
1267 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1268 |
lemma word_n1_ge [simp]: "y \<le> (-1::'a::len0 word)" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1269 |
unfolding word_le_def |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1270 |
by (simp only: word_m1_wi word_uint.eq_norm m1mod2k) auto |
37660 | 1271 |
|
1272 |
lemmas word_not_simps [simp] = |
|
1273 |
word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD] |
|
1274 |
||
1275 |
lemma word_gt_0: "0 < y = (0 ~= (y :: 'a :: len0 word))" |
|
1276 |
unfolding word_less_def by auto |
|
1277 |
||
45604 | 1278 |
lemmas word_gt_0_no [simp] = word_gt_0 [of "number_of y"] for y |
37660 | 1279 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1280 |
lemma word_sless_alt: "(a <s b) = (sint a < sint b)" |
37660 | 1281 |
unfolding word_sle_def word_sless_def |
1282 |
by (auto simp add: less_le) |
|
1283 |
||
1284 |
lemma word_le_nat_alt: "(a <= b) = (unat a <= unat b)" |
|
1285 |
unfolding unat_def word_le_def |
|
1286 |
by (rule nat_le_eq_zle [symmetric]) simp |
|
1287 |
||
1288 |
lemma word_less_nat_alt: "(a < b) = (unat a < unat b)" |
|
1289 |
unfolding unat_def word_less_alt |
|
1290 |
by (rule nat_less_eq_zless [symmetric]) simp |
|
1291 |
||
1292 |
lemma wi_less: |
|
1293 |
"(word_of_int n < (word_of_int m :: 'a :: len0 word)) = |
|
1294 |
(n mod 2 ^ len_of TYPE('a) < m mod 2 ^ len_of TYPE('a))" |
|
1295 |
unfolding word_less_alt by (simp add: word_uint.eq_norm) |
|
1296 |
||
1297 |
lemma wi_le: |
|
1298 |
"(word_of_int n <= (word_of_int m :: 'a :: len0 word)) = |
|
1299 |
(n mod 2 ^ len_of TYPE('a) <= m mod 2 ^ len_of TYPE('a))" |
|
1300 |
unfolding word_le_def by (simp add: word_uint.eq_norm) |
|
1301 |
||
1302 |
lemma udvd_nat_alt: "a udvd b = (EX n>=0. unat b = n * unat a)" |
|
1303 |
apply (unfold udvd_def) |
|
1304 |
apply safe |
|
1305 |
apply (simp add: unat_def nat_mult_distrib) |
|
1306 |
apply (simp add: uint_nat int_mult) |
|
1307 |
apply (rule exI) |
|
1308 |
apply safe |
|
1309 |
prefer 2 |
|
1310 |
apply (erule notE) |
|
1311 |
apply (rule refl) |
|
1312 |
apply force |
|
1313 |
done |
|
1314 |
||
1315 |
lemma udvd_iff_dvd: "x udvd y <-> unat x dvd unat y" |
|
1316 |
unfolding dvd_def udvd_nat_alt by force |
|
1317 |
||
45604 | 1318 |
lemmas unat_mono = word_less_nat_alt [THEN iffD1] |
37660 | 1319 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1320 |
lemma unat_minus_one: "x ~= 0 \<Longrightarrow> unat (x - 1) = unat x - 1" |
37660 | 1321 |
apply (unfold unat_def) |
1322 |
apply (simp only: int_word_uint word_arith_alts rdmods) |
|
1323 |
apply (subgoal_tac "uint x >= 1") |
|
1324 |
prefer 2 |
|
1325 |
apply (drule contrapos_nn) |
|
1326 |
apply (erule word_uint.Rep_inverse' [symmetric]) |
|
1327 |
apply (insert uint_ge_0 [of x])[1] |
|
1328 |
apply arith |
|
1329 |
apply (rule box_equals) |
|
1330 |
apply (rule nat_diff_distrib) |
|
1331 |
prefer 2 |
|
1332 |
apply assumption |
|
1333 |
apply simp |
|
1334 |
apply (subst mod_pos_pos_trivial) |
|
1335 |
apply arith |
|
1336 |
apply (insert uint_lt2p [of x])[1] |
|
1337 |
apply arith |
|
1338 |
apply (rule refl) |
|
1339 |
apply simp |
|
1340 |
done |
|
1341 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1342 |
lemma measure_unat: "p ~= 0 \<Longrightarrow> unat (p - 1) < unat p" |
37660 | 1343 |
by (simp add: unat_minus_one) (simp add: unat_0_iff [symmetric]) |
1344 |
||
45604 | 1345 |
lemmas uint_add_ge0 [simp] = add_nonneg_nonneg [OF uint_ge_0 uint_ge_0] |
1346 |
lemmas uint_mult_ge0 [simp] = mult_nonneg_nonneg [OF uint_ge_0 uint_ge_0] |
|
37660 | 1347 |
|
1348 |
lemma uint_sub_lt2p [simp]: |
|
1349 |
"uint (x :: 'a :: len0 word) - uint (y :: 'b :: len0 word) < |
|
1350 |
2 ^ len_of TYPE('a)" |
|
1351 |
using uint_ge_0 [of y] uint_lt2p [of x] by arith |
|
1352 |
||
1353 |
||
1354 |
subsection "Conditions for the addition (etc) of two words to overflow" |
|
1355 |
||
1356 |
lemma uint_add_lem: |
|
1357 |
"(uint x + uint y < 2 ^ len_of TYPE('a)) = |
|
1358 |
(uint (x + y :: 'a :: len0 word) = uint x + uint y)" |
|
1359 |
by (unfold uint_word_ariths) (auto intro!: trans [OF _ int_mod_lem]) |
|
1360 |
||
1361 |
lemma uint_mult_lem: |
|
1362 |
"(uint x * uint y < 2 ^ len_of TYPE('a)) = |
|
1363 |
(uint (x * y :: 'a :: len0 word) = uint x * uint y)" |
|
1364 |
by (unfold uint_word_ariths) (auto intro!: trans [OF _ int_mod_lem]) |
|
1365 |
||
1366 |
lemma uint_sub_lem: |
|
1367 |
"(uint x >= uint y) = (uint (x - y) = uint x - uint y)" |
|
1368 |
by (unfold uint_word_ariths) (auto intro!: trans [OF _ int_mod_lem]) |
|
1369 |
||
1370 |
lemma uint_add_le: "uint (x + y) <= uint x + uint y" |
|
1371 |
unfolding uint_word_ariths by (auto simp: mod_add_if_z) |
|
1372 |
||
1373 |
lemma uint_sub_ge: "uint (x - y) >= uint x - uint y" |
|
1374 |
unfolding uint_word_ariths by (auto simp: mod_sub_if_z) |
|
1375 |
||
45604 | 1376 |
lemmas uint_sub_if' = trans [OF uint_word_ariths(1) mod_sub_if_z, simplified] |
1377 |
lemmas uint_plus_if' = trans [OF uint_word_ariths(2) mod_add_if_z, simplified] |
|
37660 | 1378 |
|
1379 |
||
1380 |
subsection {* Definition of uint\_arith *} |
|
1381 |
||
1382 |
lemma word_of_int_inverse: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1383 |
"word_of_int r = a \<Longrightarrow> 0 <= r \<Longrightarrow> r < 2 ^ len_of TYPE('a) \<Longrightarrow> |
37660 | 1384 |
uint (a::'a::len0 word) = r" |
1385 |
apply (erule word_uint.Abs_inverse' [rotated]) |
|
1386 |
apply (simp add: uints_num) |
|
1387 |
done |
|
1388 |
||
1389 |
lemma uint_split: |
|
1390 |
fixes x::"'a::len0 word" |
|
1391 |
shows "P (uint x) = |
|
1392 |
(ALL i. word_of_int i = x & 0 <= i & i < 2^len_of TYPE('a) --> P i)" |
|
1393 |
apply (fold word_int_case_def) |
|
1394 |
apply (auto dest!: word_of_int_inverse simp: int_word_uint int_mod_eq' |
|
1395 |
split: word_int_split) |
|
1396 |
done |
|
1397 |
||
1398 |
lemma uint_split_asm: |
|
1399 |
fixes x::"'a::len0 word" |
|
1400 |
shows "P (uint x) = |
|
1401 |
(~(EX i. word_of_int i = x & 0 <= i & i < 2^len_of TYPE('a) & ~ P i))" |
|
1402 |
by (auto dest!: word_of_int_inverse |
|
1403 |
simp: int_word_uint int_mod_eq' |
|
1404 |
split: uint_split) |
|
1405 |
||
1406 |
lemmas uint_splits = uint_split uint_split_asm |
|
1407 |
||
1408 |
lemmas uint_arith_simps = |
|
1409 |
word_le_def word_less_alt |
|
1410 |
word_uint.Rep_inject [symmetric] |
|
1411 |
uint_sub_if' uint_plus_if' |
|
1412 |
||
1413 |
(* use this to stop, eg, 2 ^ len_of TYPE (32) being simplified *) |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1414 |
lemma power_False_cong: "False \<Longrightarrow> a ^ b = c ^ d" |
37660 | 1415 |
by auto |
1416 |
||
1417 |
(* uint_arith_tac: reduce to arithmetic on int, try to solve by arith *) |
|
1418 |
ML {* |
|
1419 |
fun uint_arith_ss_of ss = |
|
1420 |
ss addsimps @{thms uint_arith_simps} |
|
1421 |
delsimps @{thms word_uint.Rep_inject} |
|
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1422 |
|> fold Splitter.add_split @{thms split_if_asm} |
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1423 |
|> fold Simplifier.add_cong @{thms power_False_cong} |
37660 | 1424 |
|
1425 |
fun uint_arith_tacs ctxt = |
|
1426 |
let |
|
1427 |
fun arith_tac' n t = |
|
1428 |
Arith_Data.verbose_arith_tac ctxt n t |
|
1429 |
handle Cooper.COOPER _ => Seq.empty; |
|
1430 |
in |
|
42793 | 1431 |
[ clarify_tac ctxt 1, |
1432 |
full_simp_tac (uint_arith_ss_of (simpset_of ctxt)) 1, |
|
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1433 |
ALLGOALS (full_simp_tac (HOL_ss |> fold Splitter.add_split @{thms uint_splits} |
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1434 |
|> fold Simplifier.add_cong @{thms power_False_cong})), |
37660 | 1435 |
rewrite_goals_tac @{thms word_size}, |
1436 |
ALLGOALS (fn n => REPEAT (resolve_tac [allI, impI] n) THEN |
|
1437 |
REPEAT (etac conjE n) THEN |
|
1438 |
REPEAT (dtac @{thm word_of_int_inverse} n |
|
1439 |
THEN atac n |
|
1440 |
THEN atac n)), |
|
1441 |
TRYALL arith_tac' ] |
|
1442 |
end |
|
1443 |
||
1444 |
fun uint_arith_tac ctxt = SELECT_GOAL (EVERY (uint_arith_tacs ctxt)) |
|
1445 |
*} |
|
1446 |
||
1447 |
method_setup uint_arith = |
|
1448 |
{* Scan.succeed (SIMPLE_METHOD' o uint_arith_tac) *} |
|
1449 |
"solving word arithmetic via integers and arith" |
|
1450 |
||
1451 |
||
1452 |
subsection "More on overflows and monotonicity" |
|
1453 |
||
1454 |
lemma no_plus_overflow_uint_size: |
|
1455 |
"((x :: 'a :: len0 word) <= x + y) = (uint x + uint y < 2 ^ size x)" |
|
1456 |
unfolding word_size by uint_arith |
|
1457 |
||
1458 |
lemmas no_olen_add = no_plus_overflow_uint_size [unfolded word_size] |
|
1459 |
||
1460 |
lemma no_ulen_sub: "((x :: 'a :: len0 word) >= x - y) = (uint y <= uint x)" |
|
1461 |
by uint_arith |
|
1462 |
||
1463 |
lemma no_olen_add': |
|
1464 |
fixes x :: "'a::len0 word" |
|
1465 |
shows "(x \<le> y + x) = (uint y + uint x < 2 ^ len_of TYPE('a))" |
|
45546
6dd3e88de4c2
HOL-Word: removed many duplicate theorems (see NEWS)
huffman
parents:
45545
diff
changeset
|
1466 |
by (simp add: add_ac no_olen_add) |
37660 | 1467 |
|
45604 | 1468 |
lemmas olen_add_eqv = trans [OF no_olen_add no_olen_add' [symmetric]] |
1469 |
||
1470 |
lemmas uint_plus_simple_iff = trans [OF no_olen_add uint_add_lem] |
|
1471 |
lemmas uint_plus_simple = uint_plus_simple_iff [THEN iffD1] |
|
1472 |
lemmas uint_minus_simple_iff = trans [OF no_ulen_sub uint_sub_lem] |
|
37660 | 1473 |
lemmas uint_minus_simple_alt = uint_sub_lem [folded word_le_def] |
1474 |
lemmas word_sub_le_iff = no_ulen_sub [folded word_le_def] |
|
45604 | 1475 |
lemmas word_sub_le = word_sub_le_iff [THEN iffD2] |
37660 | 1476 |
|
1477 |
lemma word_less_sub1: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1478 |
"(x :: 'a :: len word) ~= 0 \<Longrightarrow> (1 < x) = (0 < x - 1)" |
37660 | 1479 |
by uint_arith |
1480 |
||
1481 |
lemma word_le_sub1: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1482 |
"(x :: 'a :: len word) ~= 0 \<Longrightarrow> (1 <= x) = (0 <= x - 1)" |
37660 | 1483 |
by uint_arith |
1484 |
||
1485 |
lemma sub_wrap_lt: |
|
1486 |
"((x :: 'a :: len0 word) < x - z) = (x < z)" |
|
1487 |
by uint_arith |
|
1488 |
||
1489 |
lemma sub_wrap: |
|
1490 |
"((x :: 'a :: len0 word) <= x - z) = (z = 0 | x < z)" |
|
1491 |
by uint_arith |
|
1492 |
||
1493 |
lemma plus_minus_not_NULL_ab: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1494 |
"(x :: 'a :: len0 word) <= ab - c \<Longrightarrow> c <= ab \<Longrightarrow> c ~= 0 \<Longrightarrow> x + c ~= 0" |
37660 | 1495 |
by uint_arith |
1496 |
||
1497 |
lemma plus_minus_no_overflow_ab: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1498 |
"(x :: 'a :: len0 word) <= ab - c \<Longrightarrow> c <= ab \<Longrightarrow> x <= x + c" |
37660 | 1499 |
by uint_arith |
1500 |
||
1501 |
lemma le_minus': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1502 |
"(a :: 'a :: len0 word) + c <= b \<Longrightarrow> a <= a + c \<Longrightarrow> c <= b - a" |
37660 | 1503 |
by uint_arith |
1504 |
||
1505 |
lemma le_plus': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1506 |
"(a :: 'a :: len0 word) <= b \<Longrightarrow> c <= b - a \<Longrightarrow> a + c <= b" |
37660 | 1507 |
by uint_arith |
1508 |
||
1509 |
lemmas le_plus = le_plus' [rotated] |
|
1510 |
||
45604 | 1511 |
lemmas le_minus = leD [THEN thin_rl, THEN le_minus'] |
37660 | 1512 |
|
1513 |
lemma word_plus_mono_right: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1514 |
"(y :: 'a :: len0 word) <= z \<Longrightarrow> x <= x + z \<Longrightarrow> x + y <= x + z" |
37660 | 1515 |
by uint_arith |
1516 |
||
1517 |
lemma word_less_minus_cancel: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1518 |
"y - x < z - x \<Longrightarrow> x <= z \<Longrightarrow> (y :: 'a :: len0 word) < z" |
37660 | 1519 |
by uint_arith |
1520 |
||
1521 |
lemma word_less_minus_mono_left: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1522 |
"(y :: 'a :: len0 word) < z \<Longrightarrow> x <= y \<Longrightarrow> y - x < z - x" |
37660 | 1523 |
by uint_arith |
1524 |
||
1525 |
lemma word_less_minus_mono: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1526 |
"a < c \<Longrightarrow> d < b \<Longrightarrow> a - b < a \<Longrightarrow> c - d < c |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1527 |
\<Longrightarrow> a - b < c - (d::'a::len word)" |
37660 | 1528 |
by uint_arith |
1529 |
||
1530 |
lemma word_le_minus_cancel: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1531 |
"y - x <= z - x \<Longrightarrow> x <= z \<Longrightarrow> (y :: 'a :: len0 word) <= z" |
37660 | 1532 |
by uint_arith |
1533 |
||
1534 |
lemma word_le_minus_mono_left: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1535 |
"(y :: 'a :: len0 word) <= z \<Longrightarrow> x <= y \<Longrightarrow> y - x <= z - x" |
37660 | 1536 |
by uint_arith |
1537 |
||
1538 |
lemma word_le_minus_mono: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1539 |
"a <= c \<Longrightarrow> d <= b \<Longrightarrow> a - b <= a \<Longrightarrow> c - d <= c |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1540 |
\<Longrightarrow> a - b <= c - (d::'a::len word)" |
37660 | 1541 |
by uint_arith |
1542 |
||
1543 |
lemma plus_le_left_cancel_wrap: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1544 |
"(x :: 'a :: len0 word) + y' < x \<Longrightarrow> x + y < x \<Longrightarrow> (x + y' < x + y) = (y' < y)" |
37660 | 1545 |
by uint_arith |
1546 |
||
1547 |
lemma plus_le_left_cancel_nowrap: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1548 |
"(x :: 'a :: len0 word) <= x + y' \<Longrightarrow> x <= x + y \<Longrightarrow> |
37660 | 1549 |
(x + y' < x + y) = (y' < y)" |
1550 |
by uint_arith |
|
1551 |
||
1552 |
lemma word_plus_mono_right2: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1553 |
"(a :: 'a :: len0 word) <= a + b \<Longrightarrow> c <= b \<Longrightarrow> a <= a + c" |
37660 | 1554 |
by uint_arith |
1555 |
||
1556 |
lemma word_less_add_right: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1557 |
"(x :: 'a :: len0 word) < y - z \<Longrightarrow> z <= y \<Longrightarrow> x + z < y" |
37660 | 1558 |
by uint_arith |
1559 |
||
1560 |
lemma word_less_sub_right: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1561 |
"(x :: 'a :: len0 word) < y + z \<Longrightarrow> y <= x \<Longrightarrow> x - y < z" |
37660 | 1562 |
by uint_arith |
1563 |
||
1564 |
lemma word_le_plus_either: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1565 |
"(x :: 'a :: len0 word) <= y | x <= z \<Longrightarrow> y <= y + z \<Longrightarrow> x <= y + z" |
37660 | 1566 |
by uint_arith |
1567 |
||
1568 |
lemma word_less_nowrapI: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1569 |
"(x :: 'a :: len0 word) < z - k \<Longrightarrow> k <= z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k" |
37660 | 1570 |
by uint_arith |
1571 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1572 |
lemma inc_le: "(i :: 'a :: len word) < m \<Longrightarrow> i + 1 <= m" |
37660 | 1573 |
by uint_arith |
1574 |
||
1575 |
lemma inc_i: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1576 |
"(1 :: 'a :: len word) <= i \<Longrightarrow> i < m \<Longrightarrow> 1 <= (i + 1) & i + 1 <= m" |
37660 | 1577 |
by uint_arith |
1578 |
||
1579 |
lemma udvd_incr_lem: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1580 |
"up < uq \<Longrightarrow> up = ua + n * uint K \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1581 |
uq = ua + n' * uint K \<Longrightarrow> up + uint K <= uq" |
37660 | 1582 |
apply clarsimp |
1583 |
apply (drule less_le_mult) |
|
1584 |
apply safe |
|
1585 |
done |
|
1586 |
||
1587 |
lemma udvd_incr': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1588 |
"p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1589 |
uint q = ua + n' * uint K \<Longrightarrow> p + K <= q" |
37660 | 1590 |
apply (unfold word_less_alt word_le_def) |
1591 |
apply (drule (2) udvd_incr_lem) |
|
1592 |
apply (erule uint_add_le [THEN order_trans]) |
|
1593 |
done |
|
1594 |
||
1595 |
lemma udvd_decr': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1596 |
"p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1597 |
uint q = ua + n' * uint K \<Longrightarrow> p <= q - K" |
37660 | 1598 |
apply (unfold word_less_alt word_le_def) |
1599 |
apply (drule (2) udvd_incr_lem) |
|
1600 |
apply (drule le_diff_eq [THEN iffD2]) |
|
1601 |
apply (erule order_trans) |
|
1602 |
apply (rule uint_sub_ge) |
|
1603 |
done |
|
1604 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1605 |
lemmas udvd_incr_lem0 = udvd_incr_lem [where ua=0, unfolded add_0_left] |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1606 |
lemmas udvd_incr0 = udvd_incr' [where ua=0, unfolded add_0_left] |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1607 |
lemmas udvd_decr0 = udvd_decr' [where ua=0, unfolded add_0_left] |
37660 | 1608 |
|
1609 |
lemma udvd_minus_le': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1610 |
"xy < k \<Longrightarrow> z udvd xy \<Longrightarrow> z udvd k \<Longrightarrow> xy <= k - z" |
37660 | 1611 |
apply (unfold udvd_def) |
1612 |
apply clarify |
|
1613 |
apply (erule (2) udvd_decr0) |
|
1614 |
done |
|
1615 |
||
45284
ae78a4ffa81d
use simproc_setup for cancellation simprocs, to get proper name bindings
huffman
parents:
44938
diff
changeset
|
1616 |
ML {* Delsimprocs [@{simproc linordered_ring_less_cancel_factor}] *} |
37660 | 1617 |
|
1618 |
lemma udvd_incr2_K: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1619 |
"p < a + s \<Longrightarrow> a <= a + s \<Longrightarrow> K udvd s \<Longrightarrow> K udvd p - a \<Longrightarrow> a <= p \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1620 |
0 < K \<Longrightarrow> p <= p + K & p + K <= a + s" |
37660 | 1621 |
apply (unfold udvd_def) |
1622 |
apply clarify |
|
1623 |
apply (simp add: uint_arith_simps split: split_if_asm) |
|
1624 |
prefer 2 |
|
1625 |
apply (insert uint_range' [of s])[1] |
|
1626 |
apply arith |
|
1627 |
apply (drule add_commute [THEN xtr1]) |
|
1628 |
apply (simp add: diff_less_eq [symmetric]) |
|
1629 |
apply (drule less_le_mult) |
|
1630 |
apply arith |
|
1631 |
apply simp |
|
1632 |
done |
|
1633 |
||
45284
ae78a4ffa81d
use simproc_setup for cancellation simprocs, to get proper name bindings
huffman
parents:
44938
diff
changeset
|
1634 |
ML {* Addsimprocs [@{simproc linordered_ring_less_cancel_factor}] *} |
37660 | 1635 |
|
1636 |
(* links with rbl operations *) |
|
1637 |
lemma word_succ_rbl: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1638 |
"to_bl w = bl \<Longrightarrow> to_bl (word_succ w) = (rev (rbl_succ (rev bl)))" |
37660 | 1639 |
apply (unfold word_succ_def) |
1640 |
apply clarify |
|
1641 |
apply (simp add: to_bl_of_bin) |
|
1642 |
apply (simp add: to_bl_def rbl_succ) |
|
1643 |
done |
|
1644 |
||
1645 |
lemma word_pred_rbl: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1646 |
"to_bl w = bl \<Longrightarrow> to_bl (word_pred w) = (rev (rbl_pred (rev bl)))" |
37660 | 1647 |
apply (unfold word_pred_def) |
1648 |
apply clarify |
|
1649 |
apply (simp add: to_bl_of_bin) |
|
1650 |
apply (simp add: to_bl_def rbl_pred) |
|
1651 |
done |
|
1652 |
||
1653 |
lemma word_add_rbl: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1654 |
"to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow> |
37660 | 1655 |
to_bl (v + w) = (rev (rbl_add (rev vbl) (rev wbl)))" |
1656 |
apply (unfold word_add_def) |
|
1657 |
apply clarify |
|
1658 |
apply (simp add: to_bl_of_bin) |
|
1659 |
apply (simp add: to_bl_def rbl_add) |
|
1660 |
done |
|
1661 |
||
1662 |
lemma word_mult_rbl: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1663 |
"to_bl v = vbl \<Longrightarrow> to_bl w = wbl \<Longrightarrow> |
37660 | 1664 |
to_bl (v * w) = (rev (rbl_mult (rev vbl) (rev wbl)))" |
1665 |
apply (unfold word_mult_def) |
|
1666 |
apply clarify |
|
1667 |
apply (simp add: to_bl_of_bin) |
|
1668 |
apply (simp add: to_bl_def rbl_mult) |
|
1669 |
done |
|
1670 |
||
1671 |
lemma rtb_rbl_ariths: |
|
1672 |
"rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_succ w)) = rbl_succ ys" |
|
1673 |
"rev (to_bl w) = ys \<Longrightarrow> rev (to_bl (word_pred w)) = rbl_pred ys" |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1674 |
"rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v * w)) = rbl_mult ys xs" |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1675 |
"rev (to_bl v) = ys \<Longrightarrow> rev (to_bl w) = xs \<Longrightarrow> rev (to_bl (v + w)) = rbl_add ys xs" |
37660 | 1676 |
by (auto simp: rev_swap [symmetric] word_succ_rbl |
1677 |
word_pred_rbl word_mult_rbl word_add_rbl) |
|
1678 |
||
1679 |
||
1680 |
subsection "Arithmetic type class instantiations" |
|
1681 |
||
1682 |
(* note that iszero_def is only for class comm_semiring_1_cancel, |
|
1683 |
which requires word length >= 1, ie 'a :: len word *) |
|
1684 |
lemma zero_bintrunc: |
|
1685 |
"iszero (number_of x :: 'a :: len word) = |
|
1686 |
(bintrunc (len_of TYPE('a)) x = Int.Pls)" |
|
1687 |
apply (unfold iszero_def word_0_wi word_no_wi) |
|
1688 |
apply (rule word_ubin.norm_eq_iff [symmetric, THEN trans]) |
|
1689 |
apply (simp add : Pls_def [symmetric]) |
|
1690 |
done |
|
1691 |
||
1692 |
lemmas word_le_0_iff [simp] = |
|
1693 |
word_zero_le [THEN leD, THEN linorder_antisym_conv1] |
|
1694 |
||
1695 |
lemma word_of_int_nat: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1696 |
"0 <= x \<Longrightarrow> word_of_int x = of_nat (nat x)" |
37660 | 1697 |
by (simp add: of_nat_nat word_of_int) |
1698 |
||
1699 |
lemma iszero_word_no [simp] : |
|
1700 |
"iszero (number_of bin :: 'a :: len word) = |
|
1701 |
iszero (number_of (bintrunc (len_of TYPE('a)) bin) :: int)" |
|
1702 |
apply (simp add: zero_bintrunc number_of_is_id) |
|
1703 |
apply (unfold iszero_def Pls_def) |
|
1704 |
apply (rule refl) |
|
1705 |
done |
|
1706 |
||
1707 |
||
1708 |
subsection "Word and nat" |
|
1709 |
||
45811 | 1710 |
lemma td_ext_unat [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1711 |
"n = len_of TYPE ('a :: len) \<Longrightarrow> |
37660 | 1712 |
td_ext (unat :: 'a word => nat) of_nat |
1713 |
(unats n) (%i. i mod 2 ^ n)" |
|
1714 |
apply (unfold td_ext_def' unat_def word_of_nat unats_uints) |
|
1715 |
apply (auto intro!: imageI simp add : word_of_int_hom_syms) |
|
1716 |
apply (erule word_uint.Abs_inverse [THEN arg_cong]) |
|
1717 |
apply (simp add: int_word_uint nat_mod_distrib nat_power_eq) |
|
1718 |
done |
|
1719 |
||
45604 | 1720 |
lemmas unat_of_nat = td_ext_unat [THEN td_ext.eq_norm] |
37660 | 1721 |
|
1722 |
interpretation word_unat: |
|
1723 |
td_ext "unat::'a::len word => nat" |
|
1724 |
of_nat |
|
1725 |
"unats (len_of TYPE('a::len))" |
|
1726 |
"%i. i mod 2 ^ len_of TYPE('a::len)" |
|
1727 |
by (rule td_ext_unat) |
|
1728 |
||
1729 |
lemmas td_unat = word_unat.td_thm |
|
1730 |
||
1731 |
lemmas unat_lt2p [iff] = word_unat.Rep [unfolded unats_def mem_Collect_eq] |
|
1732 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1733 |
lemma unat_le: "y <= unat (z :: 'a :: len word) \<Longrightarrow> y : unats (len_of TYPE ('a))" |
37660 | 1734 |
apply (unfold unats_def) |
1735 |
apply clarsimp |
|
1736 |
apply (rule xtrans, rule unat_lt2p, assumption) |
|
1737 |
done |
|
1738 |
||
1739 |
lemma word_nchotomy: |
|
1740 |
"ALL w. EX n. (w :: 'a :: len word) = of_nat n & n < 2 ^ len_of TYPE ('a)" |
|
1741 |
apply (rule allI) |
|
1742 |
apply (rule word_unat.Abs_cases) |
|
1743 |
apply (unfold unats_def) |
|
1744 |
apply auto |
|
1745 |
done |
|
1746 |
||
1747 |
lemma of_nat_eq: |
|
1748 |
fixes w :: "'a::len word" |
|
1749 |
shows "(of_nat n = w) = (\<exists>q. n = unat w + q * 2 ^ len_of TYPE('a))" |
|
1750 |
apply (rule trans) |
|
1751 |
apply (rule word_unat.inverse_norm) |
|
1752 |
apply (rule iffI) |
|
1753 |
apply (rule mod_eqD) |
|
1754 |
apply simp |
|
1755 |
apply clarsimp |
|
1756 |
done |
|
1757 |
||
1758 |
lemma of_nat_eq_size: |
|
1759 |
"(of_nat n = w) = (EX q. n = unat w + q * 2 ^ size w)" |
|
1760 |
unfolding word_size by (rule of_nat_eq) |
|
1761 |
||
1762 |
lemma of_nat_0: |
|
1763 |
"(of_nat m = (0::'a::len word)) = (\<exists>q. m = q * 2 ^ len_of TYPE('a))" |
|
1764 |
by (simp add: of_nat_eq) |
|
1765 |
||
45805 | 1766 |
lemma of_nat_2p [simp]: |
1767 |
"of_nat (2 ^ len_of TYPE('a)) = (0::'a::len word)" |
|
1768 |
by (fact mult_1 [symmetric, THEN iffD2 [OF of_nat_0 exI]]) |
|
37660 | 1769 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1770 |
lemma of_nat_gt_0: "of_nat k ~= 0 \<Longrightarrow> 0 < k" |
37660 | 1771 |
by (cases k) auto |
1772 |
||
1773 |
lemma of_nat_neq_0: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1774 |
"0 < k \<Longrightarrow> k < 2 ^ len_of TYPE ('a :: len) \<Longrightarrow> of_nat k ~= (0 :: 'a word)" |
37660 | 1775 |
by (clarsimp simp add : of_nat_0) |
1776 |
||
1777 |
lemma Abs_fnat_hom_add: |
|
1778 |
"of_nat a + of_nat b = of_nat (a + b)" |
|
1779 |
by simp |
|
1780 |
||
1781 |
lemma Abs_fnat_hom_mult: |
|
1782 |
"of_nat a * of_nat b = (of_nat (a * b) :: 'a :: len word)" |
|
1783 |
by (simp add: word_of_nat word_of_int_mult_hom zmult_int) |
|
1784 |
||
1785 |
lemma Abs_fnat_hom_Suc: |
|
1786 |
"word_succ (of_nat a) = of_nat (Suc a)" |
|
1787 |
by (simp add: word_of_nat word_of_int_succ_hom add_ac) |
|
1788 |
||
1789 |
lemma Abs_fnat_hom_0: "(0::'a::len word) = of_nat 0" |
|
1790 |
by (simp add: word_of_nat word_0_wi) |
|
1791 |
||
1792 |
lemma Abs_fnat_hom_1: "(1::'a::len word) = of_nat (Suc 0)" |
|
1793 |
by (simp add: word_of_nat word_1_wi) |
|
1794 |
||
1795 |
lemmas Abs_fnat_homs = |
|
1796 |
Abs_fnat_hom_add Abs_fnat_hom_mult Abs_fnat_hom_Suc |
|
1797 |
Abs_fnat_hom_0 Abs_fnat_hom_1 |
|
1798 |
||
1799 |
lemma word_arith_nat_add: |
|
1800 |
"a + b = of_nat (unat a + unat b)" |
|
1801 |
by simp |
|
1802 |
||
1803 |
lemma word_arith_nat_mult: |
|
1804 |
"a * b = of_nat (unat a * unat b)" |
|
1805 |
by (simp add: Abs_fnat_hom_mult [symmetric]) |
|
1806 |
||
1807 |
lemma word_arith_nat_Suc: |
|
1808 |
"word_succ a = of_nat (Suc (unat a))" |
|
1809 |
by (subst Abs_fnat_hom_Suc [symmetric]) simp |
|
1810 |
||
1811 |
lemma word_arith_nat_div: |
|
1812 |
"a div b = of_nat (unat a div unat b)" |
|
1813 |
by (simp add: word_div_def word_of_nat zdiv_int uint_nat) |
|
1814 |
||
1815 |
lemma word_arith_nat_mod: |
|
1816 |
"a mod b = of_nat (unat a mod unat b)" |
|
1817 |
by (simp add: word_mod_def word_of_nat zmod_int uint_nat) |
|
1818 |
||
1819 |
lemmas word_arith_nat_defs = |
|
1820 |
word_arith_nat_add word_arith_nat_mult |
|
1821 |
word_arith_nat_Suc Abs_fnat_hom_0 |
|
1822 |
Abs_fnat_hom_1 word_arith_nat_div |
|
1823 |
word_arith_nat_mod |
|
1824 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1825 |
lemma unat_cong: "x = y \<Longrightarrow> unat x = unat y" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1826 |
by simp |
37660 | 1827 |
|
1828 |
lemmas unat_word_ariths = word_arith_nat_defs |
|
45604 | 1829 |
[THEN trans [OF unat_cong unat_of_nat]] |
37660 | 1830 |
|
1831 |
lemmas word_sub_less_iff = word_sub_le_iff |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1832 |
[unfolded linorder_not_less [symmetric] Not_eq_iff] |
37660 | 1833 |
|
1834 |
lemma unat_add_lem: |
|
1835 |
"(unat x + unat y < 2 ^ len_of TYPE('a)) = |
|
1836 |
(unat (x + y :: 'a :: len word) = unat x + unat y)" |
|
1837 |
unfolding unat_word_ariths |
|
1838 |
by (auto intro!: trans [OF _ nat_mod_lem]) |
|
1839 |
||
1840 |
lemma unat_mult_lem: |
|
1841 |
"(unat x * unat y < 2 ^ len_of TYPE('a)) = |
|
1842 |
(unat (x * y :: 'a :: len word) = unat x * unat y)" |
|
1843 |
unfolding unat_word_ariths |
|
1844 |
by (auto intro!: trans [OF _ nat_mod_lem]) |
|
1845 |
||
45604 | 1846 |
lemmas unat_plus_if' = trans [OF unat_word_ariths(1) mod_nat_add, simplified] |
37660 | 1847 |
|
1848 |
lemma le_no_overflow: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1849 |
"x <= b \<Longrightarrow> a <= a + b \<Longrightarrow> x <= a + (b :: 'a :: len0 word)" |
37660 | 1850 |
apply (erule order_trans) |
1851 |
apply (erule olen_add_eqv [THEN iffD1]) |
|
1852 |
done |
|
1853 |
||
45604 | 1854 |
lemmas un_ui_le = trans [OF word_le_nat_alt [symmetric] word_le_def] |
37660 | 1855 |
|
1856 |
lemma unat_sub_if_size: |
|
1857 |
"unat (x - y) = (if unat y <= unat x |
|
1858 |
then unat x - unat y |
|
1859 |
else unat x + 2 ^ size x - unat y)" |
|
1860 |
apply (unfold word_size) |
|
1861 |
apply (simp add: un_ui_le) |
|
1862 |
apply (auto simp add: unat_def uint_sub_if') |
|
1863 |
apply (rule nat_diff_distrib) |
|
1864 |
prefer 3 |
|
1865 |
apply (simp add: algebra_simps) |
|
1866 |
apply (rule nat_diff_distrib [THEN trans]) |
|
1867 |
prefer 3 |
|
1868 |
apply (subst nat_add_distrib) |
|
1869 |
prefer 3 |
|
1870 |
apply (simp add: nat_power_eq) |
|
1871 |
apply auto |
|
1872 |
apply uint_arith |
|
1873 |
done |
|
1874 |
||
1875 |
lemmas unat_sub_if' = unat_sub_if_size [unfolded word_size] |
|
1876 |
||
1877 |
lemma unat_div: "unat ((x :: 'a :: len word) div y) = unat x div unat y" |
|
1878 |
apply (simp add : unat_word_ariths) |
|
1879 |
apply (rule unat_lt2p [THEN xtr7, THEN nat_mod_eq']) |
|
1880 |
apply (rule div_le_dividend) |
|
1881 |
done |
|
1882 |
||
1883 |
lemma unat_mod: "unat ((x :: 'a :: len word) mod y) = unat x mod unat y" |
|
1884 |
apply (clarsimp simp add : unat_word_ariths) |
|
1885 |
apply (cases "unat y") |
|
1886 |
prefer 2 |
|
1887 |
apply (rule unat_lt2p [THEN xtr7, THEN nat_mod_eq']) |
|
1888 |
apply (rule mod_le_divisor) |
|
1889 |
apply auto |
|
1890 |
done |
|
1891 |
||
1892 |
lemma uint_div: "uint ((x :: 'a :: len word) div y) = uint x div uint y" |
|
1893 |
unfolding uint_nat by (simp add : unat_div zdiv_int) |
|
1894 |
||
1895 |
lemma uint_mod: "uint ((x :: 'a :: len word) mod y) = uint x mod uint y" |
|
1896 |
unfolding uint_nat by (simp add : unat_mod zmod_int) |
|
1897 |
||
1898 |
||
1899 |
subsection {* Definition of unat\_arith tactic *} |
|
1900 |
||
1901 |
lemma unat_split: |
|
1902 |
fixes x::"'a::len word" |
|
1903 |
shows "P (unat x) = |
|
1904 |
(ALL n. of_nat n = x & n < 2^len_of TYPE('a) --> P n)" |
|
1905 |
by (auto simp: unat_of_nat) |
|
1906 |
||
1907 |
lemma unat_split_asm: |
|
1908 |
fixes x::"'a::len word" |
|
1909 |
shows "P (unat x) = |
|
1910 |
(~(EX n. of_nat n = x & n < 2^len_of TYPE('a) & ~ P n))" |
|
1911 |
by (auto simp: unat_of_nat) |
|
1912 |
||
1913 |
lemmas of_nat_inverse = |
|
1914 |
word_unat.Abs_inverse' [rotated, unfolded unats_def, simplified] |
|
1915 |
||
1916 |
lemmas unat_splits = unat_split unat_split_asm |
|
1917 |
||
1918 |
lemmas unat_arith_simps = |
|
1919 |
word_le_nat_alt word_less_nat_alt |
|
1920 |
word_unat.Rep_inject [symmetric] |
|
1921 |
unat_sub_if' unat_plus_if' unat_div unat_mod |
|
1922 |
||
1923 |
(* unat_arith_tac: tactic to reduce word arithmetic to nat, |
|
1924 |
try to solve via arith *) |
|
1925 |
ML {* |
|
1926 |
fun unat_arith_ss_of ss = |
|
1927 |
ss addsimps @{thms unat_arith_simps} |
|
1928 |
delsimps @{thms word_unat.Rep_inject} |
|
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1929 |
|> fold Splitter.add_split @{thms split_if_asm} |
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1930 |
|> fold Simplifier.add_cong @{thms power_False_cong} |
37660 | 1931 |
|
1932 |
fun unat_arith_tacs ctxt = |
|
1933 |
let |
|
1934 |
fun arith_tac' n t = |
|
1935 |
Arith_Data.verbose_arith_tac ctxt n t |
|
1936 |
handle Cooper.COOPER _ => Seq.empty; |
|
1937 |
in |
|
42793 | 1938 |
[ clarify_tac ctxt 1, |
1939 |
full_simp_tac (unat_arith_ss_of (simpset_of ctxt)) 1, |
|
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1940 |
ALLGOALS (full_simp_tac (HOL_ss |> fold Splitter.add_split @{thms unat_splits} |
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
1941 |
|> fold Simplifier.add_cong @{thms power_False_cong})), |
37660 | 1942 |
rewrite_goals_tac @{thms word_size}, |
1943 |
ALLGOALS (fn n => REPEAT (resolve_tac [allI, impI] n) THEN |
|
1944 |
REPEAT (etac conjE n) THEN |
|
1945 |
REPEAT (dtac @{thm of_nat_inverse} n THEN atac n)), |
|
1946 |
TRYALL arith_tac' ] |
|
1947 |
end |
|
1948 |
||
1949 |
fun unat_arith_tac ctxt = SELECT_GOAL (EVERY (unat_arith_tacs ctxt)) |
|
1950 |
*} |
|
1951 |
||
1952 |
method_setup unat_arith = |
|
1953 |
{* Scan.succeed (SIMPLE_METHOD' o unat_arith_tac) *} |
|
1954 |
"solving word arithmetic via natural numbers and arith" |
|
1955 |
||
1956 |
lemma no_plus_overflow_unat_size: |
|
1957 |
"((x :: 'a :: len word) <= x + y) = (unat x + unat y < 2 ^ size x)" |
|
1958 |
unfolding word_size by unat_arith |
|
1959 |
||
1960 |
lemmas no_olen_add_nat = no_plus_overflow_unat_size [unfolded word_size] |
|
1961 |
||
45604 | 1962 |
lemmas unat_plus_simple = trans [OF no_olen_add_nat unat_add_lem] |
37660 | 1963 |
|
1964 |
lemma word_div_mult: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1965 |
"(0 :: 'a :: len word) < y \<Longrightarrow> unat x * unat y < 2 ^ len_of TYPE('a) \<Longrightarrow> |
37660 | 1966 |
x * y div y = x" |
1967 |
apply unat_arith |
|
1968 |
apply clarsimp |
|
1969 |
apply (subst unat_mult_lem [THEN iffD1]) |
|
1970 |
apply auto |
|
1971 |
done |
|
1972 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1973 |
lemma div_lt': "(i :: 'a :: len word) <= k div x \<Longrightarrow> |
37660 | 1974 |
unat i * unat x < 2 ^ len_of TYPE('a)" |
1975 |
apply unat_arith |
|
1976 |
apply clarsimp |
|
1977 |
apply (drule mult_le_mono1) |
|
1978 |
apply (erule order_le_less_trans) |
|
1979 |
apply (rule xtr7 [OF unat_lt2p div_mult_le]) |
|
1980 |
done |
|
1981 |
||
1982 |
lemmas div_lt'' = order_less_imp_le [THEN div_lt'] |
|
1983 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1984 |
lemma div_lt_mult: "(i :: 'a :: len word) < k div x \<Longrightarrow> 0 < x \<Longrightarrow> i * x < k" |
37660 | 1985 |
apply (frule div_lt'' [THEN unat_mult_lem [THEN iffD1]]) |
1986 |
apply (simp add: unat_arith_simps) |
|
1987 |
apply (drule (1) mult_less_mono1) |
|
1988 |
apply (erule order_less_le_trans) |
|
1989 |
apply (rule div_mult_le) |
|
1990 |
done |
|
1991 |
||
1992 |
lemma div_le_mult: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1993 |
"(i :: 'a :: len word) <= k div x \<Longrightarrow> 0 < x \<Longrightarrow> i * x <= k" |
37660 | 1994 |
apply (frule div_lt' [THEN unat_mult_lem [THEN iffD1]]) |
1995 |
apply (simp add: unat_arith_simps) |
|
1996 |
apply (drule mult_le_mono1) |
|
1997 |
apply (erule order_trans) |
|
1998 |
apply (rule div_mult_le) |
|
1999 |
done |
|
2000 |
||
2001 |
lemma div_lt_uint': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2002 |
"(i :: 'a :: len word) <= k div x \<Longrightarrow> uint i * uint x < 2 ^ len_of TYPE('a)" |
37660 | 2003 |
apply (unfold uint_nat) |
2004 |
apply (drule div_lt') |
|
2005 |
apply (simp add: zmult_int zless_nat_eq_int_zless [symmetric] |
|
2006 |
nat_power_eq) |
|
2007 |
done |
|
2008 |
||
2009 |
lemmas div_lt_uint'' = order_less_imp_le [THEN div_lt_uint'] |
|
2010 |
||
2011 |
lemma word_le_exists': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2012 |
"(x :: 'a :: len0 word) <= y \<Longrightarrow> |
37660 | 2013 |
(EX z. y = x + z & uint x + uint z < 2 ^ len_of TYPE('a))" |
2014 |
apply (rule exI) |
|
2015 |
apply (rule conjI) |
|
2016 |
apply (rule zadd_diff_inverse) |
|
2017 |
apply uint_arith |
|
2018 |
done |
|
2019 |
||
2020 |
lemmas plus_minus_not_NULL = order_less_imp_le [THEN plus_minus_not_NULL_ab] |
|
2021 |
||
2022 |
lemmas plus_minus_no_overflow = |
|
2023 |
order_less_imp_le [THEN plus_minus_no_overflow_ab] |
|
2024 |
||
2025 |
lemmas mcs = word_less_minus_cancel word_less_minus_mono_left |
|
2026 |
word_le_minus_cancel word_le_minus_mono_left |
|
2027 |
||
45604 | 2028 |
lemmas word_l_diffs = mcs [where y = "w + x", unfolded add_diff_cancel] for w x |
2029 |
lemmas word_diff_ls = mcs [where z = "w + x", unfolded add_diff_cancel] for w x |
|
2030 |
lemmas word_plus_mcs = word_diff_ls [where y = "v + x", unfolded add_diff_cancel] for v x |
|
37660 | 2031 |
|
2032 |
lemmas le_unat_uoi = unat_le [THEN word_unat.Abs_inverse] |
|
2033 |
||
2034 |
lemmas thd = refl [THEN [2] split_div_lemma [THEN iffD2], THEN conjunct1] |
|
2035 |
||
2036 |
lemma thd1: |
|
2037 |
"a div b * b \<le> (a::nat)" |
|
2038 |
using gt_or_eq_0 [of b] |
|
2039 |
apply (rule disjE) |
|
2040 |
apply (erule xtr4 [OF thd mult_commute]) |
|
2041 |
apply clarsimp |
|
2042 |
done |
|
2043 |
||
45604 | 2044 |
lemmas uno_simps [THEN le_unat_uoi] = mod_le_divisor div_le_dividend thd1 |
37660 | 2045 |
|
2046 |
lemma word_mod_div_equality: |
|
2047 |
"(n div b) * b + (n mod b) = (n :: 'a :: len word)" |
|
2048 |
apply (unfold word_less_nat_alt word_arith_nat_defs) |
|
2049 |
apply (cut_tac y="unat b" in gt_or_eq_0) |
|
2050 |
apply (erule disjE) |
|
2051 |
apply (simp add: mod_div_equality uno_simps) |
|
2052 |
apply simp |
|
2053 |
done |
|
2054 |
||
2055 |
lemma word_div_mult_le: "a div b * b <= (a::'a::len word)" |
|
2056 |
apply (unfold word_le_nat_alt word_arith_nat_defs) |
|
2057 |
apply (cut_tac y="unat b" in gt_or_eq_0) |
|
2058 |
apply (erule disjE) |
|
2059 |
apply (simp add: div_mult_le uno_simps) |
|
2060 |
apply simp |
|
2061 |
done |
|
2062 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2063 |
lemma word_mod_less_divisor: "0 < n \<Longrightarrow> m mod n < (n :: 'a :: len word)" |
37660 | 2064 |
apply (simp only: word_less_nat_alt word_arith_nat_defs) |
2065 |
apply (clarsimp simp add : uno_simps) |
|
2066 |
done |
|
2067 |
||
2068 |
lemma word_of_int_power_hom: |
|
2069 |
"word_of_int a ^ n = (word_of_int (a ^ n) :: 'a :: len word)" |
|
41550 | 2070 |
by (induct n) (simp_all add: word_of_int_hom_syms) |
37660 | 2071 |
|
2072 |
lemma word_arith_power_alt: |
|
2073 |
"a ^ n = (word_of_int (uint a ^ n) :: 'a :: len word)" |
|
2074 |
by (simp add : word_of_int_power_hom [symmetric]) |
|
2075 |
||
2076 |
lemma of_bl_length_less: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2077 |
"length x = k \<Longrightarrow> k < len_of TYPE('a) \<Longrightarrow> (of_bl x :: 'a :: len word) < 2 ^ k" |
37660 | 2078 |
apply (unfold of_bl_no [unfolded word_number_of_def] |
2079 |
word_less_alt word_number_of_alt) |
|
2080 |
apply safe |
|
2081 |
apply (simp (no_asm) add: word_of_int_power_hom word_uint.eq_norm |
|
2082 |
del: word_of_int_bin) |
|
2083 |
apply (simp add: mod_pos_pos_trivial) |
|
2084 |
apply (subst mod_pos_pos_trivial) |
|
2085 |
apply (rule bl_to_bin_ge0) |
|
2086 |
apply (rule order_less_trans) |
|
2087 |
apply (rule bl_to_bin_lt2p) |
|
2088 |
apply simp |
|
2089 |
apply (rule bl_to_bin_lt2p) |
|
2090 |
done |
|
2091 |
||
2092 |
||
2093 |
subsection "Cardinality, finiteness of set of words" |
|
2094 |
||
45809
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2095 |
instance word :: (len0) finite |
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2096 |
by (default, simp add: type_definition.univ [OF type_definition_word]) |
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2097 |
|
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2098 |
lemma card_word: "CARD('a::len0 word) = 2 ^ len_of TYPE('a)" |
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2099 |
by (simp add: type_definition.card [OF type_definition_word] nat_power_eq) |
37660 | 2100 |
|
2101 |
lemma card_word_size: |
|
45809
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2102 |
"card (UNIV :: 'a :: len0 word set) = (2 ^ size (x :: 'a word))" |
37660 | 2103 |
unfolding word_size by (rule card_word) |
2104 |
||
2105 |
||
2106 |
subsection {* Bitwise Operations on Words *} |
|
2107 |
||
2108 |
lemmas bin_log_bintrs = bin_trunc_not bin_trunc_xor bin_trunc_and bin_trunc_or |
|
2109 |
||
2110 |
(* following definitions require both arithmetic and bit-wise word operations *) |
|
2111 |
||
2112 |
(* to get word_no_log_defs from word_log_defs, using bin_log_bintrs *) |
|
2113 |
lemmas wils1 = bin_log_bintrs [THEN word_ubin.norm_eq_iff [THEN iffD1], |
|
45604 | 2114 |
folded word_ubin.eq_norm, THEN eq_reflection] |
37660 | 2115 |
|
2116 |
(* the binary operations only *) |
|
2117 |
lemmas word_log_binary_defs = |
|
2118 |
word_and_def word_or_def word_xor_def |
|
2119 |
||
2120 |
lemmas word_no_log_defs [simp] = |
|
2121 |
word_not_def [where a="number_of a", |
|
45604 | 2122 |
unfolded word_no_wi wils1, folded word_no_wi] |
37660 | 2123 |
word_log_binary_defs [where a="number_of a" and b="number_of b", |
45604 | 2124 |
unfolded word_no_wi wils1, folded word_no_wi] |
2125 |
for a b |
|
37660 | 2126 |
|
2127 |
lemmas word_wi_log_defs = word_no_log_defs [unfolded word_no_wi] |
|
2128 |
||
2129 |
lemma uint_or: "uint (x OR y) = (uint x) OR (uint y)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2130 |
by (simp add: word_or_def word_wi_log_defs word_ubin.eq_norm |
37660 | 2131 |
bin_trunc_ao(2) [symmetric]) |
2132 |
||
2133 |
lemma uint_and: "uint (x AND y) = (uint x) AND (uint y)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2134 |
by (simp add: word_and_def word_wi_log_defs word_ubin.eq_norm |
37660 | 2135 |
bin_trunc_ao(1) [symmetric]) |
2136 |
||
2137 |
lemma word_ops_nth_size: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2138 |
"n < size (x::'a::len0 word) \<Longrightarrow> |
37660 | 2139 |
(x OR y) !! n = (x !! n | y !! n) & |
2140 |
(x AND y) !! n = (x !! n & y !! n) & |
|
2141 |
(x XOR y) !! n = (x !! n ~= y !! n) & |
|
2142 |
(NOT x) !! n = (~ x !! n)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2143 |
unfolding word_size word_test_bit_def word_log_defs |
37660 | 2144 |
by (clarsimp simp add : word_ubin.eq_norm nth_bintr bin_nth_ops) |
2145 |
||
2146 |
lemma word_ao_nth: |
|
2147 |
fixes x :: "'a::len0 word" |
|
2148 |
shows "(x OR y) !! n = (x !! n | y !! n) & |
|
2149 |
(x AND y) !! n = (x !! n & y !! n)" |
|
2150 |
apply (cases "n < size x") |
|
2151 |
apply (drule_tac y = "y" in word_ops_nth_size) |
|
2152 |
apply simp |
|
2153 |
apply (simp add : test_bit_bin word_size) |
|
2154 |
done |
|
2155 |
||
2156 |
(* get from commutativity, associativity etc of int_and etc |
|
2157 |
to same for word_and etc *) |
|
2158 |
||
2159 |
lemmas bwsimps = |
|
2160 |
word_of_int_homs(2) |
|
2161 |
word_0_wi_Pls |
|
2162 |
word_m1_wi_Min |
|
2163 |
word_wi_log_defs |
|
2164 |
||
2165 |
lemma word_bw_assocs: |
|
2166 |
fixes x :: "'a::len0 word" |
|
2167 |
shows |
|
2168 |
"(x AND y) AND z = x AND y AND z" |
|
2169 |
"(x OR y) OR z = x OR y OR z" |
|
2170 |
"(x XOR y) XOR z = x XOR y XOR z" |
|
2171 |
using word_of_int_Ex [where x=x] |
|
2172 |
word_of_int_Ex [where x=y] |
|
2173 |
word_of_int_Ex [where x=z] |
|
2174 |
by (auto simp: bwsimps bbw_assocs) |
|
2175 |
||
2176 |
lemma word_bw_comms: |
|
2177 |
fixes x :: "'a::len0 word" |
|
2178 |
shows |
|
2179 |
"x AND y = y AND x" |
|
2180 |
"x OR y = y OR x" |
|
2181 |
"x XOR y = y XOR x" |
|
2182 |
using word_of_int_Ex [where x=x] |
|
2183 |
word_of_int_Ex [where x=y] |
|
2184 |
by (auto simp: bwsimps bin_ops_comm) |
|
2185 |
||
2186 |
lemma word_bw_lcs: |
|
2187 |
fixes x :: "'a::len0 word" |
|
2188 |
shows |
|
2189 |
"y AND x AND z = x AND y AND z" |
|
2190 |
"y OR x OR z = x OR y OR z" |
|
2191 |
"y XOR x XOR z = x XOR y XOR z" |
|
2192 |
using word_of_int_Ex [where x=x] |
|
2193 |
word_of_int_Ex [where x=y] |
|
2194 |
word_of_int_Ex [where x=z] |
|
2195 |
by (auto simp: bwsimps) |
|
2196 |
||
2197 |
lemma word_log_esimps [simp]: |
|
2198 |
fixes x :: "'a::len0 word" |
|
2199 |
shows |
|
2200 |
"x AND 0 = 0" |
|
2201 |
"x AND -1 = x" |
|
2202 |
"x OR 0 = x" |
|
2203 |
"x OR -1 = -1" |
|
2204 |
"x XOR 0 = x" |
|
2205 |
"x XOR -1 = NOT x" |
|
2206 |
"0 AND x = 0" |
|
2207 |
"-1 AND x = x" |
|
2208 |
"0 OR x = x" |
|
2209 |
"-1 OR x = -1" |
|
2210 |
"0 XOR x = x" |
|
2211 |
"-1 XOR x = NOT x" |
|
2212 |
using word_of_int_Ex [where x=x] |
|
2213 |
by (auto simp: bwsimps) |
|
2214 |
||
2215 |
lemma word_not_dist: |
|
2216 |
fixes x :: "'a::len0 word" |
|
2217 |
shows |
|
2218 |
"NOT (x OR y) = NOT x AND NOT y" |
|
2219 |
"NOT (x AND y) = NOT x OR NOT y" |
|
2220 |
using word_of_int_Ex [where x=x] |
|
2221 |
word_of_int_Ex [where x=y] |
|
2222 |
by (auto simp: bwsimps bbw_not_dist) |
|
2223 |
||
2224 |
lemma word_bw_same: |
|
2225 |
fixes x :: "'a::len0 word" |
|
2226 |
shows |
|
2227 |
"x AND x = x" |
|
2228 |
"x OR x = x" |
|
2229 |
"x XOR x = 0" |
|
2230 |
using word_of_int_Ex [where x=x] |
|
2231 |
by (auto simp: bwsimps) |
|
2232 |
||
2233 |
lemma word_ao_absorbs [simp]: |
|
2234 |
fixes x :: "'a::len0 word" |
|
2235 |
shows |
|
2236 |
"x AND (y OR x) = x" |
|
2237 |
"x OR y AND x = x" |
|
2238 |
"x AND (x OR y) = x" |
|
2239 |
"y AND x OR x = x" |
|
2240 |
"(y OR x) AND x = x" |
|
2241 |
"x OR x AND y = x" |
|
2242 |
"(x OR y) AND x = x" |
|
2243 |
"x AND y OR x = x" |
|
2244 |
using word_of_int_Ex [where x=x] |
|
2245 |
word_of_int_Ex [where x=y] |
|
2246 |
by (auto simp: bwsimps) |
|
2247 |
||
2248 |
lemma word_not_not [simp]: |
|
2249 |
"NOT NOT (x::'a::len0 word) = x" |
|
2250 |
using word_of_int_Ex [where x=x] |
|
2251 |
by (auto simp: bwsimps) |
|
2252 |
||
2253 |
lemma word_ao_dist: |
|
2254 |
fixes x :: "'a::len0 word" |
|
2255 |
shows "(x OR y) AND z = x AND z OR y AND z" |
|
2256 |
using word_of_int_Ex [where x=x] |
|
2257 |
word_of_int_Ex [where x=y] |
|
2258 |
word_of_int_Ex [where x=z] |
|
41550 | 2259 |
by (auto simp: bwsimps bbw_ao_dist) |
37660 | 2260 |
|
2261 |
lemma word_oa_dist: |
|
2262 |
fixes x :: "'a::len0 word" |
|
2263 |
shows "x AND y OR z = (x OR z) AND (y OR z)" |
|
2264 |
using word_of_int_Ex [where x=x] |
|
2265 |
word_of_int_Ex [where x=y] |
|
2266 |
word_of_int_Ex [where x=z] |
|
41550 | 2267 |
by (auto simp: bwsimps bbw_oa_dist) |
37660 | 2268 |
|
2269 |
lemma word_add_not [simp]: |
|
2270 |
fixes x :: "'a::len0 word" |
|
2271 |
shows "x + NOT x = -1" |
|
2272 |
using word_of_int_Ex [where x=x] |
|
2273 |
by (auto simp: bwsimps bin_add_not) |
|
2274 |
||
2275 |
lemma word_plus_and_or [simp]: |
|
2276 |
fixes x :: "'a::len0 word" |
|
2277 |
shows "(x AND y) + (x OR y) = x + y" |
|
2278 |
using word_of_int_Ex [where x=x] |
|
2279 |
word_of_int_Ex [where x=y] |
|
2280 |
by (auto simp: bwsimps plus_and_or) |
|
2281 |
||
2282 |
lemma leoa: |
|
2283 |
fixes x :: "'a::len0 word" |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2284 |
shows "(w = (x OR y)) \<Longrightarrow> (y = (w AND y))" by auto |
37660 | 2285 |
lemma leao: |
2286 |
fixes x' :: "'a::len0 word" |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2287 |
shows "(w' = (x' AND y')) \<Longrightarrow> (x' = (x' OR w'))" by auto |
37660 | 2288 |
|
2289 |
lemmas word_ao_equiv = leao [COMP leoa [COMP iffI]] |
|
2290 |
||
2291 |
lemma le_word_or2: "x <= x OR (y::'a::len0 word)" |
|
2292 |
unfolding word_le_def uint_or |
|
2293 |
by (auto intro: le_int_or) |
|
2294 |
||
45604 | 2295 |
lemmas le_word_or1 = xtr3 [OF word_bw_comms (2) le_word_or2] |
2296 |
lemmas word_and_le1 = xtr3 [OF word_ao_absorbs (4) [symmetric] le_word_or2] |
|
2297 |
lemmas word_and_le2 = xtr3 [OF word_ao_absorbs (8) [symmetric] le_word_or2] |
|
37660 | 2298 |
|
2299 |
lemma bl_word_not: "to_bl (NOT w) = map Not (to_bl w)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2300 |
unfolding to_bl_def word_log_defs bl_not_bin |
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2301 |
by (simp add: word_ubin.eq_norm) |
37660 | 2302 |
|
2303 |
lemma bl_word_xor: "to_bl (v XOR w) = map2 op ~= (to_bl v) (to_bl w)" |
|
2304 |
unfolding to_bl_def word_log_defs bl_xor_bin |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2305 |
by (simp add: word_ubin.eq_norm) |
37660 | 2306 |
|
2307 |
lemma bl_word_or: "to_bl (v OR w) = map2 op | (to_bl v) (to_bl w)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2308 |
unfolding to_bl_def word_log_defs bl_or_bin |
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2309 |
by (simp add: word_ubin.eq_norm) |
37660 | 2310 |
|
2311 |
lemma bl_word_and: "to_bl (v AND w) = map2 op & (to_bl v) (to_bl w)" |
|
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2312 |
unfolding to_bl_def word_log_defs bl_and_bin |
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2313 |
by (simp add: word_ubin.eq_norm) |
37660 | 2314 |
|
2315 |
lemma word_lsb_alt: "lsb (w::'a::len0 word) = test_bit w 0" |
|
2316 |
by (auto simp: word_test_bit_def word_lsb_def) |
|
2317 |
||
45805 | 2318 |
lemma word_lsb_1_0 [simp]: "lsb (1::'a::len word) & ~ lsb (0::'b::len0 word)" |
45550
73a4f31d41c4
Word.thy: reduce usage of numeral-representation-dependent thms like number_of_is_id in proofs
huffman
parents:
45549
diff
changeset
|
2319 |
unfolding word_lsb_def uint_eq_0 uint_1 by simp |
37660 | 2320 |
|
2321 |
lemma word_lsb_last: "lsb (w::'a::len word) = last (to_bl w)" |
|
2322 |
apply (unfold word_lsb_def uint_bl bin_to_bl_def) |
|
2323 |
apply (rule_tac bin="uint w" in bin_exhaust) |
|
2324 |
apply (cases "size w") |
|
2325 |
apply auto |
|
2326 |
apply (auto simp add: bin_to_bl_aux_alt) |
|
2327 |
done |
|
2328 |
||
2329 |
lemma word_lsb_int: "lsb w = (uint w mod 2 = 1)" |
|
45529
0e1037d4e049
remove redundant lemmas bin_last_mod and bin_rest_div, use bin_last_def and bin_rest_def instead
huffman
parents:
45528
diff
changeset
|
2330 |
unfolding word_lsb_def bin_last_def by auto |
37660 | 2331 |
|
2332 |
lemma word_msb_sint: "msb w = (sint w < 0)" |
|
2333 |
unfolding word_msb_def |
|
2334 |
by (simp add : sign_Min_lt_0 number_of_is_id) |
|
2335 |
||
45805 | 2336 |
lemma word_msb_no [simp]: |
2337 |
"msb (number_of bin :: 'a::len word) = bin_nth bin (len_of TYPE('a) - 1)" |
|
45811 | 2338 |
unfolding word_msb_def word_number_of_def |
2339 |
by (clarsimp simp add: word_sbin.eq_norm bin_sign_lem) |
|
2340 |
||
2341 |
lemma word_msb_nth: |
|
2342 |
"msb (w::'a::len word) = bin_nth (uint w) (len_of TYPE('a) - 1)" |
|
37660 | 2343 |
apply (rule trans [OF _ word_msb_no]) |
2344 |
apply (simp add : word_number_of_def) |
|
2345 |
done |
|
2346 |
||
2347 |
lemma word_msb_alt: "msb (w::'a::len word) = hd (to_bl w)" |
|
2348 |
apply (unfold word_msb_nth uint_bl) |
|
2349 |
apply (subst hd_conv_nth) |
|
2350 |
apply (rule length_greater_0_conv [THEN iffD1]) |
|
2351 |
apply simp |
|
2352 |
apply (simp add : nth_bin_to_bl word_size) |
|
2353 |
done |
|
2354 |
||
45805 | 2355 |
lemma word_set_nth [simp]: |
37660 | 2356 |
"set_bit w n (test_bit w n) = (w::'a::len0 word)" |
2357 |
unfolding word_test_bit_def word_set_bit_def by auto |
|
2358 |
||
2359 |
lemma bin_nth_uint': |
|
2360 |
"bin_nth (uint w) n = (rev (bin_to_bl (size w) (uint w)) ! n & n < size w)" |
|
2361 |
apply (unfold word_size) |
|
2362 |
apply (safe elim!: bin_nth_uint_imp) |
|
2363 |
apply (frule bin_nth_uint_imp) |
|
2364 |
apply (fast dest!: bin_nth_bl)+ |
|
2365 |
done |
|
2366 |
||
2367 |
lemmas bin_nth_uint = bin_nth_uint' [unfolded word_size] |
|
2368 |
||
2369 |
lemma test_bit_bl: "w !! n = (rev (to_bl w) ! n & n < size w)" |
|
2370 |
unfolding to_bl_def word_test_bit_def word_size |
|
2371 |
by (rule bin_nth_uint) |
|
2372 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2373 |
lemma to_bl_nth: "n < size w \<Longrightarrow> to_bl w ! n = w !! (size w - Suc n)" |
37660 | 2374 |
apply (unfold test_bit_bl) |
2375 |
apply clarsimp |
|
2376 |
apply (rule trans) |
|
2377 |
apply (rule nth_rev_alt) |
|
2378 |
apply (auto simp add: word_size) |
|
2379 |
done |
|
2380 |
||
2381 |
lemma test_bit_set: |
|
2382 |
fixes w :: "'a::len0 word" |
|
2383 |
shows "(set_bit w n x) !! n = (n < size w & x)" |
|
2384 |
unfolding word_size word_test_bit_def word_set_bit_def |
|
2385 |
by (clarsimp simp add : word_ubin.eq_norm nth_bintr) |
|
2386 |
||
2387 |
lemma test_bit_set_gen: |
|
2388 |
fixes w :: "'a::len0 word" |
|
2389 |
shows "test_bit (set_bit w n x) m = |
|
2390 |
(if m = n then n < size w & x else test_bit w m)" |
|
2391 |
apply (unfold word_size word_test_bit_def word_set_bit_def) |
|
2392 |
apply (clarsimp simp add: word_ubin.eq_norm nth_bintr bin_nth_sc_gen) |
|
2393 |
apply (auto elim!: test_bit_size [unfolded word_size] |
|
2394 |
simp add: word_test_bit_def [symmetric]) |
|
2395 |
done |
|
2396 |
||
2397 |
lemma of_bl_rep_False: "of_bl (replicate n False @ bs) = of_bl bs" |
|
2398 |
unfolding of_bl_def bl_to_bin_rep_F by auto |
|
2399 |
||
45811 | 2400 |
lemma msb_nth: |
37660 | 2401 |
fixes w :: "'a::len word" |
45811 | 2402 |
shows "msb w = w !! (len_of TYPE('a) - 1)" |
2403 |
unfolding word_msb_nth word_test_bit_def by simp |
|
37660 | 2404 |
|
45604 | 2405 |
lemmas msb0 = len_gt_0 [THEN diff_Suc_less, THEN word_ops_nth_size [unfolded word_size]] |
37660 | 2406 |
lemmas msb1 = msb0 [where i = 0] |
2407 |
lemmas word_ops_msb = msb1 [unfolded msb_nth [symmetric, unfolded One_nat_def]] |
|
2408 |
||
45604 | 2409 |
lemmas lsb0 = len_gt_0 [THEN word_ops_nth_size [unfolded word_size]] |
37660 | 2410 |
lemmas word_ops_lsb = lsb0 [unfolded word_lsb_alt] |
2411 |
||
45811 | 2412 |
lemma td_ext_nth [OF refl refl refl, unfolded word_size]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2413 |
"n = size (w::'a::len0 word) \<Longrightarrow> ofn = set_bits \<Longrightarrow> [w, ofn g] = l \<Longrightarrow> |
37660 | 2414 |
td_ext test_bit ofn {f. ALL i. f i --> i < n} (%h i. h i & i < n)" |
2415 |
apply (unfold word_size td_ext_def') |
|
2416 |
apply (safe del: subset_antisym) |
|
2417 |
apply (rule_tac [3] ext) |
|
2418 |
apply (rule_tac [4] ext) |
|
2419 |
apply (unfold word_size of_nth_def test_bit_bl) |
|
2420 |
apply safe |
|
2421 |
defer |
|
2422 |
apply (clarsimp simp: word_bl.Abs_inverse)+ |
|
2423 |
apply (rule word_bl.Rep_inverse') |
|
2424 |
apply (rule sym [THEN trans]) |
|
2425 |
apply (rule bl_of_nth_nth) |
|
2426 |
apply simp |
|
2427 |
apply (rule bl_of_nth_inj) |
|
2428 |
apply (clarsimp simp add : test_bit_bl word_size) |
|
2429 |
done |
|
2430 |
||
2431 |
interpretation test_bit: |
|
2432 |
td_ext "op !! :: 'a::len0 word => nat => bool" |
|
2433 |
set_bits |
|
2434 |
"{f. \<forall>i. f i \<longrightarrow> i < len_of TYPE('a::len0)}" |
|
2435 |
"(\<lambda>h i. h i \<and> i < len_of TYPE('a::len0))" |
|
2436 |
by (rule td_ext_nth) |
|
2437 |
||
2438 |
lemmas td_nth = test_bit.td_thm |
|
2439 |
||
45805 | 2440 |
lemma word_set_set_same [simp]: |
37660 | 2441 |
fixes w :: "'a::len0 word" |
2442 |
shows "set_bit (set_bit w n x) n y = set_bit w n y" |
|
2443 |
by (rule word_eqI) (simp add : test_bit_set_gen word_size) |
|
2444 |
||
2445 |
lemma word_set_set_diff: |
|
2446 |
fixes w :: "'a::len0 word" |
|
2447 |
assumes "m ~= n" |
|
2448 |
shows "set_bit (set_bit w m x) n y = set_bit (set_bit w n y) m x" |
|
41550 | 2449 |
by (rule word_eqI) (clarsimp simp add: test_bit_set_gen word_size assms) |
37660 | 2450 |
|
45811 | 2451 |
lemma test_bit_no [simp]: |
2452 |
"(number_of bin :: 'a::len0 word) !! n \<equiv> n < len_of TYPE('a) \<and> bin_nth bin n" |
|
37660 | 2453 |
unfolding word_test_bit_def word_number_of_def word_size |
2454 |
by (simp add : nth_bintr [symmetric] word_ubin.eq_norm) |
|
2455 |
||
45805 | 2456 |
lemma nth_0 [simp]: "~ (0::'a::len0 word) !! n" |
37660 | 2457 |
unfolding test_bit_no word_0_no by auto |
2458 |
||
2459 |
lemma nth_sint: |
|
2460 |
fixes w :: "'a::len word" |
|
2461 |
defines "l \<equiv> len_of TYPE ('a)" |
|
2462 |
shows "bin_nth (sint w) n = (if n < l - 1 then w !! n else w !! (l - 1))" |
|
2463 |
unfolding sint_uint l_def |
|
2464 |
by (clarsimp simp add: nth_sbintr word_test_bit_def [symmetric]) |
|
2465 |
||
45805 | 2466 |
lemma word_lsb_no [simp]: |
37660 | 2467 |
"lsb (number_of bin :: 'a :: len word) = (bin_last bin = 1)" |
2468 |
unfolding word_lsb_alt test_bit_no by auto |
|
2469 |
||
45805 | 2470 |
lemma word_set_no [simp]: |
37660 | 2471 |
"set_bit (number_of bin::'a::len0 word) n b = |
2472 |
number_of (bin_sc n (if b then 1 else 0) bin)" |
|
2473 |
apply (unfold word_set_bit_def word_number_of_def [symmetric]) |
|
2474 |
apply (rule word_eqI) |
|
2475 |
apply (clarsimp simp: word_size bin_nth_sc_gen number_of_is_id |
|
45805 | 2476 |
nth_bintr) |
37660 | 2477 |
done |
2478 |
||
45805 | 2479 |
lemma setBit_no [simp]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2480 |
"setBit (number_of bin) n = number_of (bin_sc n 1 bin) " |
45805 | 2481 |
by (simp add: setBit_def) |
2482 |
||
2483 |
lemma clearBit_no [simp]: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2484 |
"clearBit (number_of bin) n = number_of (bin_sc n 0 bin)" |
45805 | 2485 |
by (simp add: clearBit_def) |
37660 | 2486 |
|
2487 |
lemma to_bl_n1: |
|
2488 |
"to_bl (-1::'a::len0 word) = replicate (len_of TYPE ('a)) True" |
|
2489 |
apply (rule word_bl.Abs_inverse') |
|
2490 |
apply simp |
|
2491 |
apply (rule word_eqI) |
|
45805 | 2492 |
apply (clarsimp simp add: word_size) |
37660 | 2493 |
apply (auto simp add: word_bl.Abs_inverse test_bit_bl word_size) |
2494 |
done |
|
2495 |
||
45805 | 2496 |
lemma word_msb_n1 [simp]: "msb (-1::'a::len word)" |
41550 | 2497 |
unfolding word_msb_alt to_bl_n1 by simp |
37660 | 2498 |
|
2499 |
lemma word_set_nth_iff: |
|
2500 |
"(set_bit w n b = w) = (w !! n = b | n >= size (w::'a::len0 word))" |
|
2501 |
apply (rule iffI) |
|
2502 |
apply (rule disjCI) |
|
2503 |
apply (drule word_eqD) |
|
2504 |
apply (erule sym [THEN trans]) |
|
2505 |
apply (simp add: test_bit_set) |
|
2506 |
apply (erule disjE) |
|
2507 |
apply clarsimp |
|
2508 |
apply (rule word_eqI) |
|
2509 |
apply (clarsimp simp add : test_bit_set_gen) |
|
2510 |
apply (drule test_bit_size) |
|
2511 |
apply force |
|
2512 |
done |
|
2513 |
||
45811 | 2514 |
lemma test_bit_2p: |
2515 |
"(word_of_int (2 ^ n)::'a::len word) !! m \<longleftrightarrow> m = n \<and> m < len_of TYPE('a)" |
|
2516 |
unfolding word_test_bit_def |
|
37660 | 2517 |
by (auto simp add: word_ubin.eq_norm nth_bintr nth_2p_bin) |
2518 |
||
2519 |
lemma nth_w2p: |
|
2520 |
"((2\<Colon>'a\<Colon>len word) ^ n) !! m \<longleftrightarrow> m = n \<and> m < len_of TYPE('a\<Colon>len)" |
|
2521 |
unfolding test_bit_2p [symmetric] word_of_int [symmetric] |
|
2522 |
by (simp add: of_int_power) |
|
2523 |
||
2524 |
lemma uint_2p: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2525 |
"(0::'a::len word) < 2 ^ n \<Longrightarrow> uint (2 ^ n::'a::len word) = 2 ^ n" |
37660 | 2526 |
apply (unfold word_arith_power_alt) |
2527 |
apply (case_tac "len_of TYPE ('a)") |
|
2528 |
apply clarsimp |
|
2529 |
apply (case_tac "nat") |
|
2530 |
apply clarsimp |
|
2531 |
apply (case_tac "n") |
|
2532 |
apply (clarsimp simp add : word_1_wi [symmetric]) |
|
45847 | 2533 |
apply (clarsimp simp add : word_0_wi [symmetric] BIT_simps) |
37660 | 2534 |
apply (drule word_gt_0 [THEN iffD1]) |
2535 |
apply (safe intro!: word_eqI bin_nth_lem ext) |
|
45847 | 2536 |
apply (auto simp add: test_bit_2p nth_2p_bin word_test_bit_def [symmetric] BIT_simps) |
37660 | 2537 |
done |
2538 |
||
2539 |
lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a :: len word) = 2 ^ n" |
|
2540 |
apply (unfold word_arith_power_alt) |
|
2541 |
apply (case_tac "len_of TYPE ('a)") |
|
2542 |
apply clarsimp |
|
2543 |
apply (case_tac "nat") |
|
2544 |
apply (rule word_ubin.norm_eq_iff [THEN iffD1]) |
|
2545 |
apply (rule box_equals) |
|
2546 |
apply (rule_tac [2] bintr_ariths (1))+ |
|
2547 |
apply (clarsimp simp add : number_of_is_id) |
|
45847 | 2548 |
apply (simp add: BIT_simps) |
37660 | 2549 |
done |
2550 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2551 |
lemma bang_is_le: "x !! m \<Longrightarrow> 2 ^ m <= (x :: 'a :: len word)" |
37660 | 2552 |
apply (rule xtr3) |
2553 |
apply (rule_tac [2] y = "x" in le_word_or2) |
|
2554 |
apply (rule word_eqI) |
|
2555 |
apply (auto simp add: word_ao_nth nth_w2p word_size) |
|
2556 |
done |
|
2557 |
||
2558 |
lemma word_clr_le: |
|
2559 |
fixes w :: "'a::len0 word" |
|
2560 |
shows "w >= set_bit w n False" |
|
2561 |
apply (unfold word_set_bit_def word_le_def word_ubin.eq_norm) |
|
2562 |
apply simp |
|
2563 |
apply (rule order_trans) |
|
2564 |
apply (rule bintr_bin_clr_le) |
|
2565 |
apply simp |
|
2566 |
done |
|
2567 |
||
2568 |
lemma word_set_ge: |
|
2569 |
fixes w :: "'a::len word" |
|
2570 |
shows "w <= set_bit w n True" |
|
2571 |
apply (unfold word_set_bit_def word_le_def word_ubin.eq_norm) |
|
2572 |
apply simp |
|
2573 |
apply (rule order_trans [OF _ bintr_bin_set_ge]) |
|
2574 |
apply simp |
|
2575 |
done |
|
2576 |
||
2577 |
||
2578 |
subsection {* Shifting, Rotating, and Splitting Words *} |
|
2579 |
||
2580 |
lemma shiftl1_number [simp] : |
|
2581 |
"shiftl1 (number_of w) = number_of (w BIT 0)" |
|
2582 |
apply (unfold shiftl1_def word_number_of_def) |
|
2583 |
apply (simp add: word_ubin.norm_eq_iff [symmetric] word_ubin.eq_norm |
|
2584 |
del: BIT_simps) |
|
2585 |
apply (subst refl [THEN bintrunc_BIT_I, symmetric]) |
|
2586 |
apply (subst bintrunc_bintrunc_min) |
|
2587 |
apply simp |
|
2588 |
done |
|
2589 |
||
2590 |
lemma shiftl1_0 [simp] : "shiftl1 0 = 0" |
|
45847 | 2591 |
unfolding word_0_no shiftl1_number by (auto simp: BIT_simps) |
37660 | 2592 |
|
45858 | 2593 |
lemma shiftl1_def_u: "shiftl1 w = number_of (uint w BIT 0)" |
2594 |
by (simp only: word_number_of_def shiftl1_def) |
|
37660 | 2595 |
|
2596 |
lemma shiftl1_def_s: "shiftl1 w = number_of (sint w BIT 0)" |
|
2597 |
by (rule trans [OF _ shiftl1_number]) simp |
|
2598 |
||
2599 |
lemma shiftr1_0 [simp] : "shiftr1 0 = 0" |
|
2600 |
unfolding shiftr1_def |
|
2601 |
by simp (simp add: word_0_wi) |
|
2602 |
||
2603 |
lemma sshiftr1_0 [simp] : "sshiftr1 0 = 0" |
|
2604 |
apply (unfold sshiftr1_def) |
|
2605 |
apply simp |
|
2606 |
apply (simp add : word_0_wi) |
|
2607 |
done |
|
2608 |
||
2609 |
lemma sshiftr1_n1 [simp] : "sshiftr1 -1 = -1" |
|
2610 |
unfolding sshiftr1_def by auto |
|
2611 |
||
2612 |
lemma shiftl_0 [simp] : "(0::'a::len0 word) << n = 0" |
|
2613 |
unfolding shiftl_def by (induct n) auto |
|
2614 |
||
2615 |
lemma shiftr_0 [simp] : "(0::'a::len0 word) >> n = 0" |
|
2616 |
unfolding shiftr_def by (induct n) auto |
|
2617 |
||
2618 |
lemma sshiftr_0 [simp] : "0 >>> n = 0" |
|
2619 |
unfolding sshiftr_def by (induct n) auto |
|
2620 |
||
2621 |
lemma sshiftr_n1 [simp] : "-1 >>> n = -1" |
|
2622 |
unfolding sshiftr_def by (induct n) auto |
|
2623 |
||
2624 |
lemma nth_shiftl1: "shiftl1 w !! n = (n < size w & n > 0 & w !! (n - 1))" |
|
2625 |
apply (unfold shiftl1_def word_test_bit_def) |
|
2626 |
apply (simp add: nth_bintr word_ubin.eq_norm word_size) |
|
2627 |
apply (cases n) |
|
2628 |
apply auto |
|
2629 |
done |
|
2630 |
||
2631 |
lemma nth_shiftl' [rule_format]: |
|
2632 |
"ALL n. ((w::'a::len0 word) << m) !! n = (n < size w & n >= m & w !! (n - m))" |
|
2633 |
apply (unfold shiftl_def) |
|
2634 |
apply (induct "m") |
|
2635 |
apply (force elim!: test_bit_size) |
|
2636 |
apply (clarsimp simp add : nth_shiftl1 word_size) |
|
2637 |
apply arith |
|
2638 |
done |
|
2639 |
||
2640 |
lemmas nth_shiftl = nth_shiftl' [unfolded word_size] |
|
2641 |
||
2642 |
lemma nth_shiftr1: "shiftr1 w !! n = w !! Suc n" |
|
2643 |
apply (unfold shiftr1_def word_test_bit_def) |
|
2644 |
apply (simp add: nth_bintr word_ubin.eq_norm) |
|
2645 |
apply safe |
|
2646 |
apply (drule bin_nth.Suc [THEN iffD2, THEN bin_nth_uint_imp]) |
|
2647 |
apply simp |
|
2648 |
done |
|
2649 |
||
2650 |
lemma nth_shiftr: |
|
2651 |
"\<And>n. ((w::'a::len0 word) >> m) !! n = w !! (n + m)" |
|
2652 |
apply (unfold shiftr_def) |
|
2653 |
apply (induct "m") |
|
2654 |
apply (auto simp add : nth_shiftr1) |
|
2655 |
done |
|
2656 |
||
2657 |
(* see paper page 10, (1), (2), shiftr1_def is of the form of (1), |
|
2658 |
where f (ie bin_rest) takes normal arguments to normal results, |
|
2659 |
thus we get (2) from (1) *) |
|
2660 |
||
2661 |
lemma uint_shiftr1: "uint (shiftr1 w) = bin_rest (uint w)" |
|
2662 |
apply (unfold shiftr1_def word_ubin.eq_norm bin_rest_trunc_i) |
|
2663 |
apply (subst bintr_uint [symmetric, OF order_refl]) |
|
2664 |
apply (simp only : bintrunc_bintrunc_l) |
|
2665 |
apply simp |
|
2666 |
done |
|
2667 |
||
2668 |
lemma nth_sshiftr1: |
|
2669 |
"sshiftr1 w !! n = (if n = size w - 1 then w !! n else w !! Suc n)" |
|
2670 |
apply (unfold sshiftr1_def word_test_bit_def) |
|
2671 |
apply (simp add: nth_bintr word_ubin.eq_norm |
|
2672 |
bin_nth.Suc [symmetric] word_size |
|
2673 |
del: bin_nth.simps) |
|
2674 |
apply (simp add: nth_bintr uint_sint del : bin_nth.simps) |
|
2675 |
apply (auto simp add: bin_nth_sint) |
|
2676 |
done |
|
2677 |
||
2678 |
lemma nth_sshiftr [rule_format] : |
|
2679 |
"ALL n. sshiftr w m !! n = (n < size w & |
|
2680 |
(if n + m >= size w then w !! (size w - 1) else w !! (n + m)))" |
|
2681 |
apply (unfold sshiftr_def) |
|
2682 |
apply (induct_tac "m") |
|
2683 |
apply (simp add: test_bit_bl) |
|
2684 |
apply (clarsimp simp add: nth_sshiftr1 word_size) |
|
2685 |
apply safe |
|
2686 |
apply arith |
|
2687 |
apply arith |
|
2688 |
apply (erule thin_rl) |
|
2689 |
apply (case_tac n) |
|
2690 |
apply safe |
|
2691 |
apply simp |
|
2692 |
apply simp |
|
2693 |
apply (erule thin_rl) |
|
2694 |
apply (case_tac n) |
|
2695 |
apply safe |
|
2696 |
apply simp |
|
2697 |
apply simp |
|
2698 |
apply arith+ |
|
2699 |
done |
|
2700 |
||
2701 |
lemma shiftr1_div_2: "uint (shiftr1 w) = uint w div 2" |
|
45529
0e1037d4e049
remove redundant lemmas bin_last_mod and bin_rest_div, use bin_last_def and bin_rest_def instead
huffman
parents:
45528
diff
changeset
|
2702 |
apply (unfold shiftr1_def bin_rest_def) |
37660 | 2703 |
apply (rule word_uint.Abs_inverse) |
2704 |
apply (simp add: uints_num pos_imp_zdiv_nonneg_iff) |
|
2705 |
apply (rule xtr7) |
|
2706 |
prefer 2 |
|
2707 |
apply (rule zdiv_le_dividend) |
|
2708 |
apply auto |
|
2709 |
done |
|
2710 |
||
2711 |
lemma sshiftr1_div_2: "sint (sshiftr1 w) = sint w div 2" |
|
45529
0e1037d4e049
remove redundant lemmas bin_last_mod and bin_rest_div, use bin_last_def and bin_rest_def instead
huffman
parents:
45528
diff
changeset
|
2712 |
apply (unfold sshiftr1_def bin_rest_def [symmetric]) |
37660 | 2713 |
apply (simp add: word_sbin.eq_norm) |
2714 |
apply (rule trans) |
|
2715 |
defer |
|
2716 |
apply (subst word_sbin.norm_Rep [symmetric]) |
|
2717 |
apply (rule refl) |
|
2718 |
apply (subst word_sbin.norm_Rep [symmetric]) |
|
2719 |
apply (unfold One_nat_def) |
|
2720 |
apply (rule sbintrunc_rest) |
|
2721 |
done |
|
2722 |
||
2723 |
lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n" |
|
2724 |
apply (unfold shiftr_def) |
|
2725 |
apply (induct "n") |
|
2726 |
apply simp |
|
2727 |
apply (simp add: shiftr1_div_2 mult_commute |
|
2728 |
zdiv_zmult2_eq [symmetric]) |
|
2729 |
done |
|
2730 |
||
2731 |
lemma sshiftr_div_2n: "sint (sshiftr w n) = sint w div 2 ^ n" |
|
2732 |
apply (unfold sshiftr_def) |
|
2733 |
apply (induct "n") |
|
2734 |
apply simp |
|
2735 |
apply (simp add: sshiftr1_div_2 mult_commute |
|
2736 |
zdiv_zmult2_eq [symmetric]) |
|
2737 |
done |
|
2738 |
||
2739 |
subsubsection "shift functions in terms of lists of bools" |
|
2740 |
||
2741 |
lemmas bshiftr1_no_bin [simp] = |
|
45604 | 2742 |
bshiftr1_def [where w="number_of w", unfolded to_bl_no_bin] for w |
37660 | 2743 |
|
2744 |
lemma bshiftr1_bl: "to_bl (bshiftr1 b w) = b # butlast (to_bl w)" |
|
2745 |
unfolding bshiftr1_def by (rule word_bl.Abs_inverse) simp |
|
2746 |
||
2747 |
lemma shiftl1_of_bl: "shiftl1 (of_bl bl) = of_bl (bl @ [False])" |
|
2748 |
unfolding uint_bl of_bl_no |
|
2749 |
by (simp add: bl_to_bin_aux_append bl_to_bin_def) |
|
2750 |
||
2751 |
lemma shiftl1_bl: "shiftl1 (w::'a::len0 word) = of_bl (to_bl w @ [False])" |
|
2752 |
proof - |
|
2753 |
have "shiftl1 w = shiftl1 (of_bl (to_bl w))" by simp |
|
2754 |
also have "\<dots> = of_bl (to_bl w @ [False])" by (rule shiftl1_of_bl) |
|
2755 |
finally show ?thesis . |
|
2756 |
qed |
|
2757 |
||
2758 |
lemma bl_shiftl1: |
|
2759 |
"to_bl (shiftl1 (w :: 'a :: len word)) = tl (to_bl w) @ [False]" |
|
2760 |
apply (simp add: shiftl1_bl word_rep_drop drop_Suc drop_Cons') |
|
2761 |
apply (fast intro!: Suc_leI) |
|
2762 |
done |
|
2763 |
||
45807 | 2764 |
(* Generalized version of bl_shiftl1. Maybe this one should replace it? *) |
2765 |
lemma bl_shiftl1': |
|
2766 |
"to_bl (shiftl1 w) = tl (to_bl w @ [False])" |
|
2767 |
unfolding shiftl1_bl |
|
2768 |
by (simp add: word_rep_drop drop_Suc del: drop_append) |
|
2769 |
||
37660 | 2770 |
lemma shiftr1_bl: "shiftr1 w = of_bl (butlast (to_bl w))" |
2771 |
apply (unfold shiftr1_def uint_bl of_bl_def) |
|
2772 |
apply (simp add: butlast_rest_bin word_size) |
|
2773 |
apply (simp add: bin_rest_trunc [symmetric, unfolded One_nat_def]) |
|
2774 |
done |
|
2775 |
||
2776 |
lemma bl_shiftr1: |
|
2777 |
"to_bl (shiftr1 (w :: 'a :: len word)) = False # butlast (to_bl w)" |
|
2778 |
unfolding shiftr1_bl |
|
2779 |
by (simp add : word_rep_drop len_gt_0 [THEN Suc_leI]) |
|
2780 |
||
45807 | 2781 |
(* Generalized version of bl_shiftr1. Maybe this one should replace it? *) |
2782 |
lemma bl_shiftr1': |
|
2783 |
"to_bl (shiftr1 w) = butlast (False # to_bl w)" |
|
2784 |
apply (rule word_bl.Abs_inverse') |
|
2785 |
apply (simp del: butlast.simps) |
|
2786 |
apply (simp add: shiftr1_bl of_bl_def) |
|
2787 |
done |
|
2788 |
||
37660 | 2789 |
lemma shiftl1_rev: |
45807 | 2790 |
"shiftl1 w = word_reverse (shiftr1 (word_reverse w))" |
37660 | 2791 |
apply (unfold word_reverse_def) |
2792 |
apply (rule word_bl.Rep_inverse' [symmetric]) |
|
45807 | 2793 |
apply (simp add: bl_shiftl1' bl_shiftr1' word_bl.Abs_inverse) |
37660 | 2794 |
apply (cases "to_bl w") |
2795 |
apply auto |
|
2796 |
done |
|
2797 |
||
2798 |
lemma shiftl_rev: |
|
45807 | 2799 |
"shiftl w n = word_reverse (shiftr (word_reverse w) n)" |
37660 | 2800 |
apply (unfold shiftl_def shiftr_def) |
2801 |
apply (induct "n") |
|
2802 |
apply (auto simp add : shiftl1_rev) |
|
2803 |
done |
|
2804 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2805 |
lemma rev_shiftl: "word_reverse w << n = word_reverse (w >> n)" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2806 |
by (simp add: shiftl_rev) |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2807 |
|
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2808 |
lemma shiftr_rev: "w >> n = word_reverse (word_reverse w << n)" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2809 |
by (simp add: rev_shiftl) |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2810 |
|
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2811 |
lemma rev_shiftr: "word_reverse w >> n = word_reverse (w << n)" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2812 |
by (simp add: shiftr_rev) |
37660 | 2813 |
|
2814 |
lemma bl_sshiftr1: |
|
2815 |
"to_bl (sshiftr1 (w :: 'a :: len word)) = hd (to_bl w) # butlast (to_bl w)" |
|
2816 |
apply (unfold sshiftr1_def uint_bl word_size) |
|
2817 |
apply (simp add: butlast_rest_bin word_ubin.eq_norm) |
|
2818 |
apply (simp add: sint_uint) |
|
2819 |
apply (rule nth_equalityI) |
|
2820 |
apply clarsimp |
|
2821 |
apply clarsimp |
|
2822 |
apply (case_tac i) |
|
2823 |
apply (simp_all add: hd_conv_nth length_0_conv [symmetric] |
|
2824 |
nth_bin_to_bl bin_nth.Suc [symmetric] |
|
2825 |
nth_sbintr |
|
2826 |
del: bin_nth.Suc) |
|
2827 |
apply force |
|
2828 |
apply (rule impI) |
|
2829 |
apply (rule_tac f = "bin_nth (uint w)" in arg_cong) |
|
2830 |
apply simp |
|
2831 |
done |
|
2832 |
||
2833 |
lemma drop_shiftr: |
|
2834 |
"drop n (to_bl ((w :: 'a :: len word) >> n)) = take (size w - n) (to_bl w)" |
|
2835 |
apply (unfold shiftr_def) |
|
2836 |
apply (induct n) |
|
2837 |
prefer 2 |
|
2838 |
apply (simp add: drop_Suc bl_shiftr1 butlast_drop [symmetric]) |
|
2839 |
apply (rule butlast_take [THEN trans]) |
|
2840 |
apply (auto simp: word_size) |
|
2841 |
done |
|
2842 |
||
2843 |
lemma drop_sshiftr: |
|
2844 |
"drop n (to_bl ((w :: 'a :: len word) >>> n)) = take (size w - n) (to_bl w)" |
|
2845 |
apply (unfold sshiftr_def) |
|
2846 |
apply (induct n) |
|
2847 |
prefer 2 |
|
2848 |
apply (simp add: drop_Suc bl_sshiftr1 butlast_drop [symmetric]) |
|
2849 |
apply (rule butlast_take [THEN trans]) |
|
2850 |
apply (auto simp: word_size) |
|
2851 |
done |
|
2852 |
||
45807 | 2853 |
lemma take_shiftr: |
2854 |
"n \<le> size w \<Longrightarrow> take n (to_bl (w >> n)) = replicate n False" |
|
37660 | 2855 |
apply (unfold shiftr_def) |
2856 |
apply (induct n) |
|
2857 |
prefer 2 |
|
45807 | 2858 |
apply (simp add: bl_shiftr1' length_0_conv [symmetric] word_size) |
37660 | 2859 |
apply (rule take_butlast [THEN trans]) |
2860 |
apply (auto simp: word_size) |
|
2861 |
done |
|
2862 |
||
2863 |
lemma take_sshiftr' [rule_format] : |
|
2864 |
"n <= size (w :: 'a :: len word) --> hd (to_bl (w >>> n)) = hd (to_bl w) & |
|
2865 |
take n (to_bl (w >>> n)) = replicate n (hd (to_bl w))" |
|
2866 |
apply (unfold sshiftr_def) |
|
2867 |
apply (induct n) |
|
2868 |
prefer 2 |
|
2869 |
apply (simp add: bl_sshiftr1) |
|
2870 |
apply (rule impI) |
|
2871 |
apply (rule take_butlast [THEN trans]) |
|
2872 |
apply (auto simp: word_size) |
|
2873 |
done |
|
2874 |
||
45604 | 2875 |
lemmas hd_sshiftr = take_sshiftr' [THEN conjunct1] |
2876 |
lemmas take_sshiftr = take_sshiftr' [THEN conjunct2] |
|
37660 | 2877 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2878 |
lemma atd_lem: "take n xs = t \<Longrightarrow> drop n xs = d \<Longrightarrow> xs = t @ d" |
37660 | 2879 |
by (auto intro: append_take_drop_id [symmetric]) |
2880 |
||
2881 |
lemmas bl_shiftr = atd_lem [OF take_shiftr drop_shiftr] |
|
2882 |
lemmas bl_sshiftr = atd_lem [OF take_sshiftr drop_sshiftr] |
|
2883 |
||
2884 |
lemma shiftl_of_bl: "of_bl bl << n = of_bl (bl @ replicate n False)" |
|
2885 |
unfolding shiftl_def |
|
2886 |
by (induct n) (auto simp: shiftl1_of_bl replicate_app_Cons_same) |
|
2887 |
||
2888 |
lemma shiftl_bl: |
|
2889 |
"(w::'a::len0 word) << (n::nat) = of_bl (to_bl w @ replicate n False)" |
|
2890 |
proof - |
|
2891 |
have "w << n = of_bl (to_bl w) << n" by simp |
|
2892 |
also have "\<dots> = of_bl (to_bl w @ replicate n False)" by (rule shiftl_of_bl) |
|
2893 |
finally show ?thesis . |
|
2894 |
qed |
|
2895 |
||
45604 | 2896 |
lemmas shiftl_number [simp] = shiftl_def [where w="number_of w"] for w |
37660 | 2897 |
|
2898 |
lemma bl_shiftl: |
|
2899 |
"to_bl (w << n) = drop n (to_bl w) @ replicate (min (size w) n) False" |
|
2900 |
by (simp add: shiftl_bl word_rep_drop word_size) |
|
2901 |
||
2902 |
lemma shiftl_zero_size: |
|
2903 |
fixes x :: "'a::len0 word" |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2904 |
shows "size x <= n \<Longrightarrow> x << n = 0" |
37660 | 2905 |
apply (unfold word_size) |
2906 |
apply (rule word_eqI) |
|
2907 |
apply (clarsimp simp add: shiftl_bl word_size test_bit_of_bl nth_append) |
|
2908 |
done |
|
2909 |
||
2910 |
(* note - the following results use 'a :: len word < number_ring *) |
|
2911 |
||
2912 |
lemma shiftl1_2t: "shiftl1 (w :: 'a :: len word) = 2 * w" |
|
45847 | 2913 |
apply (simp add: shiftl1_def_u BIT_simps) |
37660 | 2914 |
apply (simp only: double_number_of_Bit0 [symmetric]) |
2915 |
apply simp |
|
2916 |
done |
|
2917 |
||
2918 |
lemma shiftl1_p: "shiftl1 (w :: 'a :: len word) = w + w" |
|
45847 | 2919 |
apply (simp add: shiftl1_def_u BIT_simps) |
37660 | 2920 |
apply (simp only: double_number_of_Bit0 [symmetric]) |
2921 |
apply simp |
|
2922 |
done |
|
2923 |
||
2924 |
lemma shiftl_t2n: "shiftl (w :: 'a :: len word) n = 2 ^ n * w" |
|
2925 |
unfolding shiftl_def |
|
41550 | 2926 |
by (induct n) (auto simp: shiftl1_2t) |
37660 | 2927 |
|
2928 |
lemma shiftr1_bintr [simp]: |
|
2929 |
"(shiftr1 (number_of w) :: 'a :: len0 word) = |
|
2930 |
number_of (bin_rest (bintrunc (len_of TYPE ('a)) w))" |
|
2931 |
unfolding shiftr1_def word_number_of_def |
|
2932 |
by (simp add : word_ubin.eq_norm) |
|
2933 |
||
2934 |
lemma sshiftr1_sbintr [simp] : |
|
2935 |
"(sshiftr1 (number_of w) :: 'a :: len word) = |
|
2936 |
number_of (bin_rest (sbintrunc (len_of TYPE ('a) - 1) w))" |
|
2937 |
unfolding sshiftr1_def word_number_of_def |
|
2938 |
by (simp add : word_sbin.eq_norm) |
|
2939 |
||
2940 |
lemma shiftr_no': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2941 |
"w = number_of bin \<Longrightarrow> |
37660 | 2942 |
(w::'a::len0 word) >> n = number_of ((bin_rest ^^ n) (bintrunc (size w) bin))" |
2943 |
apply clarsimp |
|
2944 |
apply (rule word_eqI) |
|
2945 |
apply (auto simp: nth_shiftr nth_rest_power_bin nth_bintr word_size) |
|
2946 |
done |
|
2947 |
||
2948 |
lemma sshiftr_no': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
2949 |
"w = number_of bin \<Longrightarrow> w >>> n = number_of ((bin_rest ^^ n) |
37660 | 2950 |
(sbintrunc (size w - 1) bin))" |
2951 |
apply clarsimp |
|
2952 |
apply (rule word_eqI) |
|
2953 |
apply (auto simp: nth_sshiftr nth_rest_power_bin nth_sbintr word_size) |
|
2954 |
apply (subgoal_tac "na + n = len_of TYPE('a) - Suc 0", simp, simp)+ |
|
2955 |
done |
|
2956 |
||
2957 |
lemmas sshiftr_no [simp] = |
|
45604 | 2958 |
sshiftr_no' [where w = "number_of w", OF refl, unfolded word_size] for w |
37660 | 2959 |
|
2960 |
lemmas shiftr_no [simp] = |
|
45604 | 2961 |
shiftr_no' [where w = "number_of w", OF refl, unfolded word_size] for w |
37660 | 2962 |
|
45811 | 2963 |
lemma shiftr1_bl_of: |
2964 |
"length bl \<le> len_of TYPE('a) \<Longrightarrow> |
|
2965 |
shiftr1 (of_bl bl::'a::len0 word) = of_bl (butlast bl)" |
|
2966 |
by (clarsimp simp: shiftr1_def of_bl_def butlast_rest_bl2bin |
|
37660 | 2967 |
word_ubin.eq_norm trunc_bl2bin) |
2968 |
||
45811 | 2969 |
lemma shiftr_bl_of: |
2970 |
"length bl \<le> len_of TYPE('a) \<Longrightarrow> |
|
2971 |
(of_bl bl::'a::len0 word) >> n = of_bl (take (length bl - n) bl)" |
|
37660 | 2972 |
apply (unfold shiftr_def) |
2973 |
apply (induct n) |
|
2974 |
apply clarsimp |
|
2975 |
apply clarsimp |
|
2976 |
apply (subst shiftr1_bl_of) |
|
2977 |
apply simp |
|
2978 |
apply (simp add: butlast_take) |
|
2979 |
done |
|
2980 |
||
45811 | 2981 |
lemma shiftr_bl: |
2982 |
"(x::'a::len0 word) >> n \<equiv> of_bl (take (len_of TYPE('a) - n) (to_bl x))" |
|
2983 |
using shiftr_bl_of [where 'a='a, of "to_bl x"] by simp |
|
2984 |
||
2985 |
lemma msb_shift: |
|
2986 |
"msb (w::'a::len word) \<longleftrightarrow> (w >> (len_of TYPE('a) - 1)) \<noteq> 0" |
|
37660 | 2987 |
apply (unfold shiftr_bl word_msb_alt) |
2988 |
apply (simp add: word_size Suc_le_eq take_Suc) |
|
2989 |
apply (cases "hd (to_bl w)") |
|
45805 | 2990 |
apply (auto simp: word_1_bl |
37660 | 2991 |
of_bl_rep_False [where n=1 and bs="[]", simplified]) |
2992 |
done |
|
2993 |
||
2994 |
lemma align_lem_or [rule_format] : |
|
2995 |
"ALL x m. length x = n + m --> length y = n + m --> |
|
2996 |
drop m x = replicate n False --> take m y = replicate m False --> |
|
2997 |
map2 op | x y = take m x @ drop m y" |
|
2998 |
apply (induct_tac y) |
|
2999 |
apply force |
|
3000 |
apply clarsimp |
|
3001 |
apply (case_tac x, force) |
|
3002 |
apply (case_tac m, auto) |
|
3003 |
apply (drule sym) |
|
3004 |
apply auto |
|
3005 |
apply (induct_tac list, auto) |
|
3006 |
done |
|
3007 |
||
3008 |
lemma align_lem_and [rule_format] : |
|
3009 |
"ALL x m. length x = n + m --> length y = n + m --> |
|
3010 |
drop m x = replicate n False --> take m y = replicate m False --> |
|
3011 |
map2 op & x y = replicate (n + m) False" |
|
3012 |
apply (induct_tac y) |
|
3013 |
apply force |
|
3014 |
apply clarsimp |
|
3015 |
apply (case_tac x, force) |
|
3016 |
apply (case_tac m, auto) |
|
3017 |
apply (drule sym) |
|
3018 |
apply auto |
|
3019 |
apply (induct_tac list, auto) |
|
3020 |
done |
|
3021 |
||
45811 | 3022 |
lemma aligned_bl_add_size [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3023 |
"size x - n = m \<Longrightarrow> n <= size x \<Longrightarrow> drop m (to_bl x) = replicate n False \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3024 |
take m (to_bl y) = replicate m False \<Longrightarrow> |
37660 | 3025 |
to_bl (x + y) = take m (to_bl x) @ drop m (to_bl y)" |
3026 |
apply (subgoal_tac "x AND y = 0") |
|
3027 |
prefer 2 |
|
3028 |
apply (rule word_bl.Rep_eqD) |
|
45805 | 3029 |
apply (simp add: bl_word_and) |
37660 | 3030 |
apply (rule align_lem_and [THEN trans]) |
3031 |
apply (simp_all add: word_size)[5] |
|
3032 |
apply simp |
|
3033 |
apply (subst word_plus_and_or [symmetric]) |
|
3034 |
apply (simp add : bl_word_or) |
|
3035 |
apply (rule align_lem_or) |
|
3036 |
apply (simp_all add: word_size) |
|
3037 |
done |
|
3038 |
||
3039 |
subsubsection "Mask" |
|
3040 |
||
45811 | 3041 |
lemma nth_mask [OF refl, simp]: |
3042 |
"m = mask n \<Longrightarrow> test_bit m i = (i < n & i < size m)" |
|
37660 | 3043 |
apply (unfold mask_def test_bit_bl) |
3044 |
apply (simp only: word_1_bl [symmetric] shiftl_of_bl) |
|
3045 |
apply (clarsimp simp add: word_size) |
|
3046 |
apply (simp only: of_bl_no mask_lem number_of_succ add_diff_cancel2) |
|
3047 |
apply (fold of_bl_no) |
|
3048 |
apply (simp add: word_1_bl) |
|
3049 |
apply (rule test_bit_of_bl [THEN trans, unfolded test_bit_bl word_size]) |
|
3050 |
apply auto |
|
3051 |
done |
|
3052 |
||
3053 |
lemma mask_bl: "mask n = of_bl (replicate n True)" |
|
3054 |
by (auto simp add : test_bit_of_bl word_size intro: word_eqI) |
|
3055 |
||
3056 |
lemma mask_bin: "mask n = number_of (bintrunc n Int.Min)" |
|
3057 |
by (auto simp add: nth_bintr word_size intro: word_eqI) |
|
3058 |
||
3059 |
lemma and_mask_bintr: "w AND mask n = number_of (bintrunc n (uint w))" |
|
3060 |
apply (rule word_eqI) |
|
3061 |
apply (simp add: nth_bintr word_size word_ops_nth_size) |
|
3062 |
apply (auto simp add: test_bit_bin) |
|
3063 |
done |
|
3064 |
||
3065 |
lemma and_mask_no: "number_of i AND mask n = number_of (bintrunc n i)" |
|
3066 |
by (auto simp add : nth_bintr word_size word_ops_nth_size intro: word_eqI) |
|
3067 |
||
45811 | 3068 |
lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (bintrunc n i)" |
3069 |
by (fact and_mask_no [unfolded word_number_of_def]) |
|
37660 | 3070 |
|
3071 |
lemma bl_and_mask': |
|
3072 |
"to_bl (w AND mask n :: 'a :: len word) = |
|
3073 |
replicate (len_of TYPE('a) - n) False @ |
|
3074 |
drop (len_of TYPE('a) - n) (to_bl w)" |
|
3075 |
apply (rule nth_equalityI) |
|
3076 |
apply simp |
|
3077 |
apply (clarsimp simp add: to_bl_nth word_size) |
|
3078 |
apply (simp add: word_size word_ops_nth_size) |
|
3079 |
apply (auto simp add: word_size test_bit_bl nth_append nth_rev) |
|
3080 |
done |
|
3081 |
||
45811 | 3082 |
lemma and_mask_mod_2p: "w AND mask n = word_of_int (uint w mod 2 ^ n)" |
3083 |
by (fact and_mask_bintr [unfolded word_number_of_alt no_bintr_alt]) |
|
37660 | 3084 |
|
3085 |
lemma and_mask_lt_2p: "uint (w AND mask n) < 2 ^ n" |
|
3086 |
apply (simp add : and_mask_bintr no_bintr_alt) |
|
3087 |
apply (rule xtr8) |
|
3088 |
prefer 2 |
|
3089 |
apply (rule pos_mod_bound) |
|
3090 |
apply auto |
|
3091 |
done |
|
3092 |
||
45811 | 3093 |
lemma eq_mod_iff: "0 < (n::int) \<Longrightarrow> b = b mod n \<longleftrightarrow> 0 \<le> b \<and> b < n" |
3094 |
by (simp add: int_mod_lem eq_sym_conv) |
|
37660 | 3095 |
|
3096 |
lemma mask_eq_iff: "(w AND mask n) = w <-> uint w < 2 ^ n" |
|
3097 |
apply (simp add: and_mask_bintr word_number_of_def) |
|
3098 |
apply (simp add: word_ubin.inverse_norm) |
|
3099 |
apply (simp add: eq_mod_iff bintrunc_mod2p min_def) |
|
3100 |
apply (fast intro!: lt2p_lem) |
|
3101 |
done |
|
3102 |
||
3103 |
lemma and_mask_dvd: "2 ^ n dvd uint w = (w AND mask n = 0)" |
|
3104 |
apply (simp add: dvd_eq_mod_eq_0 and_mask_mod_2p) |
|
3105 |
apply (simp add: word_uint.norm_eq_iff [symmetric] word_of_int_homs) |
|
3106 |
apply (subst word_uint.norm_Rep [symmetric]) |
|
3107 |
apply (simp only: bintrunc_bintrunc_min bintrunc_mod2p [symmetric] min_def) |
|
3108 |
apply auto |
|
3109 |
done |
|
3110 |
||
3111 |
lemma and_mask_dvd_nat: "2 ^ n dvd unat w = (w AND mask n = 0)" |
|
3112 |
apply (unfold unat_def) |
|
3113 |
apply (rule trans [OF _ and_mask_dvd]) |
|
3114 |
apply (unfold dvd_def) |
|
3115 |
apply auto |
|
3116 |
apply (drule uint_ge_0 [THEN nat_int.Abs_inverse' [simplified], symmetric]) |
|
3117 |
apply (simp add : int_mult int_power) |
|
3118 |
apply (simp add : nat_mult_distrib nat_power_eq) |
|
3119 |
done |
|
3120 |
||
3121 |
lemma word_2p_lem: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3122 |
"n < size w \<Longrightarrow> w < 2 ^ n = (uint (w :: 'a :: len word) < 2 ^ n)" |
37660 | 3123 |
apply (unfold word_size word_less_alt word_number_of_alt) |
3124 |
apply (clarsimp simp add: word_of_int_power_hom word_uint.eq_norm |
|
3125 |
int_mod_eq' |
|
3126 |
simp del: word_of_int_bin) |
|
3127 |
done |
|
3128 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3129 |
lemma less_mask_eq: "x < 2 ^ n \<Longrightarrow> x AND mask n = (x :: 'a :: len word)" |
37660 | 3130 |
apply (unfold word_less_alt word_number_of_alt) |
3131 |
apply (clarsimp simp add: and_mask_mod_2p word_of_int_power_hom |
|
3132 |
word_uint.eq_norm |
|
3133 |
simp del: word_of_int_bin) |
|
3134 |
apply (drule xtr8 [rotated]) |
|
3135 |
apply (rule int_mod_le) |
|
3136 |
apply (auto simp add : mod_pos_pos_trivial) |
|
3137 |
done |
|
3138 |
||
45604 | 3139 |
lemmas mask_eq_iff_w2p = trans [OF mask_eq_iff word_2p_lem [symmetric]] |
3140 |
||
3141 |
lemmas and_mask_less' = iffD2 [OF word_2p_lem and_mask_lt_2p, simplified word_size] |
|
37660 | 3142 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3143 |
lemma and_mask_less_size: "n < size x \<Longrightarrow> x AND mask n < 2^n" |
37660 | 3144 |
unfolding word_size by (erule and_mask_less') |
3145 |
||
45811 | 3146 |
lemma word_mod_2p_is_mask [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3147 |
"c = 2 ^ n \<Longrightarrow> c > 0 \<Longrightarrow> x mod c = (x :: 'a :: len word) AND mask n" |
37660 | 3148 |
by (clarsimp simp add: word_mod_def uint_2p and_mask_mod_2p) |
3149 |
||
3150 |
lemma mask_eqs: |
|
3151 |
"(a AND mask n) + b AND mask n = a + b AND mask n" |
|
3152 |
"a + (b AND mask n) AND mask n = a + b AND mask n" |
|
3153 |
"(a AND mask n) - b AND mask n = a - b AND mask n" |
|
3154 |
"a - (b AND mask n) AND mask n = a - b AND mask n" |
|
3155 |
"a * (b AND mask n) AND mask n = a * b AND mask n" |
|
3156 |
"(b AND mask n) * a AND mask n = b * a AND mask n" |
|
3157 |
"(a AND mask n) + (b AND mask n) AND mask n = a + b AND mask n" |
|
3158 |
"(a AND mask n) - (b AND mask n) AND mask n = a - b AND mask n" |
|
3159 |
"(a AND mask n) * (b AND mask n) AND mask n = a * b AND mask n" |
|
3160 |
"- (a AND mask n) AND mask n = - a AND mask n" |
|
3161 |
"word_succ (a AND mask n) AND mask n = word_succ a AND mask n" |
|
3162 |
"word_pred (a AND mask n) AND mask n = word_pred a AND mask n" |
|
3163 |
using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b] |
|
3164 |
by (auto simp: and_mask_wi bintr_ariths bintr_arith1s new_word_of_int_homs) |
|
3165 |
||
3166 |
lemma mask_power_eq: |
|
3167 |
"(x AND mask n) ^ k AND mask n = x ^ k AND mask n" |
|
3168 |
using word_of_int_Ex [where x=x] |
|
3169 |
by (clarsimp simp: and_mask_wi word_of_int_power_hom bintr_ariths) |
|
3170 |
||
3171 |
||
3172 |
subsubsection "Revcast" |
|
3173 |
||
3174 |
lemmas revcast_def' = revcast_def [simplified] |
|
3175 |
lemmas revcast_def'' = revcast_def' [simplified word_size] |
|
45604 | 3176 |
lemmas revcast_no_def [simp] = revcast_def' [where w="number_of w", unfolded word_size] for w |
37660 | 3177 |
|
3178 |
lemma to_bl_revcast: |
|
3179 |
"to_bl (revcast w :: 'a :: len0 word) = |
|
3180 |
takefill False (len_of TYPE ('a)) (to_bl w)" |
|
3181 |
apply (unfold revcast_def' word_size) |
|
3182 |
apply (rule word_bl.Abs_inverse) |
|
3183 |
apply simp |
|
3184 |
done |
|
3185 |
||
45811 | 3186 |
lemma revcast_rev_ucast [OF refl refl refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3187 |
"cs = [rc, uc] \<Longrightarrow> rc = revcast (word_reverse w) \<Longrightarrow> uc = ucast w \<Longrightarrow> |
37660 | 3188 |
rc = word_reverse uc" |
3189 |
apply (unfold ucast_def revcast_def' Let_def word_reverse_def) |
|
3190 |
apply (clarsimp simp add : to_bl_of_bin takefill_bintrunc) |
|
3191 |
apply (simp add : word_bl.Abs_inverse word_size) |
|
3192 |
done |
|
3193 |
||
45811 | 3194 |
lemma revcast_ucast: "revcast w = word_reverse (ucast (word_reverse w))" |
3195 |
using revcast_rev_ucast [of "word_reverse w"] by simp |
|
3196 |
||
3197 |
lemma ucast_revcast: "ucast w = word_reverse (revcast (word_reverse w))" |
|
3198 |
by (fact revcast_rev_ucast [THEN word_rev_gal']) |
|
3199 |
||
3200 |
lemma ucast_rev_revcast: "ucast (word_reverse w) = word_reverse (revcast w)" |
|
3201 |
by (fact revcast_ucast [THEN word_rev_gal']) |
|
37660 | 3202 |
|
3203 |
||
3204 |
-- "linking revcast and cast via shift" |
|
3205 |
||
3206 |
lemmas wsst_TYs = source_size target_size word_size |
|
3207 |
||
45811 | 3208 |
lemma revcast_down_uu [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3209 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> |
37660 | 3210 |
rc (w :: 'a :: len word) = ucast (w >> n)" |
3211 |
apply (simp add: revcast_def') |
|
3212 |
apply (rule word_bl.Rep_inverse') |
|
3213 |
apply (rule trans, rule ucast_down_drop) |
|
3214 |
prefer 2 |
|
3215 |
apply (rule trans, rule drop_shiftr) |
|
3216 |
apply (auto simp: takefill_alt wsst_TYs) |
|
3217 |
done |
|
3218 |
||
45811 | 3219 |
lemma revcast_down_us [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3220 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> |
37660 | 3221 |
rc (w :: 'a :: len word) = ucast (w >>> n)" |
3222 |
apply (simp add: revcast_def') |
|
3223 |
apply (rule word_bl.Rep_inverse') |
|
3224 |
apply (rule trans, rule ucast_down_drop) |
|
3225 |
prefer 2 |
|
3226 |
apply (rule trans, rule drop_sshiftr) |
|
3227 |
apply (auto simp: takefill_alt wsst_TYs) |
|
3228 |
done |
|
3229 |
||
45811 | 3230 |
lemma revcast_down_su [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3231 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> |
37660 | 3232 |
rc (w :: 'a :: len word) = scast (w >> n)" |
3233 |
apply (simp add: revcast_def') |
|
3234 |
apply (rule word_bl.Rep_inverse') |
|
3235 |
apply (rule trans, rule scast_down_drop) |
|
3236 |
prefer 2 |
|
3237 |
apply (rule trans, rule drop_shiftr) |
|
3238 |
apply (auto simp: takefill_alt wsst_TYs) |
|
3239 |
done |
|
3240 |
||
45811 | 3241 |
lemma revcast_down_ss [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3242 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> |
37660 | 3243 |
rc (w :: 'a :: len word) = scast (w >>> n)" |
3244 |
apply (simp add: revcast_def') |
|
3245 |
apply (rule word_bl.Rep_inverse') |
|
3246 |
apply (rule trans, rule scast_down_drop) |
|
3247 |
prefer 2 |
|
3248 |
apply (rule trans, rule drop_sshiftr) |
|
3249 |
apply (auto simp: takefill_alt wsst_TYs) |
|
3250 |
done |
|
3251 |
||
45811 | 3252 |
(* FIXME: should this also be [OF refl] ? *) |
37660 | 3253 |
lemma cast_down_rev: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3254 |
"uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> |
37660 | 3255 |
uc w = revcast ((w :: 'a :: len word) << n)" |
3256 |
apply (unfold shiftl_rev) |
|
3257 |
apply clarify |
|
3258 |
apply (simp add: revcast_rev_ucast) |
|
3259 |
apply (rule word_rev_gal') |
|
3260 |
apply (rule trans [OF _ revcast_rev_ucast]) |
|
3261 |
apply (rule revcast_down_uu [symmetric]) |
|
3262 |
apply (auto simp add: wsst_TYs) |
|
3263 |
done |
|
3264 |
||
45811 | 3265 |
lemma revcast_up [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3266 |
"rc = revcast \<Longrightarrow> source_size rc + n = target_size rc \<Longrightarrow> |
37660 | 3267 |
rc w = (ucast w :: 'a :: len word) << n" |
3268 |
apply (simp add: revcast_def') |
|
3269 |
apply (rule word_bl.Rep_inverse') |
|
3270 |
apply (simp add: takefill_alt) |
|
3271 |
apply (rule bl_shiftl [THEN trans]) |
|
3272 |
apply (subst ucast_up_app) |
|
3273 |
apply (auto simp add: wsst_TYs) |
|
3274 |
done |
|
3275 |
||
3276 |
lemmas rc1 = revcast_up [THEN |
|
3277 |
revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]] |
|
3278 |
lemmas rc2 = revcast_down_uu [THEN |
|
3279 |
revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]] |
|
3280 |
||
3281 |
lemmas ucast_up = |
|
3282 |
rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]] |
|
3283 |
lemmas ucast_down = |
|
3284 |
rc2 [simplified rev_shiftr revcast_ucast [symmetric]] |
|
3285 |
||
3286 |
||
3287 |
subsubsection "Slices" |
|
3288 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3289 |
lemma slice1_no_bin [simp]: |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3290 |
"slice1 n (number_of w :: 'b word) = of_bl (takefill False n (bin_to_bl (len_of TYPE('b :: len0)) w))" |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3291 |
by (simp add: slice1_def) |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3292 |
|
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3293 |
lemma slice_no_bin [simp]: |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3294 |
"slice n (number_of w :: 'b word) = of_bl (takefill False (len_of TYPE('b :: len0) - n) |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3295 |
(bin_to_bl (len_of TYPE('b :: len0)) w))" |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3296 |
by (simp add: slice_def word_size) |
37660 | 3297 |
|
3298 |
lemma slice1_0 [simp] : "slice1 n 0 = 0" |
|
45805 | 3299 |
unfolding slice1_def by simp |
37660 | 3300 |
|
3301 |
lemma slice_0 [simp] : "slice n 0 = 0" |
|
3302 |
unfolding slice_def by auto |
|
3303 |
||
3304 |
lemma slice_take': "slice n w = of_bl (take (size w - n) (to_bl w))" |
|
3305 |
unfolding slice_def' slice1_def |
|
3306 |
by (simp add : takefill_alt word_size) |
|
3307 |
||
3308 |
lemmas slice_take = slice_take' [unfolded word_size] |
|
3309 |
||
3310 |
-- "shiftr to a word of the same size is just slice, |
|
3311 |
slice is just shiftr then ucast" |
|
45604 | 3312 |
lemmas shiftr_slice = trans [OF shiftr_bl [THEN meta_eq_to_obj_eq] slice_take [symmetric]] |
37660 | 3313 |
|
3314 |
lemma slice_shiftr: "slice n w = ucast (w >> n)" |
|
3315 |
apply (unfold slice_take shiftr_bl) |
|
3316 |
apply (rule ucast_of_bl_up [symmetric]) |
|
3317 |
apply (simp add: word_size) |
|
3318 |
done |
|
3319 |
||
3320 |
lemma nth_slice: |
|
3321 |
"(slice n w :: 'a :: len0 word) !! m = |
|
3322 |
(w !! (m + n) & m < len_of TYPE ('a))" |
|
3323 |
unfolding slice_shiftr |
|
3324 |
by (simp add : nth_ucast nth_shiftr) |
|
3325 |
||
3326 |
lemma slice1_down_alt': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3327 |
"sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs + k = n \<Longrightarrow> |
37660 | 3328 |
to_bl sl = takefill False fs (drop k (to_bl w))" |
3329 |
unfolding slice1_def word_size of_bl_def uint_bl |
|
3330 |
by (clarsimp simp: word_ubin.eq_norm bl_bin_bl_rep_drop drop_takefill) |
|
3331 |
||
3332 |
lemma slice1_up_alt': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3333 |
"sl = slice1 n w \<Longrightarrow> fs = size sl \<Longrightarrow> fs = n + k \<Longrightarrow> |
37660 | 3334 |
to_bl sl = takefill False fs (replicate k False @ (to_bl w))" |
3335 |
apply (unfold slice1_def word_size of_bl_def uint_bl) |
|
3336 |
apply (clarsimp simp: word_ubin.eq_norm bl_bin_bl_rep_drop |
|
3337 |
takefill_append [symmetric]) |
|
3338 |
apply (rule_tac f = "%k. takefill False (len_of TYPE('a)) |
|
3339 |
(replicate k False @ bin_to_bl (len_of TYPE('b)) (uint w))" in arg_cong) |
|
3340 |
apply arith |
|
3341 |
done |
|
3342 |
||
3343 |
lemmas sd1 = slice1_down_alt' [OF refl refl, unfolded word_size] |
|
3344 |
lemmas su1 = slice1_up_alt' [OF refl refl, unfolded word_size] |
|
3345 |
lemmas slice1_down_alt = le_add_diff_inverse [THEN sd1] |
|
3346 |
lemmas slice1_up_alts = |
|
3347 |
le_add_diff_inverse [symmetric, THEN su1] |
|
3348 |
le_add_diff_inverse2 [symmetric, THEN su1] |
|
3349 |
||
3350 |
lemma ucast_slice1: "ucast w = slice1 (size w) w" |
|
3351 |
unfolding slice1_def ucast_bl |
|
3352 |
by (simp add : takefill_same' word_size) |
|
3353 |
||
3354 |
lemma ucast_slice: "ucast w = slice 0 w" |
|
3355 |
unfolding slice_def by (simp add : ucast_slice1) |
|
3356 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3357 |
lemma slice_id: "slice 0 t = t" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3358 |
by (simp only: ucast_slice [symmetric] ucast_id) |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3359 |
|
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3360 |
lemma revcast_slice1 [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3361 |
"rc = revcast w \<Longrightarrow> slice1 (size rc) w = rc" |
37660 | 3362 |
unfolding slice1_def revcast_def' by (simp add : word_size) |
3363 |
||
3364 |
lemma slice1_tf_tf': |
|
3365 |
"to_bl (slice1 n w :: 'a :: len0 word) = |
|
3366 |
rev (takefill False (len_of TYPE('a)) (rev (takefill False n (to_bl w))))" |
|
3367 |
unfolding slice1_def by (rule word_rev_tf) |
|
3368 |
||
45604 | 3369 |
lemmas slice1_tf_tf = slice1_tf_tf' [THEN word_bl.Rep_inverse', symmetric] |
37660 | 3370 |
|
3371 |
lemma rev_slice1: |
|
3372 |
"n + k = len_of TYPE('a) + len_of TYPE('b) \<Longrightarrow> |
|
3373 |
slice1 n (word_reverse w :: 'b :: len0 word) = |
|
3374 |
word_reverse (slice1 k w :: 'a :: len0 word)" |
|
3375 |
apply (unfold word_reverse_def slice1_tf_tf) |
|
3376 |
apply (rule word_bl.Rep_inverse') |
|
3377 |
apply (rule rev_swap [THEN iffD1]) |
|
3378 |
apply (rule trans [symmetric]) |
|
3379 |
apply (rule tf_rev) |
|
3380 |
apply (simp add: word_bl.Abs_inverse) |
|
3381 |
apply (simp add: word_bl.Abs_inverse) |
|
3382 |
done |
|
3383 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3384 |
lemma rev_slice: |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3385 |
"n + k + len_of TYPE('a::len0) = len_of TYPE('b::len0) \<Longrightarrow> |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3386 |
slice n (word_reverse (w::'b word)) = word_reverse (slice k w::'a word)" |
37660 | 3387 |
apply (unfold slice_def word_size) |
3388 |
apply (rule rev_slice1) |
|
3389 |
apply arith |
|
3390 |
done |
|
3391 |
||
3392 |
lemmas sym_notr = |
|
3393 |
not_iff [THEN iffD2, THEN not_sym, THEN not_iff [THEN iffD1]] |
|
3394 |
||
3395 |
-- {* problem posed by TPHOLs referee: |
|
3396 |
criterion for overflow of addition of signed integers *} |
|
3397 |
||
3398 |
lemma sofl_test: |
|
3399 |
"(sint (x :: 'a :: len word) + sint y = sint (x + y)) = |
|
3400 |
((((x+y) XOR x) AND ((x+y) XOR y)) >> (size x - 1) = 0)" |
|
3401 |
apply (unfold word_size) |
|
3402 |
apply (cases "len_of TYPE('a)", simp) |
|
3403 |
apply (subst msb_shift [THEN sym_notr]) |
|
3404 |
apply (simp add: word_ops_msb) |
|
3405 |
apply (simp add: word_msb_sint) |
|
3406 |
apply safe |
|
3407 |
apply simp_all |
|
3408 |
apply (unfold sint_word_ariths) |
|
3409 |
apply (unfold word_sbin.set_iff_norm [symmetric] sints_num) |
|
3410 |
apply safe |
|
3411 |
apply (insert sint_range' [where x=x]) |
|
3412 |
apply (insert sint_range' [where x=y]) |
|
3413 |
defer |
|
3414 |
apply (simp (no_asm), arith) |
|
3415 |
apply (simp (no_asm), arith) |
|
3416 |
defer |
|
3417 |
defer |
|
3418 |
apply (simp (no_asm), arith) |
|
3419 |
apply (simp (no_asm), arith) |
|
3420 |
apply (rule notI [THEN notnotD], |
|
3421 |
drule leI not_leE, |
|
3422 |
drule sbintrunc_inc sbintrunc_dec, |
|
3423 |
simp)+ |
|
3424 |
done |
|
3425 |
||
3426 |
||
3427 |
subsection "Split and cat" |
|
3428 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3429 |
lemmas word_split_bin' = word_split_def |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3430 |
lemmas word_cat_bin' = word_cat_def |
37660 | 3431 |
|
3432 |
lemma word_rsplit_no: |
|
3433 |
"(word_rsplit (number_of bin :: 'b :: len0 word) :: 'a word list) = |
|
3434 |
map number_of (bin_rsplit (len_of TYPE('a :: len)) |
|
3435 |
(len_of TYPE('b), bintrunc (len_of TYPE('b)) bin))" |
|
3436 |
apply (unfold word_rsplit_def word_no_wi) |
|
3437 |
apply (simp add: word_ubin.eq_norm) |
|
3438 |
done |
|
3439 |
||
3440 |
lemmas word_rsplit_no_cl [simp] = word_rsplit_no |
|
3441 |
[unfolded bin_rsplitl_def bin_rsplit_l [symmetric]] |
|
3442 |
||
3443 |
lemma test_bit_cat: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3444 |
"wc = word_cat a b \<Longrightarrow> wc !! n = (n < size wc & |
37660 | 3445 |
(if n < size b then b !! n else a !! (n - size b)))" |
3446 |
apply (unfold word_cat_bin' test_bit_bin) |
|
3447 |
apply (auto simp add : word_ubin.eq_norm nth_bintr bin_nth_cat word_size) |
|
3448 |
apply (erule bin_nth_uint_imp) |
|
3449 |
done |
|
3450 |
||
3451 |
lemma word_cat_bl: "word_cat a b = of_bl (to_bl a @ to_bl b)" |
|
3452 |
apply (unfold of_bl_def to_bl_def word_cat_bin') |
|
3453 |
apply (simp add: bl_to_bin_app_cat) |
|
3454 |
done |
|
3455 |
||
3456 |
lemma of_bl_append: |
|
3457 |
"(of_bl (xs @ ys) :: 'a :: len word) = of_bl xs * 2^(length ys) + of_bl ys" |
|
3458 |
apply (unfold of_bl_def) |
|
3459 |
apply (simp add: bl_to_bin_app_cat bin_cat_num) |
|
3460 |
apply (simp add: word_of_int_power_hom [symmetric] new_word_of_int_hom_syms) |
|
3461 |
done |
|
3462 |
||
3463 |
lemma of_bl_False [simp]: |
|
3464 |
"of_bl (False#xs) = of_bl xs" |
|
3465 |
by (rule word_eqI) |
|
3466 |
(auto simp add: test_bit_of_bl nth_append) |
|
3467 |
||
45805 | 3468 |
lemma of_bl_True [simp]: |
37660 | 3469 |
"(of_bl (True#xs)::'a::len word) = 2^length xs + of_bl xs" |
3470 |
by (subst of_bl_append [where xs="[True]", simplified]) |
|
3471 |
(simp add: word_1_bl) |
|
3472 |
||
3473 |
lemma of_bl_Cons: |
|
3474 |
"of_bl (x#xs) = of_bool x * 2^length xs + of_bl xs" |
|
45805 | 3475 |
by (cases x) simp_all |
37660 | 3476 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3477 |
lemma split_uint_lem: "bin_split n (uint (w :: 'a :: len0 word)) = (a, b) \<Longrightarrow> |
37660 | 3478 |
a = bintrunc (len_of TYPE('a) - n) a & b = bintrunc (len_of TYPE('a)) b" |
3479 |
apply (frule word_ubin.norm_Rep [THEN ssubst]) |
|
3480 |
apply (drule bin_split_trunc1) |
|
3481 |
apply (drule sym [THEN trans]) |
|
3482 |
apply assumption |
|
3483 |
apply safe |
|
3484 |
done |
|
3485 |
||
3486 |
lemma word_split_bl': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3487 |
"std = size c - size b \<Longrightarrow> (word_split c = (a, b)) \<Longrightarrow> |
37660 | 3488 |
(a = of_bl (take std (to_bl c)) & b = of_bl (drop std (to_bl c)))" |
3489 |
apply (unfold word_split_bin') |
|
3490 |
apply safe |
|
3491 |
defer |
|
3492 |
apply (clarsimp split: prod.splits) |
|
3493 |
apply (drule word_ubin.norm_Rep [THEN ssubst]) |
|
3494 |
apply (drule split_bintrunc) |
|
3495 |
apply (simp add : of_bl_def bl2bin_drop word_size |
|
3496 |
word_ubin.norm_eq_iff [symmetric] min_def del : word_ubin.norm_Rep) |
|
3497 |
apply (clarsimp split: prod.splits) |
|
3498 |
apply (frule split_uint_lem [THEN conjunct1]) |
|
3499 |
apply (unfold word_size) |
|
3500 |
apply (cases "len_of TYPE('a) >= len_of TYPE('b)") |
|
3501 |
defer |
|
45805 | 3502 |
apply (simp add: word_0_wi_Pls) |
37660 | 3503 |
apply (simp add : of_bl_def to_bl_def) |
3504 |
apply (subst bin_split_take1 [symmetric]) |
|
3505 |
prefer 2 |
|
3506 |
apply assumption |
|
3507 |
apply simp |
|
3508 |
apply (erule thin_rl) |
|
3509 |
apply (erule arg_cong [THEN trans]) |
|
3510 |
apply (simp add : word_ubin.norm_eq_iff [symmetric]) |
|
3511 |
done |
|
3512 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3513 |
lemma word_split_bl: "std = size c - size b \<Longrightarrow> |
37660 | 3514 |
(a = of_bl (take std (to_bl c)) & b = of_bl (drop std (to_bl c))) <-> |
3515 |
word_split c = (a, b)" |
|
3516 |
apply (rule iffI) |
|
3517 |
defer |
|
3518 |
apply (erule (1) word_split_bl') |
|
3519 |
apply (case_tac "word_split c") |
|
3520 |
apply (auto simp add : word_size) |
|
3521 |
apply (frule word_split_bl' [rotated]) |
|
3522 |
apply (auto simp add : word_size) |
|
3523 |
done |
|
3524 |
||
3525 |
lemma word_split_bl_eq: |
|
3526 |
"(word_split (c::'a::len word) :: ('c :: len0 word * 'd :: len0 word)) = |
|
3527 |
(of_bl (take (len_of TYPE('a::len) - len_of TYPE('d::len0)) (to_bl c)), |
|
3528 |
of_bl (drop (len_of TYPE('a) - len_of TYPE('d)) (to_bl c)))" |
|
3529 |
apply (rule word_split_bl [THEN iffD1]) |
|
3530 |
apply (unfold word_size) |
|
3531 |
apply (rule refl conjI)+ |
|
3532 |
done |
|
3533 |
||
3534 |
-- "keep quantifiers for use in simplification" |
|
3535 |
lemma test_bit_split': |
|
3536 |
"word_split c = (a, b) --> (ALL n m. b !! n = (n < size b & c !! n) & |
|
3537 |
a !! m = (m < size a & c !! (m + size b)))" |
|
3538 |
apply (unfold word_split_bin' test_bit_bin) |
|
3539 |
apply (clarify) |
|
3540 |
apply (clarsimp simp: word_ubin.eq_norm nth_bintr word_size split: prod.splits) |
|
3541 |
apply (drule bin_nth_split) |
|
3542 |
apply safe |
|
3543 |
apply (simp_all add: add_commute) |
|
3544 |
apply (erule bin_nth_uint_imp)+ |
|
3545 |
done |
|
3546 |
||
3547 |
lemma test_bit_split: |
|
3548 |
"word_split c = (a, b) \<Longrightarrow> |
|
3549 |
(\<forall>n\<Colon>nat. b !! n \<longleftrightarrow> n < size b \<and> c !! n) \<and> (\<forall>m\<Colon>nat. a !! m \<longleftrightarrow> m < size a \<and> c !! (m + size b))" |
|
3550 |
by (simp add: test_bit_split') |
|
3551 |
||
3552 |
lemma test_bit_split_eq: "word_split c = (a, b) <-> |
|
3553 |
((ALL n::nat. b !! n = (n < size b & c !! n)) & |
|
3554 |
(ALL m::nat. a !! m = (m < size a & c !! (m + size b))))" |
|
3555 |
apply (rule_tac iffI) |
|
3556 |
apply (rule_tac conjI) |
|
3557 |
apply (erule test_bit_split [THEN conjunct1]) |
|
3558 |
apply (erule test_bit_split [THEN conjunct2]) |
|
3559 |
apply (case_tac "word_split c") |
|
3560 |
apply (frule test_bit_split) |
|
3561 |
apply (erule trans) |
|
44890
22f665a2e91c
new fastforce replacing fastsimp - less confusing name
nipkow
parents:
44821
diff
changeset
|
3562 |
apply (fastforce intro ! : word_eqI simp add : word_size) |
37660 | 3563 |
done |
3564 |
||
3565 |
-- {* this odd result is analogous to @{text "ucast_id"}, |
|
3566 |
result to the length given by the result type *} |
|
3567 |
||
3568 |
lemma word_cat_id: "word_cat a b = b" |
|
3569 |
unfolding word_cat_bin' by (simp add: word_ubin.inverse_norm) |
|
3570 |
||
3571 |
-- "limited hom result" |
|
3572 |
lemma word_cat_hom: |
|
3573 |
"len_of TYPE('a::len0) <= len_of TYPE('b::len0) + len_of TYPE ('c::len0) |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3574 |
\<Longrightarrow> |
37660 | 3575 |
(word_cat (word_of_int w :: 'b word) (b :: 'c word) :: 'a word) = |
3576 |
word_of_int (bin_cat w (size b) (uint b))" |
|
3577 |
apply (unfold word_cat_def word_size) |
|
3578 |
apply (clarsimp simp add: word_ubin.norm_eq_iff [symmetric] |
|
3579 |
word_ubin.eq_norm bintr_cat min_max.inf_absorb1) |
|
3580 |
done |
|
3581 |
||
3582 |
lemma word_cat_split_alt: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3583 |
"size w <= size u + size v \<Longrightarrow> word_split w = (u, v) \<Longrightarrow> word_cat u v = w" |
37660 | 3584 |
apply (rule word_eqI) |
3585 |
apply (drule test_bit_split) |
|
3586 |
apply (clarsimp simp add : test_bit_cat word_size) |
|
3587 |
apply safe |
|
3588 |
apply arith |
|
3589 |
done |
|
3590 |
||
45604 | 3591 |
lemmas word_cat_split_size = sym [THEN [2] word_cat_split_alt [symmetric]] |
37660 | 3592 |
|
3593 |
||
3594 |
subsubsection "Split and slice" |
|
3595 |
||
3596 |
lemma split_slices: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3597 |
"word_split w = (u, v) \<Longrightarrow> u = slice (size v) w & v = slice 0 w" |
37660 | 3598 |
apply (drule test_bit_split) |
3599 |
apply (rule conjI) |
|
3600 |
apply (rule word_eqI, clarsimp simp: nth_slice word_size)+ |
|
3601 |
done |
|
3602 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3603 |
lemma slice_cat1 [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3604 |
"wc = word_cat a b \<Longrightarrow> size wc >= size a + size b \<Longrightarrow> slice (size b) wc = a" |
37660 | 3605 |
apply safe |
3606 |
apply (rule word_eqI) |
|
3607 |
apply (simp add: nth_slice test_bit_cat word_size) |
|
3608 |
done |
|
3609 |
||
3610 |
lemmas slice_cat2 = trans [OF slice_id word_cat_id] |
|
3611 |
||
3612 |
lemma cat_slices: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3613 |
"a = slice n c \<Longrightarrow> b = slice 0 c \<Longrightarrow> n = size b \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3614 |
size a + size b >= size c \<Longrightarrow> word_cat a b = c" |
37660 | 3615 |
apply safe |
3616 |
apply (rule word_eqI) |
|
3617 |
apply (simp add: nth_slice test_bit_cat word_size) |
|
3618 |
apply safe |
|
3619 |
apply arith |
|
3620 |
done |
|
3621 |
||
3622 |
lemma word_split_cat_alt: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3623 |
"w = word_cat u v \<Longrightarrow> size u + size v <= size w \<Longrightarrow> word_split w = (u, v)" |
37660 | 3624 |
apply (case_tac "word_split ?w") |
3625 |
apply (rule trans, assumption) |
|
3626 |
apply (drule test_bit_split) |
|
3627 |
apply safe |
|
3628 |
apply (rule word_eqI, clarsimp simp: test_bit_cat word_size)+ |
|
3629 |
done |
|
3630 |
||
3631 |
lemmas word_cat_bl_no_bin [simp] = |
|
3632 |
word_cat_bl [where a="number_of a" |
|
3633 |
and b="number_of b", |
|
45604 | 3634 |
unfolded to_bl_no_bin] |
3635 |
for a b |
|
37660 | 3636 |
|
3637 |
lemmas word_split_bl_no_bin [simp] = |
|
45604 | 3638 |
word_split_bl_eq [where c="number_of c", unfolded to_bl_no_bin] for c |
37660 | 3639 |
|
3640 |
-- {* this odd result arises from the fact that the statement of the |
|
3641 |
result implies that the decoded words are of the same type, |
|
3642 |
and therefore of the same length, as the original word *} |
|
3643 |
||
3644 |
lemma word_rsplit_same: "word_rsplit w = [w]" |
|
3645 |
unfolding word_rsplit_def by (simp add : bin_rsplit_all) |
|
3646 |
||
3647 |
lemma word_rsplit_empty_iff_size: |
|
3648 |
"(word_rsplit w = []) = (size w = 0)" |
|
3649 |
unfolding word_rsplit_def bin_rsplit_def word_size |
|
3650 |
by (simp add: bin_rsplit_aux_simp_alt Let_def split: Product_Type.split_split) |
|
3651 |
||
3652 |
lemma test_bit_rsplit: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3653 |
"sw = word_rsplit w \<Longrightarrow> m < size (hd sw :: 'a :: len word) \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3654 |
k < length sw \<Longrightarrow> (rev sw ! k) !! m = (w !! (k * size (hd sw) + m))" |
37660 | 3655 |
apply (unfold word_rsplit_def word_test_bit_def) |
3656 |
apply (rule trans) |
|
3657 |
apply (rule_tac f = "%x. bin_nth x m" in arg_cong) |
|
3658 |
apply (rule nth_map [symmetric]) |
|
3659 |
apply simp |
|
3660 |
apply (rule bin_nth_rsplit) |
|
3661 |
apply simp_all |
|
3662 |
apply (simp add : word_size rev_map) |
|
3663 |
apply (rule trans) |
|
3664 |
defer |
|
3665 |
apply (rule map_ident [THEN fun_cong]) |
|
3666 |
apply (rule refl [THEN map_cong]) |
|
3667 |
apply (simp add : word_ubin.eq_norm) |
|
3668 |
apply (erule bin_rsplit_size_sign [OF len_gt_0 refl]) |
|
3669 |
done |
|
3670 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3671 |
lemma word_rcat_bl: "word_rcat wl = of_bl (concat (map to_bl wl))" |
37660 | 3672 |
unfolding word_rcat_def to_bl_def' of_bl_def |
3673 |
by (clarsimp simp add : bin_rcat_bl) |
|
3674 |
||
3675 |
lemma size_rcat_lem': |
|
3676 |
"size (concat (map to_bl wl)) = length wl * size (hd wl)" |
|
3677 |
unfolding word_size by (induct wl) auto |
|
3678 |
||
3679 |
lemmas size_rcat_lem = size_rcat_lem' [unfolded word_size] |
|
3680 |
||
45604 | 3681 |
lemmas td_gal_lt_len = len_gt_0 [THEN td_gal_lt] |
37660 | 3682 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3683 |
lemma nth_rcat_lem: |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3684 |
"n < length (wl::'a word list) * len_of TYPE('a::len) \<Longrightarrow> |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3685 |
rev (concat (map to_bl wl)) ! n = |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3686 |
rev (to_bl (rev wl ! (n div len_of TYPE('a)))) ! (n mod len_of TYPE('a))" |
37660 | 3687 |
apply (induct "wl") |
3688 |
apply clarsimp |
|
3689 |
apply (clarsimp simp add : nth_append size_rcat_lem) |
|
3690 |
apply (simp (no_asm_use) only: mult_Suc [symmetric] |
|
3691 |
td_gal_lt_len less_Suc_eq_le mod_div_equality') |
|
3692 |
apply clarsimp |
|
3693 |
done |
|
3694 |
||
3695 |
lemma test_bit_rcat: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3696 |
"sw = size (hd wl :: 'a :: len word) \<Longrightarrow> rc = word_rcat wl \<Longrightarrow> rc !! n = |
37660 | 3697 |
(n < size rc & n div sw < size wl & (rev wl) ! (n div sw) !! (n mod sw))" |
3698 |
apply (unfold word_rcat_bl word_size) |
|
3699 |
apply (clarsimp simp add : |
|
3700 |
test_bit_of_bl size_rcat_lem word_size td_gal_lt_len) |
|
3701 |
apply safe |
|
3702 |
apply (auto simp add : |
|
3703 |
test_bit_bl word_size td_gal_lt_len [THEN iffD2, THEN nth_rcat_lem]) |
|
3704 |
done |
|
3705 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3706 |
lemma foldl_eq_foldr: |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3707 |
"foldl op + x xs = foldr op + (x # xs) (0 :: 'a :: comm_monoid_add)" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3708 |
by (induct xs arbitrary: x) (auto simp add : add_assoc) |
37660 | 3709 |
|
3710 |
lemmas test_bit_cong = arg_cong [where f = "test_bit", THEN fun_cong] |
|
3711 |
||
3712 |
lemmas test_bit_rsplit_alt = |
|
3713 |
trans [OF nth_rev_alt [THEN test_bit_cong] |
|
3714 |
test_bit_rsplit [OF refl asm_rl diff_Suc_less]] |
|
3715 |
||
3716 |
-- "lazy way of expressing that u and v, and su and sv, have same types" |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3717 |
lemma word_rsplit_len_indep [OF refl refl refl refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3718 |
"[u,v] = p \<Longrightarrow> [su,sv] = q \<Longrightarrow> word_rsplit u = su \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3719 |
word_rsplit v = sv \<Longrightarrow> length su = length sv" |
37660 | 3720 |
apply (unfold word_rsplit_def) |
3721 |
apply (auto simp add : bin_rsplit_len_indep) |
|
3722 |
done |
|
3723 |
||
3724 |
lemma length_word_rsplit_size: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3725 |
"n = len_of TYPE ('a :: len) \<Longrightarrow> |
37660 | 3726 |
(length (word_rsplit w :: 'a word list) <= m) = (size w <= m * n)" |
3727 |
apply (unfold word_rsplit_def word_size) |
|
3728 |
apply (clarsimp simp add : bin_rsplit_len_le) |
|
3729 |
done |
|
3730 |
||
3731 |
lemmas length_word_rsplit_lt_size = |
|
3732 |
length_word_rsplit_size [unfolded Not_eq_iff linorder_not_less [symmetric]] |
|
3733 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3734 |
lemma length_word_rsplit_exp_size: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3735 |
"n = len_of TYPE ('a :: len) \<Longrightarrow> |
37660 | 3736 |
length (word_rsplit w :: 'a word list) = (size w + n - 1) div n" |
3737 |
unfolding word_rsplit_def by (clarsimp simp add : word_size bin_rsplit_len) |
|
3738 |
||
3739 |
lemma length_word_rsplit_even_size: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3740 |
"n = len_of TYPE ('a :: len) \<Longrightarrow> size w = m * n \<Longrightarrow> |
37660 | 3741 |
length (word_rsplit w :: 'a word list) = m" |
3742 |
by (clarsimp simp add : length_word_rsplit_exp_size given_quot_alt) |
|
3743 |
||
3744 |
lemmas length_word_rsplit_exp_size' = refl [THEN length_word_rsplit_exp_size] |
|
3745 |
||
3746 |
(* alternative proof of word_rcat_rsplit *) |
|
3747 |
lemmas tdle = iffD2 [OF split_div_lemma refl, THEN conjunct1] |
|
3748 |
lemmas dtle = xtr4 [OF tdle mult_commute] |
|
3749 |
||
3750 |
lemma word_rcat_rsplit: "word_rcat (word_rsplit w) = w" |
|
3751 |
apply (rule word_eqI) |
|
3752 |
apply (clarsimp simp add : test_bit_rcat word_size) |
|
3753 |
apply (subst refl [THEN test_bit_rsplit]) |
|
3754 |
apply (simp_all add: word_size |
|
3755 |
refl [THEN length_word_rsplit_size [simplified not_less [symmetric], simplified]]) |
|
3756 |
apply safe |
|
3757 |
apply (erule xtr7, rule len_gt_0 [THEN dtle])+ |
|
3758 |
done |
|
3759 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3760 |
lemma size_word_rsplit_rcat_size: |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3761 |
"\<lbrakk>word_rcat (ws::'a::len word list) = (frcw::'b::len0 word); |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3762 |
size frcw = length ws * len_of TYPE('a)\<rbrakk> |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3763 |
\<Longrightarrow> length (word_rsplit frcw::'a word list) = length ws" |
37660 | 3764 |
apply (clarsimp simp add : word_size length_word_rsplit_exp_size') |
3765 |
apply (fast intro: given_quot_alt) |
|
3766 |
done |
|
3767 |
||
3768 |
lemma msrevs: |
|
3769 |
fixes n::nat |
|
3770 |
shows "0 < n \<Longrightarrow> (k * n + m) div n = m div n + k" |
|
3771 |
and "(k * n + m) mod n = m mod n" |
|
3772 |
by (auto simp: add_commute) |
|
3773 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3774 |
lemma word_rsplit_rcat_size [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3775 |
"word_rcat (ws :: 'a :: len word list) = frcw \<Longrightarrow> |
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3776 |
size frcw = length ws * len_of TYPE ('a) \<Longrightarrow> word_rsplit frcw = ws" |
37660 | 3777 |
apply (frule size_word_rsplit_rcat_size, assumption) |
3778 |
apply (clarsimp simp add : word_size) |
|
3779 |
apply (rule nth_equalityI, assumption) |
|
3780 |
apply clarsimp |
|
3781 |
apply (rule word_eqI) |
|
3782 |
apply (rule trans) |
|
3783 |
apply (rule test_bit_rsplit_alt) |
|
3784 |
apply (clarsimp simp: word_size)+ |
|
3785 |
apply (rule trans) |
|
3786 |
apply (rule test_bit_rcat [OF refl refl]) |
|
41550 | 3787 |
apply (simp add: word_size msrevs) |
37660 | 3788 |
apply (subst nth_rev) |
3789 |
apply arith |
|
41550 | 3790 |
apply (simp add: le0 [THEN [2] xtr7, THEN diff_Suc_less]) |
37660 | 3791 |
apply safe |
41550 | 3792 |
apply (simp add: diff_mult_distrib) |
37660 | 3793 |
apply (rule mpl_lem) |
3794 |
apply (cases "size ws") |
|
3795 |
apply simp_all |
|
3796 |
done |
|
3797 |
||
3798 |
||
3799 |
subsection "Rotation" |
|
3800 |
||
3801 |
lemmas rotater_0' [simp] = rotater_def [where n = "0", simplified] |
|
3802 |
||
3803 |
lemmas word_rot_defs = word_roti_def word_rotr_def word_rotl_def |
|
3804 |
||
3805 |
lemma rotate_eq_mod: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3806 |
"m mod length xs = n mod length xs \<Longrightarrow> rotate m xs = rotate n xs" |
37660 | 3807 |
apply (rule box_equals) |
3808 |
defer |
|
3809 |
apply (rule rotate_conv_mod [symmetric])+ |
|
3810 |
apply simp |
|
3811 |
done |
|
3812 |
||
45604 | 3813 |
lemmas rotate_eqs = |
37660 | 3814 |
trans [OF rotate0 [THEN fun_cong] id_apply] |
3815 |
rotate_rotate [symmetric] |
|
45604 | 3816 |
rotate_id |
37660 | 3817 |
rotate_conv_mod |
3818 |
rotate_eq_mod |
|
3819 |
||
3820 |
||
3821 |
subsubsection "Rotation of list to right" |
|
3822 |
||
3823 |
lemma rotate1_rl': "rotater1 (l @ [a]) = a # l" |
|
3824 |
unfolding rotater1_def by (cases l) auto |
|
3825 |
||
3826 |
lemma rotate1_rl [simp] : "rotater1 (rotate1 l) = l" |
|
3827 |
apply (unfold rotater1_def) |
|
3828 |
apply (cases "l") |
|
3829 |
apply (case_tac [2] "list") |
|
3830 |
apply auto |
|
3831 |
done |
|
3832 |
||
3833 |
lemma rotate1_lr [simp] : "rotate1 (rotater1 l) = l" |
|
3834 |
unfolding rotater1_def by (cases l) auto |
|
3835 |
||
3836 |
lemma rotater1_rev': "rotater1 (rev xs) = rev (rotate1 xs)" |
|
3837 |
apply (cases "xs") |
|
3838 |
apply (simp add : rotater1_def) |
|
3839 |
apply (simp add : rotate1_rl') |
|
3840 |
done |
|
3841 |
||
3842 |
lemma rotater_rev': "rotater n (rev xs) = rev (rotate n xs)" |
|
3843 |
unfolding rotater_def by (induct n) (auto intro: rotater1_rev') |
|
3844 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3845 |
lemma rotater_rev: "rotater n ys = rev (rotate n (rev ys))" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3846 |
using rotater_rev' [where xs = "rev ys"] by simp |
37660 | 3847 |
|
3848 |
lemma rotater_drop_take: |
|
3849 |
"rotater n xs = |
|
3850 |
drop (length xs - n mod length xs) xs @ |
|
3851 |
take (length xs - n mod length xs) xs" |
|
3852 |
by (clarsimp simp add : rotater_rev rotate_drop_take rev_take rev_drop) |
|
3853 |
||
3854 |
lemma rotater_Suc [simp] : |
|
3855 |
"rotater (Suc n) xs = rotater1 (rotater n xs)" |
|
3856 |
unfolding rotater_def by auto |
|
3857 |
||
3858 |
lemma rotate_inv_plus [rule_format] : |
|
3859 |
"ALL k. k = m + n --> rotater k (rotate n xs) = rotater m xs & |
|
3860 |
rotate k (rotater n xs) = rotate m xs & |
|
3861 |
rotater n (rotate k xs) = rotate m xs & |
|
3862 |
rotate n (rotater k xs) = rotater m xs" |
|
3863 |
unfolding rotater_def rotate_def |
|
3864 |
by (induct n) (auto intro: funpow_swap1 [THEN trans]) |
|
3865 |
||
3866 |
lemmas rotate_inv_rel = le_add_diff_inverse2 [symmetric, THEN rotate_inv_plus] |
|
3867 |
||
3868 |
lemmas rotate_inv_eq = order_refl [THEN rotate_inv_rel, simplified] |
|
3869 |
||
45604 | 3870 |
lemmas rotate_lr [simp] = rotate_inv_eq [THEN conjunct1] |
3871 |
lemmas rotate_rl [simp] = rotate_inv_eq [THEN conjunct2, THEN conjunct1] |
|
37660 | 3872 |
|
3873 |
lemma rotate_gal: "(rotater n xs = ys) = (rotate n ys = xs)" |
|
3874 |
by auto |
|
3875 |
||
3876 |
lemma rotate_gal': "(ys = rotater n xs) = (xs = rotate n ys)" |
|
3877 |
by auto |
|
3878 |
||
3879 |
lemma length_rotater [simp]: |
|
3880 |
"length (rotater n xs) = length xs" |
|
3881 |
by (simp add : rotater_rev) |
|
3882 |
||
38527 | 3883 |
lemma restrict_to_left: |
3884 |
assumes "x = y" |
|
3885 |
shows "(x = z) = (y = z)" |
|
3886 |
using assms by simp |
|
3887 |
||
37660 | 3888 |
lemmas rrs0 = rotate_eqs [THEN restrict_to_left, |
45604 | 3889 |
simplified rotate_gal [symmetric] rotate_gal' [symmetric]] |
37660 | 3890 |
lemmas rrs1 = rrs0 [THEN refl [THEN rev_iffD1]] |
45604 | 3891 |
lemmas rotater_eqs = rrs1 [simplified length_rotater] |
37660 | 3892 |
lemmas rotater_0 = rotater_eqs (1) |
3893 |
lemmas rotater_add = rotater_eqs (2) |
|
3894 |
||
3895 |
||
3896 |
subsubsection "map, map2, commuting with rotate(r)" |
|
3897 |
||
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3898 |
lemma last_map: "xs ~= [] \<Longrightarrow> last (map f xs) = f (last xs)" |
37660 | 3899 |
by (induct xs) auto |
3900 |
||
3901 |
lemma butlast_map: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3902 |
"xs ~= [] \<Longrightarrow> butlast (map f xs) = map f (butlast xs)" |
37660 | 3903 |
by (induct xs) auto |
3904 |
||
3905 |
lemma rotater1_map: "rotater1 (map f xs) = map f (rotater1 xs)" |
|
3906 |
unfolding rotater1_def |
|
3907 |
by (cases xs) (auto simp add: last_map butlast_map) |
|
3908 |
||
3909 |
lemma rotater_map: |
|
3910 |
"rotater n (map f xs) = map f (rotater n xs)" |
|
3911 |
unfolding rotater_def |
|
3912 |
by (induct n) (auto simp add : rotater1_map) |
|
3913 |
||
3914 |
lemma but_last_zip [rule_format] : |
|
3915 |
"ALL ys. length xs = length ys --> xs ~= [] --> |
|
3916 |
last (zip xs ys) = (last xs, last ys) & |
|
3917 |
butlast (zip xs ys) = zip (butlast xs) (butlast ys)" |
|
3918 |
apply (induct "xs") |
|
3919 |
apply auto |
|
3920 |
apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+ |
|
3921 |
done |
|
3922 |
||
3923 |
lemma but_last_map2 [rule_format] : |
|
3924 |
"ALL ys. length xs = length ys --> xs ~= [] --> |
|
3925 |
last (map2 f xs ys) = f (last xs) (last ys) & |
|
3926 |
butlast (map2 f xs ys) = map2 f (butlast xs) (butlast ys)" |
|
3927 |
apply (induct "xs") |
|
3928 |
apply auto |
|
3929 |
apply (unfold map2_def) |
|
3930 |
apply ((case_tac ys, auto simp: neq_Nil_conv)[1])+ |
|
3931 |
done |
|
3932 |
||
3933 |
lemma rotater1_zip: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3934 |
"length xs = length ys \<Longrightarrow> |
37660 | 3935 |
rotater1 (zip xs ys) = zip (rotater1 xs) (rotater1 ys)" |
3936 |
apply (unfold rotater1_def) |
|
3937 |
apply (cases "xs") |
|
3938 |
apply auto |
|
3939 |
apply ((case_tac ys, auto simp: neq_Nil_conv but_last_zip)[1])+ |
|
3940 |
done |
|
3941 |
||
3942 |
lemma rotater1_map2: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3943 |
"length xs = length ys \<Longrightarrow> |
37660 | 3944 |
rotater1 (map2 f xs ys) = map2 f (rotater1 xs) (rotater1 ys)" |
3945 |
unfolding map2_def by (simp add: rotater1_map rotater1_zip) |
|
3946 |
||
3947 |
lemmas lrth = |
|
3948 |
box_equals [OF asm_rl length_rotater [symmetric] |
|
3949 |
length_rotater [symmetric], |
|
3950 |
THEN rotater1_map2] |
|
3951 |
||
3952 |
lemma rotater_map2: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3953 |
"length xs = length ys \<Longrightarrow> |
37660 | 3954 |
rotater n (map2 f xs ys) = map2 f (rotater n xs) (rotater n ys)" |
3955 |
by (induct n) (auto intro!: lrth) |
|
3956 |
||
3957 |
lemma rotate1_map2: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3958 |
"length xs = length ys \<Longrightarrow> |
37660 | 3959 |
rotate1 (map2 f xs ys) = map2 f (rotate1 xs) (rotate1 ys)" |
3960 |
apply (unfold map2_def) |
|
3961 |
apply (cases xs) |
|
3962 |
apply (cases ys, auto simp add : rotate1_def)+ |
|
3963 |
done |
|
3964 |
||
3965 |
lemmas lth = box_equals [OF asm_rl length_rotate [symmetric] |
|
3966 |
length_rotate [symmetric], THEN rotate1_map2] |
|
3967 |
||
3968 |
lemma rotate_map2: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3969 |
"length xs = length ys \<Longrightarrow> |
37660 | 3970 |
rotate n (map2 f xs ys) = map2 f (rotate n xs) (rotate n ys)" |
3971 |
by (induct n) (auto intro!: lth) |
|
3972 |
||
3973 |
||
3974 |
-- "corresponding equalities for word rotation" |
|
3975 |
||
3976 |
lemma to_bl_rotl: |
|
3977 |
"to_bl (word_rotl n w) = rotate n (to_bl w)" |
|
3978 |
by (simp add: word_bl.Abs_inverse' word_rotl_def) |
|
3979 |
||
3980 |
lemmas blrs0 = rotate_eqs [THEN to_bl_rotl [THEN trans]] |
|
3981 |
||
3982 |
lemmas word_rotl_eqs = |
|
45538
1fffa81b9b83
eliminated slightly odd Rep' with dynamically-scoped [simplified];
wenzelm
parents:
45529
diff
changeset
|
3983 |
blrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotl [symmetric]] |
37660 | 3984 |
|
3985 |
lemma to_bl_rotr: |
|
3986 |
"to_bl (word_rotr n w) = rotater n (to_bl w)" |
|
3987 |
by (simp add: word_bl.Abs_inverse' word_rotr_def) |
|
3988 |
||
3989 |
lemmas brrs0 = rotater_eqs [THEN to_bl_rotr [THEN trans]] |
|
3990 |
||
3991 |
lemmas word_rotr_eqs = |
|
45538
1fffa81b9b83
eliminated slightly odd Rep' with dynamically-scoped [simplified];
wenzelm
parents:
45529
diff
changeset
|
3992 |
brrs0 [simplified word_bl_Rep' word_bl.Rep_inject to_bl_rotr [symmetric]] |
37660 | 3993 |
|
3994 |
declare word_rotr_eqs (1) [simp] |
|
3995 |
declare word_rotl_eqs (1) [simp] |
|
3996 |
||
3997 |
lemma |
|
3998 |
word_rot_rl [simp]: |
|
3999 |
"word_rotl k (word_rotr k v) = v" and |
|
4000 |
word_rot_lr [simp]: |
|
4001 |
"word_rotr k (word_rotl k v) = v" |
|
4002 |
by (auto simp add: to_bl_rotr to_bl_rotl word_bl.Rep_inject [symmetric]) |
|
4003 |
||
4004 |
lemma |
|
4005 |
word_rot_gal: |
|
4006 |
"(word_rotr n v = w) = (word_rotl n w = v)" and |
|
4007 |
word_rot_gal': |
|
4008 |
"(w = word_rotr n v) = (v = word_rotl n w)" |
|
4009 |
by (auto simp: to_bl_rotr to_bl_rotl word_bl.Rep_inject [symmetric] |
|
4010 |
dest: sym) |
|
4011 |
||
4012 |
lemma word_rotr_rev: |
|
4013 |
"word_rotr n w = word_reverse (word_rotl n (word_reverse w))" |
|
4014 |
by (simp add: word_bl.Rep_inject [symmetric] to_bl_word_rev |
|
4015 |
to_bl_rotr to_bl_rotl rotater_rev) |
|
4016 |
||
4017 |
lemma word_roti_0 [simp]: "word_roti 0 w = w" |
|
4018 |
by (unfold word_rot_defs) auto |
|
4019 |
||
4020 |
lemmas abl_cong = arg_cong [where f = "of_bl"] |
|
4021 |
||
4022 |
lemma word_roti_add: |
|
4023 |
"word_roti (m + n) w = word_roti m (word_roti n w)" |
|
4024 |
proof - |
|
4025 |
have rotater_eq_lem: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4026 |
"\<And>m n xs. m = n \<Longrightarrow> rotater m xs = rotater n xs" |
37660 | 4027 |
by auto |
4028 |
||
4029 |
have rotate_eq_lem: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4030 |
"\<And>m n xs. m = n \<Longrightarrow> rotate m xs = rotate n xs" |
37660 | 4031 |
by auto |
4032 |
||
45604 | 4033 |
note rpts [symmetric] = |
37660 | 4034 |
rotate_inv_plus [THEN conjunct1] |
4035 |
rotate_inv_plus [THEN conjunct2, THEN conjunct1] |
|
4036 |
rotate_inv_plus [THEN conjunct2, THEN conjunct2, THEN conjunct1] |
|
4037 |
rotate_inv_plus [THEN conjunct2, THEN conjunct2, THEN conjunct2] |
|
4038 |
||
4039 |
note rrp = trans [symmetric, OF rotate_rotate rotate_eq_lem] |
|
4040 |
note rrrp = trans [symmetric, OF rotater_add [symmetric] rotater_eq_lem] |
|
4041 |
||
4042 |
show ?thesis |
|
4043 |
apply (unfold word_rot_defs) |
|
4044 |
apply (simp only: split: split_if) |
|
4045 |
apply (safe intro!: abl_cong) |
|
4046 |
apply (simp_all only: to_bl_rotl [THEN word_bl.Rep_inverse'] |
|
4047 |
to_bl_rotl |
|
4048 |
to_bl_rotr [THEN word_bl.Rep_inverse'] |
|
4049 |
to_bl_rotr) |
|
4050 |
apply (rule rrp rrrp rpts, |
|
4051 |
simp add: nat_add_distrib [symmetric] |
|
4052 |
nat_diff_distrib [symmetric])+ |
|
4053 |
done |
|
4054 |
qed |
|
4055 |
||
4056 |
lemma word_roti_conv_mod': "word_roti n w = word_roti (n mod int (size w)) w" |
|
4057 |
apply (unfold word_rot_defs) |
|
4058 |
apply (cut_tac y="size w" in gt_or_eq_0) |
|
4059 |
apply (erule disjE) |
|
4060 |
apply simp_all |
|
4061 |
apply (safe intro!: abl_cong) |
|
4062 |
apply (rule rotater_eqs) |
|
4063 |
apply (simp add: word_size nat_mod_distrib) |
|
4064 |
apply (simp add: rotater_add [symmetric] rotate_gal [symmetric]) |
|
4065 |
apply (rule rotater_eqs) |
|
4066 |
apply (simp add: word_size nat_mod_distrib) |
|
4067 |
apply (rule int_eq_0_conv [THEN iffD1]) |
|
44821 | 4068 |
apply (simp only: zmod_int of_nat_add) |
37660 | 4069 |
apply (simp add: rdmods) |
4070 |
done |
|
4071 |
||
4072 |
lemmas word_roti_conv_mod = word_roti_conv_mod' [unfolded word_size] |
|
4073 |
||
4074 |
||
4075 |
subsubsection "Word rotation commutes with bit-wise operations" |
|
4076 |
||
4077 |
(* using locale to not pollute lemma namespace *) |
|
4078 |
locale word_rotate |
|
4079 |
begin |
|
4080 |
||
4081 |
lemmas word_rot_defs' = to_bl_rotl to_bl_rotr |
|
4082 |
||
4083 |
lemmas blwl_syms [symmetric] = bl_word_not bl_word_and bl_word_or bl_word_xor |
|
4084 |
||
45538
1fffa81b9b83
eliminated slightly odd Rep' with dynamically-scoped [simplified];
wenzelm
parents:
45529
diff
changeset
|
4085 |
lemmas lbl_lbl = trans [OF word_bl_Rep' word_bl_Rep' [symmetric]] |
37660 | 4086 |
|
4087 |
lemmas ths_map2 [OF lbl_lbl] = rotate_map2 rotater_map2 |
|
4088 |
||
45604 | 4089 |
lemmas ths_map [where xs = "to_bl v"] = rotate_map rotater_map for v |
37660 | 4090 |
|
4091 |
lemmas th1s [simplified word_rot_defs' [symmetric]] = ths_map2 ths_map |
|
4092 |
||
4093 |
lemma word_rot_logs: |
|
4094 |
"word_rotl n (NOT v) = NOT word_rotl n v" |
|
4095 |
"word_rotr n (NOT v) = NOT word_rotr n v" |
|
4096 |
"word_rotl n (x AND y) = word_rotl n x AND word_rotl n y" |
|
4097 |
"word_rotr n (x AND y) = word_rotr n x AND word_rotr n y" |
|
4098 |
"word_rotl n (x OR y) = word_rotl n x OR word_rotl n y" |
|
4099 |
"word_rotr n (x OR y) = word_rotr n x OR word_rotr n y" |
|
4100 |
"word_rotl n (x XOR y) = word_rotl n x XOR word_rotl n y" |
|
4101 |
"word_rotr n (x XOR y) = word_rotr n x XOR word_rotr n y" |
|
4102 |
by (rule word_bl.Rep_eqD, |
|
4103 |
rule word_rot_defs' [THEN trans], |
|
4104 |
simp only: blwl_syms [symmetric], |
|
4105 |
rule th1s [THEN trans], |
|
4106 |
rule refl)+ |
|
4107 |
end |
|
4108 |
||
4109 |
lemmas word_rot_logs = word_rotate.word_rot_logs |
|
4110 |
||
4111 |
lemmas bl_word_rotl_dt = trans [OF to_bl_rotl rotate_drop_take, |
|
45604 | 4112 |
simplified word_bl_Rep'] |
37660 | 4113 |
|
4114 |
lemmas bl_word_rotr_dt = trans [OF to_bl_rotr rotater_drop_take, |
|
45604 | 4115 |
simplified word_bl_Rep'] |
37660 | 4116 |
|
4117 |
lemma bl_word_roti_dt': |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4118 |
"n = nat ((- i) mod int (size (w :: 'a :: len word))) \<Longrightarrow> |
37660 | 4119 |
to_bl (word_roti i w) = drop n (to_bl w) @ take n (to_bl w)" |
4120 |
apply (unfold word_roti_def) |
|
4121 |
apply (simp add: bl_word_rotl_dt bl_word_rotr_dt word_size) |
|
4122 |
apply safe |
|
4123 |
apply (simp add: zmod_zminus1_eq_if) |
|
4124 |
apply safe |
|
4125 |
apply (simp add: nat_mult_distrib) |
|
4126 |
apply (simp add: nat_diff_distrib [OF pos_mod_sign pos_mod_conj |
|
4127 |
[THEN conjunct2, THEN order_less_imp_le]] |
|
4128 |
nat_mod_distrib) |
|
4129 |
apply (simp add: nat_mod_distrib) |
|
4130 |
done |
|
4131 |
||
4132 |
lemmas bl_word_roti_dt = bl_word_roti_dt' [unfolded word_size] |
|
4133 |
||
45604 | 4134 |
lemmas word_rotl_dt = bl_word_rotl_dt [THEN word_bl.Rep_inverse' [symmetric]] |
4135 |
lemmas word_rotr_dt = bl_word_rotr_dt [THEN word_bl.Rep_inverse' [symmetric]] |
|
4136 |
lemmas word_roti_dt = bl_word_roti_dt [THEN word_bl.Rep_inverse' [symmetric]] |
|
37660 | 4137 |
|
4138 |
lemma word_rotx_0 [simp] : "word_rotr i 0 = 0 & word_rotl i 0 = 0" |
|
45805 | 4139 |
by (simp add : word_rotr_dt word_rotl_dt replicate_add [symmetric]) |
37660 | 4140 |
|
4141 |
lemma word_roti_0' [simp] : "word_roti n 0 = 0" |
|
4142 |
unfolding word_roti_def by auto |
|
4143 |
||
4144 |
lemmas word_rotr_dt_no_bin' [simp] = |
|
45604 | 4145 |
word_rotr_dt [where w="number_of w", unfolded to_bl_no_bin] for w |
37660 | 4146 |
|
4147 |
lemmas word_rotl_dt_no_bin' [simp] = |
|
45604 | 4148 |
word_rotl_dt [where w="number_of w", unfolded to_bl_no_bin] for w |
37660 | 4149 |
|
4150 |
declare word_roti_def [simp] |
|
4151 |
||
4152 |
||
4153 |
subsection {* Miscellaneous *} |
|
4154 |
||
4155 |
lemma word_int_cases: |
|
4156 |
"\<lbrakk>\<And>n. \<lbrakk>(x ::'a::len0 word) = word_of_int n; 0 \<le> n; n < 2^len_of TYPE('a)\<rbrakk> \<Longrightarrow> P\<rbrakk> |
|
4157 |
\<Longrightarrow> P" |
|
4158 |
by (cases x rule: word_uint.Abs_cases) (simp add: uints_num) |
|
4159 |
||
4160 |
lemma word_nat_cases [cases type: word]: |
|
4161 |
"\<lbrakk>\<And>n. \<lbrakk>(x ::'a::len word) = of_nat n; n < 2^len_of TYPE('a)\<rbrakk> \<Longrightarrow> P\<rbrakk> |
|
4162 |
\<Longrightarrow> P" |
|
4163 |
by (cases x rule: word_unat.Abs_cases) (simp add: unats_def) |
|
4164 |
||
4165 |
lemma max_word_eq: |
|
4166 |
"(max_word::'a::len word) = 2^len_of TYPE('a) - 1" |
|
4167 |
by (simp add: max_word_def word_of_int_hom_syms word_of_int_2p) |
|
4168 |
||
4169 |
lemma max_word_max [simp,intro!]: |
|
4170 |
"n \<le> max_word" |
|
4171 |
by (cases n rule: word_int_cases) |
|
4172 |
(simp add: max_word_def word_le_def int_word_uint int_mod_eq') |
|
4173 |
||
4174 |
lemma word_of_int_2p_len: |
|
4175 |
"word_of_int (2 ^ len_of TYPE('a)) = (0::'a::len0 word)" |
|
4176 |
by (subst word_uint.Abs_norm [symmetric]) |
|
4177 |
(simp add: word_of_int_hom_syms) |
|
4178 |
||
4179 |
lemma word_pow_0: |
|
4180 |
"(2::'a::len word) ^ len_of TYPE('a) = 0" |
|
4181 |
proof - |
|
4182 |
have "word_of_int (2 ^ len_of TYPE('a)) = (0::'a word)" |
|
4183 |
by (rule word_of_int_2p_len) |
|
4184 |
thus ?thesis by (simp add: word_of_int_2p) |
|
4185 |
qed |
|
4186 |
||
4187 |
lemma max_word_wrap: "x + 1 = 0 \<Longrightarrow> x = max_word" |
|
4188 |
apply (simp add: max_word_eq) |
|
4189 |
apply uint_arith |
|
4190 |
apply auto |
|
4191 |
apply (simp add: word_pow_0) |
|
4192 |
done |
|
4193 |
||
4194 |
lemma max_word_minus: |
|
4195 |
"max_word = (-1::'a::len word)" |
|
4196 |
proof - |
|
4197 |
have "-1 + 1 = (0::'a word)" by simp |
|
4198 |
thus ?thesis by (rule max_word_wrap [symmetric]) |
|
4199 |
qed |
|
4200 |
||
4201 |
lemma max_word_bl [simp]: |
|
4202 |
"to_bl (max_word::'a::len word) = replicate (len_of TYPE('a)) True" |
|
4203 |
by (subst max_word_minus to_bl_n1)+ simp |
|
4204 |
||
4205 |
lemma max_test_bit [simp]: |
|
4206 |
"(max_word::'a::len word) !! n = (n < len_of TYPE('a))" |
|
4207 |
by (auto simp add: test_bit_bl word_size) |
|
4208 |
||
4209 |
lemma word_and_max [simp]: |
|
4210 |
"x AND max_word = x" |
|
4211 |
by (rule word_eqI) (simp add: word_ops_nth_size word_size) |
|
4212 |
||
4213 |
lemma word_or_max [simp]: |
|
4214 |
"x OR max_word = max_word" |
|
4215 |
by (rule word_eqI) (simp add: word_ops_nth_size word_size) |
|
4216 |
||
4217 |
lemma word_ao_dist2: |
|
4218 |
"x AND (y OR z) = x AND y OR x AND (z::'a::len0 word)" |
|
4219 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
|
4220 |
||
4221 |
lemma word_oa_dist2: |
|
4222 |
"x OR y AND z = (x OR y) AND (x OR (z::'a::len0 word))" |
|
4223 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
|
4224 |
||
4225 |
lemma word_and_not [simp]: |
|
4226 |
"x AND NOT x = (0::'a::len0 word)" |
|
4227 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
|
4228 |
||
4229 |
lemma word_or_not [simp]: |
|
4230 |
"x OR NOT x = max_word" |
|
4231 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
|
4232 |
||
4233 |
lemma word_boolean: |
|
4234 |
"boolean (op AND) (op OR) bitNOT 0 max_word" |
|
4235 |
apply (rule boolean.intro) |
|
4236 |
apply (rule word_bw_assocs) |
|
4237 |
apply (rule word_bw_assocs) |
|
4238 |
apply (rule word_bw_comms) |
|
4239 |
apply (rule word_bw_comms) |
|
4240 |
apply (rule word_ao_dist2) |
|
4241 |
apply (rule word_oa_dist2) |
|
4242 |
apply (rule word_and_max) |
|
4243 |
apply (rule word_log_esimps) |
|
4244 |
apply (rule word_and_not) |
|
4245 |
apply (rule word_or_not) |
|
4246 |
done |
|
4247 |
||
4248 |
interpretation word_bool_alg: |
|
4249 |
boolean "op AND" "op OR" bitNOT 0 max_word |
|
4250 |
by (rule word_boolean) |
|
4251 |
||
4252 |
lemma word_xor_and_or: |
|
4253 |
"x XOR y = x AND NOT y OR NOT x AND (y::'a::len0 word)" |
|
4254 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
|
4255 |
||
4256 |
interpretation word_bool_alg: |
|
4257 |
boolean_xor "op AND" "op OR" bitNOT 0 max_word "op XOR" |
|
4258 |
apply (rule boolean_xor.intro) |
|
4259 |
apply (rule word_boolean) |
|
4260 |
apply (rule boolean_xor_axioms.intro) |
|
4261 |
apply (rule word_xor_and_or) |
|
4262 |
done |
|
4263 |
||
4264 |
lemma shiftr_x_0 [iff]: |
|
4265 |
"(x::'a::len0 word) >> 0 = x" |
|
4266 |
by (simp add: shiftr_bl) |
|
4267 |
||
4268 |
lemma shiftl_x_0 [simp]: |
|
4269 |
"(x :: 'a :: len word) << 0 = x" |
|
4270 |
by (simp add: shiftl_t2n) |
|
4271 |
||
4272 |
lemma shiftl_1 [simp]: |
|
4273 |
"(1::'a::len word) << n = 2^n" |
|
4274 |
by (simp add: shiftl_t2n) |
|
4275 |
||
4276 |
lemma uint_lt_0 [simp]: |
|
4277 |
"uint x < 0 = False" |
|
4278 |
by (simp add: linorder_not_less) |
|
4279 |
||
4280 |
lemma shiftr1_1 [simp]: |
|
4281 |
"shiftr1 (1::'a::len word) = 0" |
|
45546
6dd3e88de4c2
HOL-Word: removed many duplicate theorems (see NEWS)
huffman
parents:
45545
diff
changeset
|
4282 |
by (simp add: shiftr1_def word_0_wi) |
37660 | 4283 |
|
4284 |
lemma shiftr_1[simp]: |
|
4285 |
"(1::'a::len word) >> n = (if n = 0 then 1 else 0)" |
|
4286 |
by (induct n) (auto simp: shiftr_def) |
|
4287 |
||
4288 |
lemma word_less_1 [simp]: |
|
4289 |
"((x::'a::len word) < 1) = (x = 0)" |
|
4290 |
by (simp add: word_less_nat_alt unat_0_iff) |
|
4291 |
||
4292 |
lemma to_bl_mask: |
|
4293 |
"to_bl (mask n :: 'a::len word) = |
|
4294 |
replicate (len_of TYPE('a) - n) False @ |
|
4295 |
replicate (min (len_of TYPE('a)) n) True" |
|
4296 |
by (simp add: mask_bl word_rep_drop min_def) |
|
4297 |
||
4298 |
lemma map_replicate_True: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4299 |
"n = length xs \<Longrightarrow> |
37660 | 4300 |
map (\<lambda>(x,y). x & y) (zip xs (replicate n True)) = xs" |
4301 |
by (induct xs arbitrary: n) auto |
|
4302 |
||
4303 |
lemma map_replicate_False: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4304 |
"n = length xs \<Longrightarrow> map (\<lambda>(x,y). x & y) |
37660 | 4305 |
(zip xs (replicate n False)) = replicate n False" |
4306 |
by (induct xs arbitrary: n) auto |
|
4307 |
||
4308 |
lemma bl_and_mask: |
|
4309 |
fixes w :: "'a::len word" |
|
4310 |
fixes n |
|
4311 |
defines "n' \<equiv> len_of TYPE('a) - n" |
|
4312 |
shows "to_bl (w AND mask n) = replicate n' False @ drop n' (to_bl w)" |
|
4313 |
proof - |
|
4314 |
note [simp] = map_replicate_True map_replicate_False |
|
4315 |
have "to_bl (w AND mask n) = |
|
4316 |
map2 op & (to_bl w) (to_bl (mask n::'a::len word))" |
|
4317 |
by (simp add: bl_word_and) |
|
4318 |
also |
|
4319 |
have "to_bl w = take n' (to_bl w) @ drop n' (to_bl w)" by simp |
|
4320 |
also |
|
4321 |
have "map2 op & \<dots> (to_bl (mask n::'a::len word)) = |
|
4322 |
replicate n' False @ drop n' (to_bl w)" |
|
4323 |
unfolding to_bl_mask n'_def map2_def |
|
4324 |
by (subst zip_append) auto |
|
4325 |
finally |
|
4326 |
show ?thesis . |
|
4327 |
qed |
|
4328 |
||
4329 |
lemma drop_rev_takefill: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4330 |
"length xs \<le> n \<Longrightarrow> |
37660 | 4331 |
drop (n - length xs) (rev (takefill False n (rev xs))) = xs" |
4332 |
by (simp add: takefill_alt rev_take) |
|
4333 |
||
4334 |
lemma map_nth_0 [simp]: |
|
4335 |
"map (op !! (0::'a::len0 word)) xs = replicate (length xs) False" |
|
4336 |
by (induct xs) auto |
|
4337 |
||
4338 |
lemma uint_plus_if_size: |
|
4339 |
"uint (x + y) = |
|
4340 |
(if uint x + uint y < 2^size x then |
|
4341 |
uint x + uint y |
|
4342 |
else |
|
4343 |
uint x + uint y - 2^size x)" |
|
4344 |
by (simp add: word_arith_alts int_word_uint mod_add_if_z |
|
4345 |
word_size) |
|
4346 |
||
4347 |
lemma unat_plus_if_size: |
|
4348 |
"unat (x + (y::'a::len word)) = |
|
4349 |
(if unat x + unat y < 2^size x then |
|
4350 |
unat x + unat y |
|
4351 |
else |
|
4352 |
unat x + unat y - 2^size x)" |
|
4353 |
apply (subst word_arith_nat_defs) |
|
4354 |
apply (subst unat_of_nat) |
|
4355 |
apply (simp add: mod_nat_add word_size) |
|
4356 |
done |
|
4357 |
||
44938
98e05fc1ce7d
removed word_neq_0_conv from simpset, it's almost never wanted.
kleing
parents:
44890
diff
changeset
|
4358 |
lemma word_neq_0_conv: |
37660 | 4359 |
fixes w :: "'a :: len word" |
4360 |
shows "(w \<noteq> 0) = (0 < w)" |
|
4361 |
proof - |
|
4362 |
have "0 \<le> w" by (rule word_zero_le) |
|
4363 |
thus ?thesis by (auto simp add: word_less_def) |
|
4364 |
qed |
|
4365 |
||
4366 |
lemma max_lt: |
|
4367 |
"unat (max a b div c) = unat (max a b) div unat (c:: 'a :: len word)" |
|
4368 |
apply (subst word_arith_nat_defs) |
|
4369 |
apply (subst word_unat.eq_norm) |
|
4370 |
apply (subst mod_if) |
|
4371 |
apply clarsimp |
|
4372 |
apply (erule notE) |
|
4373 |
apply (insert div_le_dividend [of "unat (max a b)" "unat c"]) |
|
4374 |
apply (erule order_le_less_trans) |
|
4375 |
apply (insert unat_lt2p [of "max a b"]) |
|
4376 |
apply simp |
|
4377 |
done |
|
4378 |
||
4379 |
lemma uint_sub_if_size: |
|
4380 |
"uint (x - y) = |
|
4381 |
(if uint y \<le> uint x then |
|
4382 |
uint x - uint y |
|
4383 |
else |
|
4384 |
uint x - uint y + 2^size x)" |
|
4385 |
by (simp add: word_arith_alts int_word_uint mod_sub_if_z |
|
4386 |
word_size) |
|
4387 |
||
4388 |
lemma unat_sub: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4389 |
"b <= a \<Longrightarrow> unat (a - b) = unat a - unat b" |
37660 | 4390 |
by (simp add: unat_def uint_sub_if_size word_le_def nat_diff_distrib) |
4391 |
||
45604 | 4392 |
lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "number_of w"] for w |
4393 |
lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "number_of w"] for w |
|
37660 | 4394 |
|
4395 |
lemma word_of_int_minus: |
|
4396 |
"word_of_int (2^len_of TYPE('a) - i) = (word_of_int (-i)::'a::len word)" |
|
4397 |
proof - |
|
4398 |
have x: "2^len_of TYPE('a) - i = -i + 2^len_of TYPE('a)" by simp |
|
4399 |
show ?thesis |
|
4400 |
apply (subst x) |
|
4401 |
apply (subst word_uint.Abs_norm [symmetric], subst mod_add_self2) |
|
4402 |
apply simp |
|
4403 |
done |
|
4404 |
qed |
|
4405 |
||
4406 |
lemmas word_of_int_inj = |
|
4407 |
word_uint.Abs_inject [unfolded uints_num, simplified] |
|
4408 |
||
4409 |
lemma word_le_less_eq: |
|
4410 |
"(x ::'z::len word) \<le> y = (x = y \<or> x < y)" |
|
4411 |
by (auto simp add: word_less_def) |
|
4412 |
||
4413 |
lemma mod_plus_cong: |
|
4414 |
assumes 1: "(b::int) = b'" |
|
4415 |
and 2: "x mod b' = x' mod b'" |
|
4416 |
and 3: "y mod b' = y' mod b'" |
|
4417 |
and 4: "x' + y' = z'" |
|
4418 |
shows "(x + y) mod b = z' mod b'" |
|
4419 |
proof - |
|
4420 |
from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'" |
|
4421 |
by (simp add: mod_add_eq[symmetric]) |
|
4422 |
also have "\<dots> = (x' + y') mod b'" |
|
4423 |
by (simp add: mod_add_eq[symmetric]) |
|
4424 |
finally show ?thesis by (simp add: 4) |
|
4425 |
qed |
|
4426 |
||
4427 |
lemma mod_minus_cong: |
|
4428 |
assumes 1: "(b::int) = b'" |
|
4429 |
and 2: "x mod b' = x' mod b'" |
|
4430 |
and 3: "y mod b' = y' mod b'" |
|
4431 |
and 4: "x' - y' = z'" |
|
4432 |
shows "(x - y) mod b = z' mod b'" |
|
4433 |
using assms |
|
4434 |
apply (subst zmod_zsub_left_eq) |
|
4435 |
apply (subst zmod_zsub_right_eq) |
|
4436 |
apply (simp add: zmod_zsub_left_eq [symmetric] zmod_zsub_right_eq [symmetric]) |
|
4437 |
done |
|
4438 |
||
4439 |
lemma word_induct_less: |
|
4440 |
"\<lbrakk>P (0::'a::len word); \<And>n. \<lbrakk>n < m; P n\<rbrakk> \<Longrightarrow> P (1 + n)\<rbrakk> \<Longrightarrow> P m" |
|
4441 |
apply (cases m) |
|
4442 |
apply atomize |
|
4443 |
apply (erule rev_mp)+ |
|
4444 |
apply (rule_tac x=m in spec) |
|
4445 |
apply (induct_tac n) |
|
4446 |
apply simp |
|
4447 |
apply clarsimp |
|
4448 |
apply (erule impE) |
|
4449 |
apply clarsimp |
|
4450 |
apply (erule_tac x=n in allE) |
|
4451 |
apply (erule impE) |
|
4452 |
apply (simp add: unat_arith_simps) |
|
4453 |
apply (clarsimp simp: unat_of_nat) |
|
4454 |
apply simp |
|
4455 |
apply (erule_tac x="of_nat na" in allE) |
|
4456 |
apply (erule impE) |
|
4457 |
apply (simp add: unat_arith_simps) |
|
4458 |
apply (clarsimp simp: unat_of_nat) |
|
4459 |
apply simp |
|
4460 |
done |
|
4461 |
||
4462 |
lemma word_induct: |
|
4463 |
"\<lbrakk>P (0::'a::len word); \<And>n. P n \<Longrightarrow> P (1 + n)\<rbrakk> \<Longrightarrow> P m" |
|
4464 |
by (erule word_induct_less, simp) |
|
4465 |
||
4466 |
lemma word_induct2 [induct type]: |
|
4467 |
"\<lbrakk>P 0; \<And>n. \<lbrakk>1 + n \<noteq> 0; P n\<rbrakk> \<Longrightarrow> P (1 + n)\<rbrakk> \<Longrightarrow> P (n::'b::len word)" |
|
4468 |
apply (rule word_induct, simp) |
|
4469 |
apply (case_tac "1+n = 0", auto) |
|
4470 |
done |
|
4471 |
||
4472 |
definition word_rec :: "'a \<Rightarrow> ('b::len word \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'b word \<Rightarrow> 'a" where |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4473 |
"word_rec forZero forSuc n = nat_rec forZero (forSuc \<circ> of_nat) (unat n)" |
37660 | 4474 |
|
4475 |
lemma word_rec_0: "word_rec z s 0 = z" |
|
4476 |
by (simp add: word_rec_def) |
|
4477 |
||
4478 |
lemma word_rec_Suc: |
|
4479 |
"1 + n \<noteq> (0::'a::len word) \<Longrightarrow> word_rec z s (1 + n) = s n (word_rec z s n)" |
|
4480 |
apply (simp add: word_rec_def unat_word_ariths) |
|
4481 |
apply (subst nat_mod_eq') |
|
4482 |
apply (cut_tac x=n in unat_lt2p) |
|
4483 |
apply (drule Suc_mono) |
|
4484 |
apply (simp add: less_Suc_eq_le) |
|
4485 |
apply (simp only: order_less_le, simp) |
|
4486 |
apply (erule contrapos_pn, simp) |
|
4487 |
apply (drule arg_cong[where f=of_nat]) |
|
4488 |
apply simp |
|
4489 |
apply (subst (asm) word_unat.Rep_inverse[of n]) |
|
4490 |
apply simp |
|
4491 |
apply simp |
|
4492 |
done |
|
4493 |
||
4494 |
lemma word_rec_Pred: |
|
4495 |
"n \<noteq> 0 \<Longrightarrow> word_rec z s n = s (n - 1) (word_rec z s (n - 1))" |
|
4496 |
apply (rule subst[where t="n" and s="1 + (n - 1)"]) |
|
4497 |
apply simp |
|
4498 |
apply (subst word_rec_Suc) |
|
4499 |
apply simp |
|
4500 |
apply simp |
|
4501 |
done |
|
4502 |
||
4503 |
lemma word_rec_in: |
|
4504 |
"f (word_rec z (\<lambda>_. f) n) = word_rec (f z) (\<lambda>_. f) n" |
|
4505 |
by (induct n) (simp_all add: word_rec_0 word_rec_Suc) |
|
4506 |
||
4507 |
lemma word_rec_in2: |
|
4508 |
"f n (word_rec z f n) = word_rec (f 0 z) (f \<circ> op + 1) n" |
|
4509 |
by (induct n) (simp_all add: word_rec_0 word_rec_Suc) |
|
4510 |
||
4511 |
lemma word_rec_twice: |
|
4512 |
"m \<le> n \<Longrightarrow> word_rec z f n = word_rec (word_rec z f (n - m)) (f \<circ> op + (n - m)) m" |
|
4513 |
apply (erule rev_mp) |
|
4514 |
apply (rule_tac x=z in spec) |
|
4515 |
apply (rule_tac x=f in spec) |
|
4516 |
apply (induct n) |
|
4517 |
apply (simp add: word_rec_0) |
|
4518 |
apply clarsimp |
|
4519 |
apply (rule_tac t="1 + n - m" and s="1 + (n - m)" in subst) |
|
4520 |
apply simp |
|
4521 |
apply (case_tac "1 + (n - m) = 0") |
|
4522 |
apply (simp add: word_rec_0) |
|
4523 |
apply (rule_tac f = "word_rec ?a ?b" in arg_cong) |
|
4524 |
apply (rule_tac t="m" and s="m + (1 + (n - m))" in subst) |
|
4525 |
apply simp |
|
4526 |
apply (simp (no_asm_use)) |
|
4527 |
apply (simp add: word_rec_Suc word_rec_in2) |
|
4528 |
apply (erule impE) |
|
4529 |
apply uint_arith |
|
4530 |
apply (drule_tac x="x \<circ> op + 1" in spec) |
|
4531 |
apply (drule_tac x="x 0 xa" in spec) |
|
4532 |
apply simp |
|
4533 |
apply (rule_tac t="\<lambda>a. x (1 + (n - m + a))" and s="\<lambda>a. x (1 + (n - m) + a)" |
|
4534 |
in subst) |
|
39302
d7728f65b353
renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
nipkow
parents:
39198
diff
changeset
|
4535 |
apply (clarsimp simp add: fun_eq_iff) |
37660 | 4536 |
apply (rule_tac t="(1 + (n - m + xb))" and s="1 + (n - m) + xb" in subst) |
4537 |
apply simp |
|
4538 |
apply (rule refl) |
|
4539 |
apply (rule refl) |
|
4540 |
done |
|
4541 |
||
4542 |
lemma word_rec_id: "word_rec z (\<lambda>_. id) n = z" |
|
4543 |
by (induct n) (auto simp add: word_rec_0 word_rec_Suc) |
|
4544 |
||
4545 |
lemma word_rec_id_eq: "\<forall>m < n. f m = id \<Longrightarrow> word_rec z f n = z" |
|
4546 |
apply (erule rev_mp) |
|
4547 |
apply (induct n) |
|
4548 |
apply (auto simp add: word_rec_0 word_rec_Suc) |
|
4549 |
apply (drule spec, erule mp) |
|
4550 |
apply uint_arith |
|
4551 |
apply (drule_tac x=n in spec, erule impE) |
|
4552 |
apply uint_arith |
|
4553 |
apply simp |
|
4554 |
done |
|
4555 |
||
4556 |
lemma word_rec_max: |
|
4557 |
"\<forall>m\<ge>n. m \<noteq> -1 \<longrightarrow> f m = id \<Longrightarrow> word_rec z f -1 = word_rec z f n" |
|
4558 |
apply (subst word_rec_twice[where n="-1" and m="-1 - n"]) |
|
4559 |
apply simp |
|
4560 |
apply simp |
|
4561 |
apply (rule word_rec_id_eq) |
|
4562 |
apply clarsimp |
|
4563 |
apply (drule spec, rule mp, erule mp) |
|
4564 |
apply (rule word_plus_mono_right2[OF _ order_less_imp_le]) |
|
4565 |
prefer 2 |
|
4566 |
apply assumption |
|
4567 |
apply simp |
|
4568 |
apply (erule contrapos_pn) |
|
4569 |
apply simp |
|
4570 |
apply (drule arg_cong[where f="\<lambda>x. x - n"]) |
|
4571 |
apply simp |
|
4572 |
done |
|
4573 |
||
4574 |
lemma unatSuc: |
|
4575 |
"1 + n \<noteq> (0::'a::len word) \<Longrightarrow> unat (1 + n) = Suc (unat n)" |
|
4576 |
by unat_arith |
|
4577 |
||
4578 |
||
45805 | 4579 |
lemma word_no_1 [simp]: "(Numeral1::'a::len0 word) = 1" |
4580 |
by (fact word_1_no [symmetric, unfolded BIT_simps]) |
|
4581 |
||
4582 |
lemma word_no_0 [simp]: "(Numeral0::'a::len0 word) = 0" |
|
4583 |
by (fact word_0_no [symmetric]) |
|
4584 |
||
37660 | 4585 |
declare bin_to_bl_def [simp] |
4586 |
||
4587 |
||
41060
4199fdcfa3c0
moved smt_word.ML into the directory of the Word library
boehmes
parents:
40827
diff
changeset
|
4588 |
use "~~/src/HOL/Word/Tools/smt_word.ML" |
37660 | 4589 |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
35049
diff
changeset
|
4590 |
setup {* SMT_Word.setup *} |
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
35049
diff
changeset
|
4591 |
|
45847 | 4592 |
text {* Legacy simp rules *} |
4593 |
declare BIT_simps [simp] |
|
4594 |
||
41060
4199fdcfa3c0
moved smt_word.ML into the directory of the Word library
boehmes
parents:
40827
diff
changeset
|
4595 |
end |