author | haftmann |
Mon, 10 Aug 2020 08:27:17 +0200 | |
changeset 72128 | 3707cf7b370b |
parent 72102 | 0b21b2beadb5 |
child 72130 | 9e5862223442 |
permissions | -rw-r--r-- |
29628 | 1 |
(* Title: HOL/Word/Word.thy |
46124 | 2 |
Author: Jeremy Dawson and Gerwin Klein, NICTA |
24333 | 3 |
*) |
4 |
||
61799 | 5 |
section \<open>A type of finite bit strings\<close> |
24350 | 6 |
|
29628 | 7 |
theory Word |
41413
64cd30d6b0b8
explicit file specifications -- avoid secondary load path;
wenzelm
parents:
41060
diff
changeset
|
8 |
imports |
66453
cc19f7ca2ed6
session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
wenzelm
parents:
65363
diff
changeset
|
9 |
"HOL-Library.Type_Length" |
cc19f7ca2ed6
session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
wenzelm
parents:
65363
diff
changeset
|
10 |
"HOL-Library.Boolean_Algebra" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
11 |
"HOL-Library.Bit_Operations" |
70190 | 12 |
Bits_Int |
72128 | 13 |
Traditional_Syntax |
70192 | 14 |
Bit_Comprehension |
53062
3af1a6020014
some vague grouping of related theorems, with slight tuning of headings and sorting out of dubious lemmas into separate theory
haftmann
parents:
51717
diff
changeset
|
15 |
Misc_Typedef |
37660 | 16 |
begin |
17 |
||
61799 | 18 |
subsection \<open>Type definition\<close> |
37660 | 19 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
20 |
quotient_type (overloaded) 'a word = int / \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a::len) l\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
21 |
morphisms rep_word word_of_int by (auto intro!: equivpI reflpI sympI transpI) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
22 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
23 |
lift_definition uint :: \<open>'a::len word \<Rightarrow> int\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
24 |
is \<open>take_bit LENGTH('a)\<close> . |
37660 | 25 |
|
65268 | 26 |
lemma uint_nonnegative: "0 \<le> uint w" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
27 |
by transfer simp |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
28 |
|
70185 | 29 |
lemma uint_bounded: "uint w < 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
30 |
for w :: "'a::len word" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
31 |
by transfer (simp add: take_bit_eq_mod) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
32 |
|
70185 | 33 |
lemma uint_idem: "uint w mod 2 ^ LENGTH('a) = uint w" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
34 |
for w :: "'a::len word" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
35 |
using uint_nonnegative uint_bounded by (rule mod_pos_pos_trivial) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
36 |
|
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
37 |
lemma word_uint_eqI: "uint a = uint b \<Longrightarrow> a = b" |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
38 |
by transfer simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
39 |
|
65268 | 40 |
lemma word_uint_eq_iff: "a = b \<longleftrightarrow> uint a = uint b" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
41 |
using word_uint_eqI by auto |
70185 | 42 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
43 |
lemma uint_word_of_int: "uint (word_of_int k :: 'a::len word) = k mod 2 ^ LENGTH('a)" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
44 |
by transfer (simp add: take_bit_eq_mod) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
45 |
|
65268 | 46 |
lemma word_of_int_uint: "word_of_int (uint w) = w" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
47 |
by transfer simp |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
48 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
49 |
lemma split_word_all: "(\<And>x::'a::len word. PROP P x) \<equiv> (\<And>x. PROP P (word_of_int x))" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
50 |
proof |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
51 |
fix x :: "'a word" |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
52 |
assume "\<And>x. PROP P (word_of_int x)" |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
53 |
then have "PROP P (word_of_int (uint x))" . |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
54 |
then show "PROP P x" by (simp add: word_of_int_uint) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
55 |
qed |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
56 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
57 |
|
61799 | 58 |
subsection \<open>Type conversions and casting\<close> |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
59 |
|
72079 | 60 |
lemma signed_take_bit_decr_length_iff: |
61 |
\<open>signed_take_bit (LENGTH('a::len) - Suc 0) k = signed_take_bit (LENGTH('a) - Suc 0) l |
|
62 |
\<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> |
|
63 |
by (cases \<open>LENGTH('a)\<close>) |
|
64 |
(simp_all add: signed_take_bit_eq_iff_take_bit_eq) |
|
65 |
||
66 |
lift_definition sint :: \<open>'a::len word \<Rightarrow> int\<close> |
|
67 |
\<comment> \<open>treats the most-significant bit as a sign bit\<close> |
|
68 |
is \<open>signed_take_bit (LENGTH('a) - 1)\<close> |
|
69 |
by (simp add: signed_take_bit_decr_length_iff) |
|
70 |
||
71 |
lemma sint_uint [code]: |
|
72 |
\<open>sint w = signed_take_bit (LENGTH('a) - 1) (uint w)\<close> |
|
73 |
for w :: \<open>'a::len word\<close> |
|
72128 | 74 |
by (cases \<open>LENGTH('a)\<close>; transfer) (simp_all add: signed_take_bit_take_bit) |
72079 | 75 |
|
76 |
lift_definition unat :: \<open>'a::len word \<Rightarrow> nat\<close> |
|
77 |
is \<open>nat \<circ> take_bit LENGTH('a)\<close> |
|
78 |
by transfer simp |
|
79 |
||
80 |
lemma nat_uint_eq [simp]: |
|
81 |
\<open>nat (uint w) = unat w\<close> |
|
82 |
by transfer simp |
|
83 |
||
84 |
lemma unat_eq_nat_uint [code]: |
|
85 |
\<open>unat w = nat (uint w)\<close> |
|
86 |
by simp |
|
87 |
||
88 |
lift_definition ucast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
89 |
is \<open>take_bit LENGTH('a)\<close> |
|
90 |
by simp |
|
91 |
||
92 |
lemma ucast_eq [code]: |
|
93 |
\<open>ucast w = word_of_int (uint w)\<close> |
|
94 |
by transfer simp |
|
95 |
||
96 |
lift_definition scast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
97 |
is \<open>signed_take_bit (LENGTH('a) - 1)\<close> |
|
98 |
by (simp flip: signed_take_bit_decr_length_iff) |
|
99 |
||
100 |
lemma scast_eq [code]: |
|
101 |
\<open>scast w = word_of_int (sint w)\<close> |
|
102 |
by transfer simp |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
103 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
104 |
instantiation word :: (len) size |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
105 |
begin |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
106 |
|
72079 | 107 |
lift_definition size_word :: \<open>'a word \<Rightarrow> nat\<close> |
108 |
is \<open>\<lambda>_. LENGTH('a)\<close> .. |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
109 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
110 |
instance .. |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
111 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
112 |
end |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
113 |
|
72079 | 114 |
lemma word_size [code]: |
115 |
\<open>size w = LENGTH('a)\<close> for w :: \<open>'a::len word\<close> |
|
116 |
by (fact size_word.rep_eq) |
|
117 |
||
65268 | 118 |
lemma word_size_gt_0 [iff]: "0 < size w" |
119 |
for w :: "'a::len word" |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
120 |
by (simp add: word_size) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
121 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
122 |
lemmas lens_gt_0 = word_size_gt_0 len_gt_0 |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
123 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
124 |
lemma lens_not_0 [iff]: |
71942 | 125 |
\<open>size w \<noteq> 0\<close> for w :: \<open>'a::len word\<close> |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
126 |
by auto |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
127 |
|
72079 | 128 |
lift_definition source_size :: \<open>('a::len word \<Rightarrow> 'b) \<Rightarrow> nat\<close> |
129 |
is \<open>\<lambda>_. LENGTH('a)\<close> . |
|
130 |
||
131 |
lift_definition target_size :: \<open>('a \<Rightarrow> 'b::len word) \<Rightarrow> nat\<close> |
|
132 |
is \<open>\<lambda>_. LENGTH('b)\<close> .. |
|
133 |
||
134 |
lift_definition is_up :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close> |
|
135 |
is \<open>\<lambda>_. LENGTH('a) \<le> LENGTH('b)\<close> .. |
|
136 |
||
137 |
lift_definition is_down :: \<open>('a::len word \<Rightarrow> 'b::len word) \<Rightarrow> bool\<close> |
|
138 |
is \<open>\<lambda>_. LENGTH('a) \<ge> LENGTH('b)\<close> .. |
|
139 |
||
140 |
lemma is_up_eq: |
|
141 |
\<open>is_up f \<longleftrightarrow> source_size f \<le> target_size f\<close> |
|
142 |
for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
143 |
by (simp add: source_size.rep_eq target_size.rep_eq is_up.rep_eq) |
|
144 |
||
145 |
lemma is_down_eq: |
|
146 |
\<open>is_down f \<longleftrightarrow> target_size f \<le> source_size f\<close> |
|
147 |
for f :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
148 |
by (simp add: source_size.rep_eq target_size.rep_eq is_down.rep_eq) |
|
149 |
||
150 |
lift_definition word_int_case :: \<open>(int \<Rightarrow> 'b) \<Rightarrow> 'a::len word \<Rightarrow> 'b\<close> |
|
151 |
is \<open>\<lambda>f. f \<circ> take_bit LENGTH('a)\<close> by simp |
|
152 |
||
153 |
lemma word_int_case_eq_uint [code]: |
|
154 |
\<open>word_int_case f w = f (uint w)\<close> |
|
155 |
by transfer simp |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
156 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
157 |
translations |
65268 | 158 |
"case x of XCONST of_int y \<Rightarrow> b" \<rightleftharpoons> "CONST word_int_case (\<lambda>y. b) x" |
159 |
"case x of (XCONST of_int :: 'a) y \<Rightarrow> b" \<rightharpoonup> "CONST word_int_case (\<lambda>y. b) x" |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
160 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
161 |
|
61799 | 162 |
subsection \<open>Basic code generation setup\<close> |
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
163 |
|
72079 | 164 |
lift_definition Word :: \<open>int \<Rightarrow> 'a::len word\<close> |
165 |
is id . |
|
166 |
||
167 |
lemma Word_eq_word_of_int [code_post]: |
|
168 |
\<open>Word = word_of_int\<close> |
|
169 |
by (simp add: fun_eq_iff Word.abs_eq) |
|
170 |
||
171 |
lemma [code abstype]: |
|
172 |
\<open>Word (uint w) = w\<close> |
|
173 |
by transfer simp |
|
174 |
||
175 |
lemma [code abstract]: |
|
176 |
\<open>uint (word_of_int k :: 'a::len word) = take_bit LENGTH('a) k\<close> |
|
177 |
by (fact uint.abs_eq) |
|
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
178 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
179 |
instantiation word :: (len) equal |
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
180 |
begin |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
181 |
|
72079 | 182 |
lift_definition equal_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> bool\<close> |
183 |
is \<open>\<lambda>k l. take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> |
|
184 |
by simp |
|
65268 | 185 |
|
186 |
instance |
|
72079 | 187 |
by (standard; transfer) rule |
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
188 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
189 |
end |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
190 |
|
72079 | 191 |
lemma [code]: |
192 |
\<open>HOL.equal k l \<longleftrightarrow> HOL.equal (uint k) (uint l)\<close> |
|
193 |
by transfer (simp add: equal) |
|
194 |
||
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
195 |
notation fcomp (infixl "\<circ>>" 60) |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
196 |
notation scomp (infixl "\<circ>\<rightarrow>" 60) |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
197 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
198 |
instantiation word :: ("{len, typerep}") random |
55817
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
199 |
begin |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
200 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
201 |
definition |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
202 |
"random_word i = Random.range i \<circ>\<rightarrow> (\<lambda>k. Pair ( |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
203 |
let j = word_of_int (int_of_integer (integer_of_natural k)) :: 'a word |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
204 |
in (j, \<lambda>_::unit. Code_Evaluation.term_of j)))" |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
205 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
206 |
instance .. |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
207 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
208 |
end |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
209 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
210 |
no_notation fcomp (infixl "\<circ>>" 60) |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
211 |
no_notation scomp (infixl "\<circ>\<rightarrow>" 60) |
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
212 |
|
0bc0217387a5
earlier setup of transfer, without dependency on psychodelic interpretations
haftmann
parents:
55816
diff
changeset
|
213 |
|
61799 | 214 |
subsection \<open>Type-definition locale instantiations\<close> |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
215 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
216 |
lemmas uint_0 = uint_nonnegative (* FIXME duplicate *) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
217 |
lemmas uint_lt = uint_bounded (* FIXME duplicate *) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
218 |
lemmas uint_mod_same = uint_idem (* FIXME duplicate *) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
219 |
|
72043 | 220 |
definition uints :: "nat \<Rightarrow> int set" |
221 |
\<comment> \<open>the sets of integers representing the words\<close> |
|
72128 | 222 |
where "uints n = range (take_bit n)" |
72043 | 223 |
|
224 |
definition sints :: "nat \<Rightarrow> int set" |
|
72128 | 225 |
where "sints n = range (signed_take_bit (n - 1))" |
72043 | 226 |
|
227 |
lemma uints_num: "uints n = {i. 0 \<le> i \<and> i < 2 ^ n}" |
|
228 |
by (simp add: uints_def range_bintrunc) |
|
229 |
||
230 |
lemma sints_num: "sints n = {i. - (2 ^ (n - 1)) \<le> i \<and> i < 2 ^ (n - 1)}" |
|
231 |
by (simp add: sints_def range_sbintrunc) |
|
232 |
||
233 |
definition unats :: "nat \<Rightarrow> nat set" |
|
234 |
where "unats n = {i. i < 2 ^ n}" |
|
235 |
||
236 |
\<comment> \<open>naturals\<close> |
|
237 |
lemma uints_unats: "uints n = int ` unats n" |
|
238 |
apply (unfold unats_def uints_num) |
|
239 |
apply safe |
|
240 |
apply (rule_tac image_eqI) |
|
241 |
apply (erule_tac nat_0_le [symmetric]) |
|
242 |
by auto |
|
243 |
||
244 |
lemma unats_uints: "unats n = nat ` uints n" |
|
245 |
by (auto simp: uints_unats image_iff) |
|
246 |
||
65268 | 247 |
lemma td_ext_uint: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
248 |
"td_ext (uint :: 'a word \<Rightarrow> int) word_of_int (uints (LENGTH('a::len))) |
70185 | 249 |
(\<lambda>w::int. w mod 2 ^ LENGTH('a))" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
250 |
apply (unfold td_ext_def') |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
251 |
apply transfer |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
252 |
apply (simp add: uints_num take_bit_eq_mod) |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
253 |
done |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
254 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
255 |
interpretation word_uint: |
65268 | 256 |
td_ext |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
257 |
"uint::'a::len word \<Rightarrow> int" |
65268 | 258 |
word_of_int |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
259 |
"uints (LENGTH('a::len))" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
260 |
"\<lambda>w. w mod 2 ^ LENGTH('a::len)" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
261 |
by (fact td_ext_uint) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
262 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
263 |
lemmas td_uint = word_uint.td_thm |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
264 |
lemmas int_word_uint = word_uint.eq_norm |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
265 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
266 |
lemma td_ext_ubin: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
267 |
"td_ext (uint :: 'a word \<Rightarrow> int) word_of_int (uints (LENGTH('a::len))) |
72128 | 268 |
(take_bit (LENGTH('a)))" |
269 |
apply standard |
|
270 |
apply transfer |
|
271 |
apply simp |
|
272 |
done |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
273 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
274 |
interpretation word_ubin: |
65268 | 275 |
td_ext |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
276 |
"uint::'a::len word \<Rightarrow> int" |
65268 | 277 |
word_of_int |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
278 |
"uints (LENGTH('a::len))" |
72128 | 279 |
"take_bit (LENGTH('a::len))" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
280 |
by (fact td_ext_ubin) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
281 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
282 |
|
61799 | 283 |
subsection \<open>Arithmetic operations\<close> |
37660 | 284 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
285 |
lift_definition word_succ :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x + 1" |
72128 | 286 |
by (auto simp add: take_bit_eq_mod intro: mod_add_cong) |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
287 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
288 |
lift_definition word_pred :: "'a::len word \<Rightarrow> 'a word" is "\<lambda>x. x - 1" |
72128 | 289 |
by (auto simp add: take_bit_eq_mod intro: mod_diff_cong) |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
290 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
291 |
instantiation word :: (len) "{neg_numeral, modulo, comm_monoid_mult, comm_ring}" |
37660 | 292 |
begin |
293 |
||
47387
a0f257197741
remove now-unnecessary type annotations from lift_definition commands
huffman
parents:
47377
diff
changeset
|
294 |
lift_definition zero_word :: "'a word" is "0" . |
a0f257197741
remove now-unnecessary type annotations from lift_definition commands
huffman
parents:
47377
diff
changeset
|
295 |
|
a0f257197741
remove now-unnecessary type annotations from lift_definition commands
huffman
parents:
47377
diff
changeset
|
296 |
lift_definition one_word :: "'a word" is "1" . |
a0f257197741
remove now-unnecessary type annotations from lift_definition commands
huffman
parents:
47377
diff
changeset
|
297 |
|
67399 | 298 |
lift_definition plus_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "(+)" |
72128 | 299 |
by (auto simp add: take_bit_eq_mod intro: mod_add_cong) |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
300 |
|
67399 | 301 |
lift_definition minus_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "(-)" |
72128 | 302 |
by (auto simp add: take_bit_eq_mod intro: mod_diff_cong) |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
303 |
|
47387
a0f257197741
remove now-unnecessary type annotations from lift_definition commands
huffman
parents:
47377
diff
changeset
|
304 |
lift_definition uminus_word :: "'a word \<Rightarrow> 'a word" is uminus |
72128 | 305 |
by (auto simp add: take_bit_eq_mod intro: mod_minus_cong) |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
306 |
|
69064
5840724b1d71
Prefix form of infix with * on either side no longer needs special treatment
nipkow
parents:
68157
diff
changeset
|
307 |
lift_definition times_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" is "(*)" |
72128 | 308 |
by (auto simp add: take_bit_eq_mod intro: mod_mult_cong) |
37660 | 309 |
|
71950 | 310 |
lift_definition divide_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" |
311 |
is "\<lambda>a b. take_bit LENGTH('a) a div take_bit LENGTH('a) b" |
|
312 |
by simp |
|
313 |
||
314 |
lift_definition modulo_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> 'a word" |
|
315 |
is "\<lambda>a b. take_bit LENGTH('a) a mod take_bit LENGTH('a) b" |
|
316 |
by simp |
|
37660 | 317 |
|
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
318 |
instance |
61169 | 319 |
by standard (transfer, simp add: algebra_simps)+ |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
320 |
|
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
321 |
end |
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
322 |
|
72079 | 323 |
lemma uint_0_eq [simp, code]: |
324 |
\<open>uint 0 = 0\<close> |
|
325 |
by transfer simp |
|
326 |
||
327 |
quickcheck_generator word |
|
328 |
constructors: |
|
329 |
\<open>0 :: 'a::len word\<close>, |
|
330 |
\<open>numeral :: num \<Rightarrow> 'a::len word\<close>, |
|
331 |
\<open>uminus :: 'a word \<Rightarrow> 'a::len word\<close> |
|
332 |
||
333 |
lemma uint_1_eq [simp, code]: |
|
334 |
\<open>uint 1 = 1\<close> |
|
335 |
by transfer simp |
|
336 |
||
71950 | 337 |
lemma word_div_def [code]: |
338 |
"a div b = word_of_int (uint a div uint b)" |
|
339 |
by transfer rule |
|
340 |
||
341 |
lemma word_mod_def [code]: |
|
342 |
"a mod b = word_of_int (uint a mod uint b)" |
|
343 |
by transfer rule |
|
344 |
||
345 |
context |
|
346 |
includes lifting_syntax |
|
347 |
notes power_transfer [transfer_rule] |
|
348 |
begin |
|
349 |
||
350 |
lemma power_transfer_word [transfer_rule]: |
|
351 |
\<open>(pcr_word ===> (=) ===> pcr_word) (^) (^)\<close> |
|
352 |
by transfer_prover |
|
353 |
||
354 |
end |
|
355 |
||
356 |
||
61799 | 357 |
text \<open>Legacy theorems:\<close> |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
358 |
|
72079 | 359 |
lemma word_arith_wis: |
360 |
shows word_add_def [code]: "a + b = word_of_int (uint a + uint b)" |
|
361 |
and word_sub_wi [code]: "a - b = word_of_int (uint a - uint b)" |
|
362 |
and word_mult_def [code]: "a * b = word_of_int (uint a * uint b)" |
|
363 |
and word_minus_def [code]: "- a = word_of_int (- uint a)" |
|
364 |
and word_succ_alt [code]: "word_succ a = word_of_int (uint a + 1)" |
|
365 |
and word_pred_alt [code]: "word_pred a = word_of_int (uint a - 1)" |
|
65268 | 366 |
and word_0_wi: "0 = word_of_int 0" |
367 |
and word_1_wi: "1 = word_of_int 1" |
|
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
368 |
apply (simp_all flip: plus_word.abs_eq minus_word.abs_eq |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
369 |
times_word.abs_eq uminus_word.abs_eq |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
370 |
zero_word.abs_eq one_word.abs_eq) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
371 |
apply transfer |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
372 |
apply simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
373 |
apply transfer |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
374 |
apply simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
375 |
done |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
376 |
|
65268 | 377 |
lemma wi_homs: |
378 |
shows wi_hom_add: "word_of_int a + word_of_int b = word_of_int (a + b)" |
|
379 |
and wi_hom_sub: "word_of_int a - word_of_int b = word_of_int (a - b)" |
|
380 |
and wi_hom_mult: "word_of_int a * word_of_int b = word_of_int (a * b)" |
|
381 |
and wi_hom_neg: "- word_of_int a = word_of_int (- a)" |
|
382 |
and wi_hom_succ: "word_succ (word_of_int a) = word_of_int (a + 1)" |
|
383 |
and wi_hom_pred: "word_pred (word_of_int a) = word_of_int (a - 1)" |
|
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
384 |
by (transfer, simp)+ |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
385 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
386 |
lemmas wi_hom_syms = wi_homs [symmetric] |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
387 |
|
46013 | 388 |
lemmas word_of_int_homs = wi_homs word_0_wi word_1_wi |
46009 | 389 |
|
390 |
lemmas word_of_int_hom_syms = word_of_int_homs [symmetric] |
|
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
391 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
392 |
instance word :: (len) comm_monoid_add .. |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
393 |
|
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
394 |
instance word :: (len) semiring_numeral .. |
71950 | 395 |
|
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
396 |
instance word :: (len) comm_ring_1 |
45810 | 397 |
proof |
70185 | 398 |
have *: "0 < LENGTH('a)" by (rule len_gt_0) |
65268 | 399 |
show "(0::'a word) \<noteq> 1" |
400 |
by transfer (use * in \<open>auto simp add: gr0_conv_Suc\<close>) |
|
45810 | 401 |
qed |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
402 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
403 |
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
|
404 |
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
|
405 |
|
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
406 |
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
|
407 |
apply (rule ext) |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
408 |
apply (case_tac x rule: int_diff_cases) |
46013 | 409 |
apply (simp add: word_of_nat wi_hom_sub) |
45545
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
410 |
done |
26aebb8ac9c1
Word.thy: rearrange to instantiate arithmetic classes together with arithmetic operations
huffman
parents:
45544
diff
changeset
|
411 |
|
71950 | 412 |
context |
413 |
includes lifting_syntax |
|
414 |
notes |
|
415 |
transfer_rule_of_bool [transfer_rule] |
|
416 |
transfer_rule_numeral [transfer_rule] |
|
417 |
transfer_rule_of_nat [transfer_rule] |
|
418 |
transfer_rule_of_int [transfer_rule] |
|
419 |
begin |
|
420 |
||
421 |
lemma [transfer_rule]: |
|
72102 | 422 |
"((=) ===> pcr_word) of_bool of_bool" |
71950 | 423 |
by transfer_prover |
424 |
||
425 |
lemma [transfer_rule]: |
|
72102 | 426 |
"((=) ===> pcr_word) numeral numeral" |
71950 | 427 |
by transfer_prover |
428 |
||
429 |
lemma [transfer_rule]: |
|
430 |
"((=) ===> pcr_word) int of_nat" |
|
431 |
by transfer_prover |
|
432 |
||
433 |
lemma [transfer_rule]: |
|
434 |
"((=) ===> pcr_word) (\<lambda>k. k) of_int" |
|
435 |
proof - |
|
436 |
have "((=) ===> pcr_word) of_int of_int" |
|
437 |
by transfer_prover |
|
438 |
then show ?thesis by (simp add: id_def) |
|
439 |
qed |
|
440 |
||
441 |
end |
|
442 |
||
443 |
lemma word_of_int_eq: |
|
444 |
"word_of_int = of_int" |
|
445 |
by (rule ext) (transfer, rule) |
|
446 |
||
65268 | 447 |
definition udvd :: "'a::len word \<Rightarrow> 'a::len word \<Rightarrow> bool" (infixl "udvd" 50) |
448 |
where "a udvd b = (\<exists>n\<ge>0. uint b = n * uint a)" |
|
37660 | 449 |
|
71950 | 450 |
context |
451 |
includes lifting_syntax |
|
452 |
begin |
|
453 |
||
454 |
lemma [transfer_rule]: |
|
71958 | 455 |
\<open>(pcr_word ===> (\<longleftrightarrow>)) even ((dvd) 2 :: 'a::len word \<Rightarrow> bool)\<close> |
71950 | 456 |
proof - |
457 |
have even_word_unfold: "even k \<longleftrightarrow> (\<exists>l. take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l))" (is "?P \<longleftrightarrow> ?Q") |
|
458 |
for k :: int |
|
459 |
proof |
|
460 |
assume ?P |
|
461 |
then show ?Q |
|
462 |
by auto |
|
463 |
next |
|
464 |
assume ?Q |
|
465 |
then obtain l where "take_bit LENGTH('a) k = take_bit LENGTH('a) (2 * l)" .. |
|
466 |
then have "even (take_bit LENGTH('a) k)" |
|
467 |
by simp |
|
468 |
then show ?P |
|
469 |
by simp |
|
470 |
qed |
|
471 |
show ?thesis by (simp only: even_word_unfold [abs_def] dvd_def [where ?'a = "'a word", abs_def]) |
|
472 |
transfer_prover |
|
473 |
qed |
|
474 |
||
475 |
end |
|
476 |
||
71951 | 477 |
instance word :: (len) semiring_modulo |
478 |
proof |
|
479 |
show "a div b * b + a mod b = a" for a b :: "'a word" |
|
480 |
proof transfer |
|
481 |
fix k l :: int |
|
482 |
define r :: int where "r = 2 ^ LENGTH('a)" |
|
483 |
then have r: "take_bit LENGTH('a) k = k mod r" for k |
|
484 |
by (simp add: take_bit_eq_mod) |
|
485 |
have "k mod r = ((k mod r) div (l mod r) * (l mod r) |
|
486 |
+ (k mod r) mod (l mod r)) mod r" |
|
487 |
by (simp add: div_mult_mod_eq) |
|
488 |
also have "... = (((k mod r) div (l mod r) * (l mod r)) mod r |
|
489 |
+ (k mod r) mod (l mod r)) mod r" |
|
490 |
by (simp add: mod_add_left_eq) |
|
491 |
also have "... = (((k mod r) div (l mod r) * l) mod r |
|
492 |
+ (k mod r) mod (l mod r)) mod r" |
|
493 |
by (simp add: mod_mult_right_eq) |
|
494 |
finally have "k mod r = ((k mod r) div (l mod r) * l |
|
495 |
+ (k mod r) mod (l mod r)) mod r" |
|
496 |
by (simp add: mod_simps) |
|
497 |
with r show "take_bit LENGTH('a) (take_bit LENGTH('a) k div take_bit LENGTH('a) l * l |
|
498 |
+ take_bit LENGTH('a) k mod take_bit LENGTH('a) l) = take_bit LENGTH('a) k" |
|
499 |
by simp |
|
500 |
qed |
|
501 |
qed |
|
502 |
||
503 |
instance word :: (len) semiring_parity |
|
504 |
proof |
|
505 |
show "\<not> 2 dvd (1::'a word)" |
|
506 |
by transfer simp |
|
507 |
show even_iff_mod_2_eq_0: "2 dvd a \<longleftrightarrow> a mod 2 = 0" |
|
508 |
for a :: "'a word" |
|
509 |
by transfer (simp_all add: mod_2_eq_odd take_bit_Suc) |
|
510 |
show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" |
|
511 |
for a :: "'a word" |
|
512 |
by transfer (simp_all add: mod_2_eq_odd take_bit_Suc) |
|
513 |
qed |
|
514 |
||
71953 | 515 |
lemma exp_eq_zero_iff: |
516 |
\<open>2 ^ n = (0 :: 'a::len word) \<longleftrightarrow> n \<ge> LENGTH('a)\<close> |
|
517 |
by transfer simp |
|
518 |
||
71958 | 519 |
lemma double_eq_zero_iff: |
520 |
\<open>2 * a = 0 \<longleftrightarrow> a = 0 \<or> a = 2 ^ (LENGTH('a) - Suc 0)\<close> |
|
521 |
for a :: \<open>'a::len word\<close> |
|
522 |
proof - |
|
523 |
define n where \<open>n = LENGTH('a) - Suc 0\<close> |
|
524 |
then have *: \<open>LENGTH('a) = Suc n\<close> |
|
525 |
by simp |
|
526 |
have \<open>a = 0\<close> if \<open>2 * a = 0\<close> and \<open>a \<noteq> 2 ^ (LENGTH('a) - Suc 0)\<close> |
|
527 |
using that by transfer |
|
528 |
(auto simp add: take_bit_eq_0_iff take_bit_eq_mod *) |
|
529 |
moreover have \<open>2 ^ LENGTH('a) = (0 :: 'a word)\<close> |
|
530 |
by transfer simp |
|
531 |
then have \<open>2 * 2 ^ (LENGTH('a) - Suc 0) = (0 :: 'a word)\<close> |
|
532 |
by (simp add: *) |
|
533 |
ultimately show ?thesis |
|
534 |
by auto |
|
535 |
qed |
|
536 |
||
45547 | 537 |
|
61799 | 538 |
subsection \<open>Ordering\<close> |
45547 | 539 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
540 |
instantiation word :: (len) linorder |
45547 | 541 |
begin |
542 |
||
71950 | 543 |
lift_definition less_eq_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool" |
544 |
is "\<lambda>a b. take_bit LENGTH('a) a \<le> take_bit LENGTH('a) b" |
|
545 |
by simp |
|
546 |
||
547 |
lift_definition less_word :: "'a word \<Rightarrow> 'a word \<Rightarrow> bool" |
|
548 |
is "\<lambda>a b. take_bit LENGTH('a) a < take_bit LENGTH('a) b" |
|
549 |
by simp |
|
37660 | 550 |
|
45547 | 551 |
instance |
71950 | 552 |
by (standard; transfer) auto |
45547 | 553 |
|
554 |
end |
|
555 |
||
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
556 |
interpretation word_order: ordering_top \<open>(\<le>)\<close> \<open>(<)\<close> \<open>- 1 :: 'a::len word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
557 |
by (standard; transfer) (simp add: take_bit_eq_mod zmod_minus1) |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
558 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
559 |
interpretation word_coorder: ordering_top \<open>(\<ge>)\<close> \<open>(>)\<close> \<open>0 :: 'a::len word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
560 |
by (standard; transfer) simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
561 |
|
71950 | 562 |
lemma word_le_def [code]: |
563 |
"a \<le> b \<longleftrightarrow> uint a \<le> uint b" |
|
564 |
by transfer rule |
|
565 |
||
566 |
lemma word_less_def [code]: |
|
567 |
"a < b \<longleftrightarrow> uint a < uint b" |
|
568 |
by transfer rule |
|
569 |
||
71951 | 570 |
lemma word_greater_zero_iff: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
571 |
\<open>a > 0 \<longleftrightarrow> a \<noteq> 0\<close> for a :: \<open>'a::len word\<close> |
71951 | 572 |
by transfer (simp add: less_le) |
573 |
||
574 |
lemma of_nat_word_eq_iff: |
|
575 |
\<open>of_nat m = (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m = take_bit LENGTH('a) n\<close> |
|
576 |
by transfer (simp add: take_bit_of_nat) |
|
577 |
||
578 |
lemma of_nat_word_less_eq_iff: |
|
579 |
\<open>of_nat m \<le> (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m \<le> take_bit LENGTH('a) n\<close> |
|
580 |
by transfer (simp add: take_bit_of_nat) |
|
581 |
||
582 |
lemma of_nat_word_less_iff: |
|
583 |
\<open>of_nat m < (of_nat n :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) m < take_bit LENGTH('a) n\<close> |
|
584 |
by transfer (simp add: take_bit_of_nat) |
|
585 |
||
586 |
lemma of_nat_word_eq_0_iff: |
|
587 |
\<open>of_nat n = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd n\<close> |
|
588 |
using of_nat_word_eq_iff [where ?'a = 'a, of n 0] by (simp add: take_bit_eq_0_iff) |
|
589 |
||
590 |
lemma of_int_word_eq_iff: |
|
591 |
\<open>of_int k = (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> |
|
592 |
by transfer rule |
|
593 |
||
594 |
lemma of_int_word_less_eq_iff: |
|
595 |
\<open>of_int k \<le> (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k \<le> take_bit LENGTH('a) l\<close> |
|
596 |
by transfer rule |
|
597 |
||
598 |
lemma of_int_word_less_iff: |
|
599 |
\<open>of_int k < (of_int l :: 'a::len word) \<longleftrightarrow> take_bit LENGTH('a) k < take_bit LENGTH('a) l\<close> |
|
600 |
by transfer rule |
|
601 |
||
602 |
lemma of_int_word_eq_0_iff: |
|
603 |
\<open>of_int k = (0 :: 'a::len word) \<longleftrightarrow> 2 ^ LENGTH('a) dvd k\<close> |
|
604 |
using of_int_word_eq_iff [where ?'a = 'a, of k 0] by (simp add: take_bit_eq_0_iff) |
|
605 |
||
72079 | 606 |
lift_definition word_sle :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close> (\<open>(_/ <=s _)\<close> [50, 51] 50) |
607 |
is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - 1) k \<le> signed_take_bit (LENGTH('a) - 1) l\<close> |
|
608 |
by (simp flip: signed_take_bit_decr_length_iff) |
|
609 |
||
610 |
lemma word_sle_eq [code]: |
|
611 |
\<open>a <=s b \<longleftrightarrow> sint a \<le> sint b\<close> |
|
612 |
by transfer simp |
|
613 |
||
614 |
lift_definition word_sless :: \<open>'a::len word \<Rightarrow> 'a word \<Rightarrow> bool\<close> (\<open>(_/ <s _)\<close> [50, 51] 50) |
|
615 |
is \<open>\<lambda>k l. signed_take_bit (LENGTH('a) - 1) k < signed_take_bit (LENGTH('a) - 1) l\<close> |
|
616 |
by (simp flip: signed_take_bit_decr_length_iff) |
|
617 |
||
618 |
lemma word_sless_eq: |
|
619 |
\<open>x <s y \<longleftrightarrow> x <=s y \<and> x \<noteq> y\<close> |
|
620 |
by transfer (simp add: signed_take_bit_decr_length_iff less_le) |
|
621 |
||
622 |
lemma [code]: |
|
623 |
\<open>a <s b \<longleftrightarrow> sint a < sint b\<close> |
|
624 |
by transfer simp |
|
37660 | 625 |
|
626 |
||
61799 | 627 |
subsection \<open>Bit-wise operations\<close> |
37660 | 628 |
|
71951 | 629 |
lemma word_bit_induct [case_names zero even odd]: |
630 |
\<open>P a\<close> if word_zero: \<open>P 0\<close> |
|
631 |
and word_even: \<open>\<And>a. P a \<Longrightarrow> 0 < a \<Longrightarrow> a < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> P (2 * a)\<close> |
|
632 |
and word_odd: \<open>\<And>a. P a \<Longrightarrow> a < 2 ^ (LENGTH('a) - 1) \<Longrightarrow> P (1 + 2 * a)\<close> |
|
633 |
for P and a :: \<open>'a::len word\<close> |
|
634 |
proof - |
|
635 |
define m :: nat where \<open>m = LENGTH('a) - 1\<close> |
|
636 |
then have l: \<open>LENGTH('a) = Suc m\<close> |
|
637 |
by simp |
|
638 |
define n :: nat where \<open>n = unat a\<close> |
|
639 |
then have \<open>n < 2 ^ LENGTH('a)\<close> |
|
640 |
by (unfold unat_def) (transfer, simp add: take_bit_eq_mod) |
|
641 |
then have \<open>n < 2 * 2 ^ m\<close> |
|
642 |
by (simp add: l) |
|
643 |
then have \<open>P (of_nat n)\<close> |
|
644 |
proof (induction n rule: nat_bit_induct) |
|
645 |
case zero |
|
646 |
show ?case |
|
647 |
by simp (rule word_zero) |
|
648 |
next |
|
649 |
case (even n) |
|
650 |
then have \<open>n < 2 ^ m\<close> |
|
651 |
by simp |
|
652 |
with even.IH have \<open>P (of_nat n)\<close> |
|
653 |
by simp |
|
654 |
moreover from \<open>n < 2 ^ m\<close> even.hyps have \<open>0 < (of_nat n :: 'a word)\<close> |
|
655 |
by (auto simp add: word_greater_zero_iff of_nat_word_eq_0_iff l) |
|
656 |
moreover from \<open>n < 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - 1)\<close> |
|
657 |
using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>] |
|
658 |
by (cases \<open>m = 0\<close>) (simp_all add: not_less take_bit_eq_self ac_simps l) |
|
659 |
ultimately have \<open>P (2 * of_nat n)\<close> |
|
660 |
by (rule word_even) |
|
661 |
then show ?case |
|
662 |
by simp |
|
663 |
next |
|
664 |
case (odd n) |
|
665 |
then have \<open>Suc n \<le> 2 ^ m\<close> |
|
666 |
by simp |
|
667 |
with odd.IH have \<open>P (of_nat n)\<close> |
|
668 |
by simp |
|
669 |
moreover from \<open>Suc n \<le> 2 ^ m\<close> have \<open>(of_nat n :: 'a word) < 2 ^ (LENGTH('a) - 1)\<close> |
|
670 |
using of_nat_word_less_iff [where ?'a = 'a, of n \<open>2 ^ m\<close>] |
|
671 |
by (cases \<open>m = 0\<close>) (simp_all add: not_less take_bit_eq_self ac_simps l) |
|
672 |
ultimately have \<open>P (1 + 2 * of_nat n)\<close> |
|
673 |
by (rule word_odd) |
|
674 |
then show ?case |
|
675 |
by simp |
|
676 |
qed |
|
677 |
moreover have \<open>of_nat (nat (uint a)) = a\<close> |
|
678 |
by transfer simp |
|
679 |
ultimately show ?thesis |
|
72079 | 680 |
by (simp add: n_def) |
71951 | 681 |
qed |
682 |
||
683 |
lemma bit_word_half_eq: |
|
684 |
\<open>(of_bool b + a * 2) div 2 = a\<close> |
|
685 |
if \<open>a < 2 ^ (LENGTH('a) - Suc 0)\<close> |
|
686 |
for a :: \<open>'a::len word\<close> |
|
687 |
proof (cases \<open>2 \<le> LENGTH('a::len)\<close>) |
|
688 |
case False |
|
689 |
have \<open>of_bool (odd k) < (1 :: int) \<longleftrightarrow> even k\<close> for k :: int |
|
690 |
by auto |
|
691 |
with False that show ?thesis |
|
692 |
by transfer (simp add: eq_iff) |
|
693 |
next |
|
694 |
case True |
|
695 |
obtain n where length: \<open>LENGTH('a) = Suc n\<close> |
|
696 |
by (cases \<open>LENGTH('a)\<close>) simp_all |
|
697 |
show ?thesis proof (cases b) |
|
698 |
case False |
|
699 |
moreover have \<open>a * 2 div 2 = a\<close> |
|
700 |
using that proof transfer |
|
701 |
fix k :: int |
|
702 |
from length have \<open>k * 2 mod 2 ^ LENGTH('a) = (k mod 2 ^ n) * 2\<close> |
|
703 |
by simp |
|
704 |
moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close> |
|
705 |
with \<open>LENGTH('a) = Suc n\<close> |
|
706 |
have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close> |
|
707 |
by (simp add: take_bit_eq_mod divmod_digit_0) |
|
708 |
ultimately have \<open>take_bit LENGTH('a) (k * 2) = take_bit LENGTH('a) k * 2\<close> |
|
709 |
by (simp add: take_bit_eq_mod) |
|
710 |
with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (k * 2) div take_bit LENGTH('a) 2) |
|
711 |
= take_bit LENGTH('a) k\<close> |
|
712 |
by simp |
|
713 |
qed |
|
714 |
ultimately show ?thesis |
|
715 |
by simp |
|
716 |
next |
|
717 |
case True |
|
718 |
moreover have \<open>(1 + a * 2) div 2 = a\<close> |
|
719 |
using that proof transfer |
|
720 |
fix k :: int |
|
721 |
from length have \<open>(1 + k * 2) mod 2 ^ LENGTH('a) = 1 + (k mod 2 ^ n) * 2\<close> |
|
722 |
using pos_zmod_mult_2 [of \<open>2 ^ n\<close> k] by (simp add: ac_simps) |
|
723 |
moreover assume \<open>take_bit LENGTH('a) k < take_bit LENGTH('a) (2 ^ (LENGTH('a) - Suc 0))\<close> |
|
724 |
with \<open>LENGTH('a) = Suc n\<close> |
|
725 |
have \<open>k mod 2 ^ LENGTH('a) = k mod 2 ^ n\<close> |
|
726 |
by (simp add: take_bit_eq_mod divmod_digit_0) |
|
727 |
ultimately have \<open>take_bit LENGTH('a) (1 + k * 2) = 1 + take_bit LENGTH('a) k * 2\<close> |
|
728 |
by (simp add: take_bit_eq_mod) |
|
729 |
with True show \<open>take_bit LENGTH('a) (take_bit LENGTH('a) (1 + k * 2) div take_bit LENGTH('a) 2) |
|
730 |
= take_bit LENGTH('a) k\<close> |
|
731 |
by (auto simp add: take_bit_Suc) |
|
732 |
qed |
|
733 |
ultimately show ?thesis |
|
734 |
by simp |
|
735 |
qed |
|
736 |
qed |
|
737 |
||
738 |
lemma even_mult_exp_div_word_iff: |
|
739 |
\<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> \<not> ( |
|
740 |
m \<le> n \<and> |
|
741 |
n < LENGTH('a) \<and> odd (a div 2 ^ (n - m)))\<close> for a :: \<open>'a::len word\<close> |
|
742 |
by transfer |
|
743 |
(auto simp flip: drop_bit_eq_div simp add: even_drop_bit_iff_not_bit bit_take_bit_iff, |
|
744 |
simp_all flip: push_bit_eq_mult add: bit_push_bit_iff_int) |
|
745 |
||
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
746 |
instantiation word :: (len) semiring_bits |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
747 |
begin |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
748 |
|
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
749 |
lift_definition bit_word :: \<open>'a word \<Rightarrow> nat \<Rightarrow> bool\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
750 |
is \<open>\<lambda>k n. n < LENGTH('a) \<and> bit k n\<close> |
71951 | 751 |
proof |
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
752 |
fix k l :: int and n :: nat |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
753 |
assume *: \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
754 |
show \<open>n < LENGTH('a) \<and> bit k n \<longleftrightarrow> n < LENGTH('a) \<and> bit l n\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
755 |
proof (cases \<open>n < LENGTH('a)\<close>) |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
756 |
case True |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
757 |
from * have \<open>bit (take_bit LENGTH('a) k) n \<longleftrightarrow> bit (take_bit LENGTH('a) l) n\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
758 |
by simp |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
759 |
then show ?thesis |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
760 |
by (simp add: bit_take_bit_iff) |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
761 |
next |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
762 |
case False |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
763 |
then show ?thesis |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
764 |
by simp |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
765 |
qed |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
766 |
qed |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
767 |
|
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
768 |
instance proof |
71951 | 769 |
show \<open>P a\<close> if stable: \<open>\<And>a. a div 2 = a \<Longrightarrow> P a\<close> |
770 |
and rec: \<open>\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a)\<close> |
|
771 |
for P and a :: \<open>'a word\<close> |
|
772 |
proof (induction a rule: word_bit_induct) |
|
773 |
case zero |
|
774 |
have \<open>0 div 2 = (0::'a word)\<close> |
|
775 |
by transfer simp |
|
776 |
with stable [of 0] show ?case |
|
777 |
by simp |
|
778 |
next |
|
779 |
case (even a) |
|
780 |
with rec [of a False] show ?case |
|
781 |
using bit_word_half_eq [of a False] by (simp add: ac_simps) |
|
782 |
next |
|
783 |
case (odd a) |
|
784 |
with rec [of a True] show ?case |
|
785 |
using bit_word_half_eq [of a True] by (simp add: ac_simps) |
|
786 |
qed |
|
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
787 |
show \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close> for a :: \<open>'a word\<close> and n |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
788 |
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit bit_iff_odd_drop_bit) |
71951 | 789 |
show \<open>0 div a = 0\<close> |
790 |
for a :: \<open>'a word\<close> |
|
791 |
by transfer simp |
|
792 |
show \<open>a div 1 = a\<close> |
|
793 |
for a :: \<open>'a word\<close> |
|
794 |
by transfer simp |
|
795 |
show \<open>a mod b div b = 0\<close> |
|
796 |
for a b :: \<open>'a word\<close> |
|
797 |
apply transfer |
|
798 |
apply (simp add: take_bit_eq_mod) |
|
799 |
apply (subst (3) mod_pos_pos_trivial [of _ \<open>2 ^ LENGTH('a)\<close>]) |
|
800 |
apply simp_all |
|
801 |
apply (metis le_less mod_by_0 pos_mod_conj zero_less_numeral zero_less_power) |
|
802 |
using pos_mod_bound [of \<open>2 ^ LENGTH('a)\<close>] apply simp |
|
803 |
proof - |
|
804 |
fix aa :: int and ba :: int |
|
805 |
have f1: "\<And>i n. (i::int) mod 2 ^ n = 0 \<or> 0 < i mod 2 ^ n" |
|
806 |
by (metis le_less take_bit_eq_mod take_bit_nonnegative) |
|
807 |
have "(0::int) < 2 ^ len_of (TYPE('a)::'a itself) \<and> ba mod 2 ^ len_of (TYPE('a)::'a itself) \<noteq> 0 \<or> aa mod 2 ^ len_of (TYPE('a)::'a itself) mod (ba mod 2 ^ len_of (TYPE('a)::'a itself)) < 2 ^ len_of (TYPE('a)::'a itself)" |
|
808 |
by (metis (no_types) mod_by_0 unique_euclidean_semiring_numeral_class.pos_mod_bound zero_less_numeral zero_less_power) |
|
809 |
then show "aa mod 2 ^ len_of (TYPE('a)::'a itself) mod (ba mod 2 ^ len_of (TYPE('a)::'a itself)) < 2 ^ len_of (TYPE('a)::'a itself)" |
|
810 |
using f1 by (meson le_less less_le_trans unique_euclidean_semiring_numeral_class.pos_mod_bound) |
|
811 |
qed |
|
812 |
show \<open>(1 + a) div 2 = a div 2\<close> |
|
813 |
if \<open>even a\<close> |
|
814 |
for a :: \<open>'a word\<close> |
|
71953 | 815 |
using that by transfer |
816 |
(auto dest: le_Suc_ex simp add: mod_2_eq_odd take_bit_Suc elim!: evenE) |
|
71951 | 817 |
show \<open>(2 :: 'a word) ^ m div 2 ^ n = of_bool ((2 :: 'a word) ^ m \<noteq> 0 \<and> n \<le> m) * 2 ^ (m - n)\<close> |
818 |
for m n :: nat |
|
819 |
by transfer (simp, simp add: exp_div_exp_eq) |
|
820 |
show "a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)" |
|
821 |
for a :: "'a word" and m n :: nat |
|
822 |
apply transfer |
|
823 |
apply (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: drop_bit_eq_div) |
|
824 |
apply (simp add: drop_bit_take_bit) |
|
825 |
done |
|
826 |
show "a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n" |
|
827 |
for a :: "'a word" and m n :: nat |
|
828 |
by transfer (auto simp flip: take_bit_eq_mod simp add: ac_simps) |
|
829 |
show \<open>a * 2 ^ m mod 2 ^ n = a mod 2 ^ (n - m) * 2 ^ m\<close> |
|
830 |
if \<open>m \<le> n\<close> for a :: "'a word" and m n :: nat |
|
831 |
using that apply transfer |
|
832 |
apply (auto simp flip: take_bit_eq_mod) |
|
833 |
apply (auto simp flip: push_bit_eq_mult simp add: push_bit_take_bit split: split_min_lin) |
|
834 |
done |
|
835 |
show \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close> |
|
836 |
for a :: "'a word" and m n :: nat |
|
837 |
by transfer (auto simp add: not_less take_bit_drop_bit ac_simps simp flip: take_bit_eq_mod drop_bit_eq_div split: split_min_lin) |
|
838 |
show \<open>even ((2 ^ m - 1) div (2::'a word) ^ n) \<longleftrightarrow> 2 ^ n = (0::'a word) \<or> m \<le> n\<close> |
|
839 |
for m n :: nat |
|
840 |
by transfer (auto simp add: take_bit_of_mask even_mask_div_iff) |
|
841 |
show \<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> n < m \<or> (2::'a word) ^ n = 0 \<or> m \<le> n \<and> even (a div 2 ^ (n - m))\<close> |
|
842 |
for a :: \<open>'a word\<close> and m n :: nat |
|
843 |
proof transfer |
|
844 |
show \<open>even (take_bit LENGTH('a) (k * 2 ^ m) div take_bit LENGTH('a) (2 ^ n)) \<longleftrightarrow> |
|
845 |
n < m |
|
846 |
\<or> take_bit LENGTH('a) ((2::int) ^ n) = take_bit LENGTH('a) 0 |
|
847 |
\<or> (m \<le> n \<and> even (take_bit LENGTH('a) k div take_bit LENGTH('a) (2 ^ (n - m))))\<close> |
|
848 |
for m n :: nat and k l :: int |
|
849 |
by (auto simp flip: take_bit_eq_mod drop_bit_eq_div push_bit_eq_mult |
|
850 |
simp add: div_push_bit_of_1_eq_drop_bit drop_bit_take_bit drop_bit_push_bit_int [of n m]) |
|
851 |
qed |
|
852 |
qed |
|
853 |
||
854 |
end |
|
855 |
||
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
856 |
instantiation word :: (len) semiring_bit_shifts |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
857 |
begin |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
858 |
|
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
859 |
lift_definition push_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
860 |
is push_bit |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
861 |
proof - |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
862 |
show \<open>take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
863 |
if \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> for k l :: int and n :: nat |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
864 |
proof - |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
865 |
from that |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
866 |
have \<open>take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k) |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
867 |
= take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
868 |
by simp |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
869 |
moreover have \<open>min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
870 |
by simp |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
871 |
ultimately show ?thesis |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
872 |
by (simp add: take_bit_push_bit) |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
873 |
qed |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
874 |
qed |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
875 |
|
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
876 |
lift_definition drop_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
877 |
is \<open>\<lambda>n. drop_bit n \<circ> take_bit LENGTH('a)\<close> |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
878 |
by (simp add: take_bit_eq_mod) |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
879 |
|
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
880 |
lift_definition take_bit_word :: \<open>nat \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
881 |
is \<open>\<lambda>n. take_bit (min LENGTH('a) n)\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
882 |
by (simp add: ac_simps) (simp only: flip: take_bit_take_bit) |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
883 |
|
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
884 |
instance proof |
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
885 |
show \<open>push_bit n a = a * 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close> |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
886 |
by transfer (simp add: push_bit_eq_mult) |
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
887 |
show \<open>drop_bit n a = a div 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close> |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
888 |
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit) |
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
889 |
show \<open>take_bit n a = a mod 2 ^ n\<close> for n :: nat and a :: \<open>'a word\<close> |
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
890 |
by transfer (auto simp flip: take_bit_eq_mod) |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
891 |
qed |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
892 |
|
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
893 |
end |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
894 |
|
71958 | 895 |
lemma bit_word_eqI: |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
896 |
\<open>a = b\<close> if \<open>\<And>n. n < LENGTH('a) \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close> |
71990 | 897 |
for a b :: \<open>'a::len word\<close> |
898 |
using that by transfer (auto simp add: nat_less_le bit_eq_iff bit_take_bit_iff) |
|
899 |
||
900 |
lemma bit_imp_le_length: |
|
901 |
\<open>n < LENGTH('a)\<close> if \<open>bit w n\<close> |
|
902 |
for w :: \<open>'a::len word\<close> |
|
903 |
using that by transfer simp |
|
904 |
||
905 |
lemma not_bit_length [simp]: |
|
906 |
\<open>\<not> bit w LENGTH('a)\<close> for w :: \<open>'a::len word\<close> |
|
907 |
by transfer simp |
|
908 |
||
72079 | 909 |
lemma uint_take_bit_eq [code]: |
910 |
\<open>uint (take_bit n w) = take_bit n (uint w)\<close> |
|
911 |
by transfer (simp add: ac_simps) |
|
912 |
||
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
913 |
lemma take_bit_length_eq [simp]: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
914 |
\<open>take_bit LENGTH('a) w = w\<close> for w :: \<open>'a::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
915 |
by transfer simp |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
916 |
|
71990 | 917 |
lemma bit_word_of_int_iff: |
918 |
\<open>bit (word_of_int k :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> bit k n\<close> |
|
919 |
by transfer rule |
|
920 |
||
921 |
lemma bit_uint_iff: |
|
922 |
\<open>bit (uint w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w n\<close> |
|
923 |
for w :: \<open>'a::len word\<close> |
|
924 |
by transfer (simp add: bit_take_bit_iff) |
|
925 |
||
926 |
lemma bit_sint_iff: |
|
927 |
\<open>bit (sint w) n \<longleftrightarrow> n \<ge> LENGTH('a) \<and> bit w (LENGTH('a) - 1) \<or> bit w n\<close> |
|
928 |
for w :: \<open>'a::len word\<close> |
|
72079 | 929 |
by transfer (auto simp add: bit_signed_take_bit_iff min_def le_less not_less) |
71990 | 930 |
|
931 |
lemma bit_word_ucast_iff: |
|
932 |
\<open>bit (ucast w :: 'b::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> n < LENGTH('b) \<and> bit w n\<close> |
|
933 |
for w :: \<open>'a::len word\<close> |
|
72079 | 934 |
by transfer (simp add: bit_take_bit_iff ac_simps) |
71990 | 935 |
|
936 |
lemma bit_word_scast_iff: |
|
937 |
\<open>bit (scast w :: 'b::len word) n \<longleftrightarrow> |
|
938 |
n < LENGTH('b) \<and> (bit w n \<or> LENGTH('a) \<le> n \<and> bit w (LENGTH('a) - Suc 0))\<close> |
|
939 |
for w :: \<open>'a::len word\<close> |
|
72079 | 940 |
by transfer (auto simp add: bit_signed_take_bit_iff le_less min_def) |
941 |
||
942 |
lift_definition shiftl1 :: \<open>'a::len word \<Rightarrow> 'a word\<close> |
|
943 |
is \<open>(*) 2\<close> |
|
944 |
by (auto simp add: take_bit_eq_mod intro: mod_mult_cong) |
|
945 |
||
946 |
lemma shiftl1_eq: |
|
947 |
\<open>shiftl1 w = word_of_int (2 * uint w)\<close> |
|
948 |
by transfer (simp add: take_bit_eq_mod mod_simps) |
|
70191 | 949 |
|
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
950 |
lemma shiftl1_eq_mult_2: |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
951 |
\<open>shiftl1 = (*) 2\<close> |
72079 | 952 |
by (rule ext, transfer) simp |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
953 |
|
71990 | 954 |
lemma bit_shiftl1_iff: |
955 |
\<open>bit (shiftl1 w) n \<longleftrightarrow> 0 < n \<and> n < LENGTH('a) \<and> bit w (n - 1)\<close> |
|
956 |
for w :: \<open>'a::len word\<close> |
|
957 |
by (simp add: shiftl1_eq_mult_2 bit_double_iff exp_eq_zero_iff not_le) (simp add: ac_simps) |
|
958 |
||
72079 | 959 |
lift_definition shiftr1 :: \<open>'a::len word \<Rightarrow> 'a word\<close> |
70191 | 960 |
\<comment> \<open>shift right as unsigned or as signed, ie logical or arithmetic\<close> |
72079 | 961 |
is \<open>\<lambda>k. take_bit LENGTH('a) k div 2\<close> by simp |
70191 | 962 |
|
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
963 |
lemma shiftr1_eq_div_2: |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
964 |
\<open>shiftr1 w = w div 2\<close> |
72079 | 965 |
by transfer simp |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
966 |
|
71990 | 967 |
lemma bit_shiftr1_iff: |
968 |
\<open>bit (shiftr1 w) n \<longleftrightarrow> bit w (Suc n)\<close> |
|
72079 | 969 |
by transfer (auto simp flip: bit_Suc simp add: bit_take_bit_iff) |
970 |
||
971 |
lemma shiftr1_eq: |
|
72128 | 972 |
\<open>shiftr1 w = word_of_int (uint w div 2)\<close> |
72079 | 973 |
by transfer simp |
71990 | 974 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
975 |
instantiation word :: (len) ring_bit_operations |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
976 |
begin |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
977 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
978 |
lift_definition not_word :: \<open>'a word \<Rightarrow> 'a word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
979 |
is not |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
980 |
by (simp add: take_bit_not_iff) |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
981 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
982 |
lift_definition and_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
983 |
is \<open>and\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
984 |
by simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
985 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
986 |
lift_definition or_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
987 |
is or |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
988 |
by simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
989 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
990 |
lift_definition xor_word :: \<open>'a word \<Rightarrow> 'a word \<Rightarrow> 'a word\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
991 |
is xor |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
992 |
by simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
993 |
|
72082 | 994 |
lift_definition mask_word :: \<open>nat \<Rightarrow> 'a word\<close> |
995 |
is mask |
|
996 |
. |
|
997 |
||
998 |
instance by (standard; transfer) |
|
999 |
(auto simp add: minus_eq_not_minus_1 mask_eq_exp_minus_1 |
|
1000 |
bit_not_iff bit_and_iff bit_or_iff bit_xor_iff) |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1001 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1002 |
end |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1003 |
|
72009 | 1004 |
context |
1005 |
includes lifting_syntax |
|
1006 |
begin |
|
1007 |
||
72079 | 1008 |
lemma set_bit_word_transfer [transfer_rule]: |
72009 | 1009 |
\<open>((=) ===> pcr_word ===> pcr_word) set_bit set_bit\<close> |
1010 |
by (unfold set_bit_def) transfer_prover |
|
1011 |
||
72079 | 1012 |
lemma unset_bit_word_transfer [transfer_rule]: |
72009 | 1013 |
\<open>((=) ===> pcr_word ===> pcr_word) unset_bit unset_bit\<close> |
1014 |
by (unfold unset_bit_def) transfer_prover |
|
1015 |
||
72079 | 1016 |
lemma flip_bit_word_transfer [transfer_rule]: |
72009 | 1017 |
\<open>((=) ===> pcr_word ===> pcr_word) flip_bit flip_bit\<close> |
1018 |
by (unfold flip_bit_def) transfer_prover |
|
1019 |
||
1020 |
end |
|
1021 |
||
72000 | 1022 |
instantiation word :: (len) semiring_bit_syntax |
37660 | 1023 |
begin |
1024 |
||
72079 | 1025 |
lift_definition test_bit_word :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> bool\<close> |
1026 |
is \<open>\<lambda>k n. n < LENGTH('a) \<and> bit k n\<close> |
|
1027 |
proof |
|
1028 |
fix k l :: int and n :: nat |
|
1029 |
assume *: \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> |
|
1030 |
show \<open>n < LENGTH('a) \<and> bit k n \<longleftrightarrow> n < LENGTH('a) \<and> bit l n\<close> |
|
1031 |
proof (cases \<open>n < LENGTH('a)\<close>) |
|
1032 |
case True |
|
1033 |
from * have \<open>bit (take_bit LENGTH('a) k) n \<longleftrightarrow> bit (take_bit LENGTH('a) l) n\<close> |
|
1034 |
by simp |
|
1035 |
then show ?thesis |
|
1036 |
by (simp add: bit_take_bit_iff) |
|
1037 |
next |
|
1038 |
case False |
|
1039 |
then show ?thesis |
|
1040 |
by simp |
|
1041 |
qed |
|
1042 |
qed |
|
37660 | 1043 |
|
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
1044 |
lemma test_bit_word_eq: |
72079 | 1045 |
\<open>test_bit = (bit :: 'a word \<Rightarrow> _)\<close> |
1046 |
by transfer simp |
|
1047 |
||
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1048 |
lemma bit_word_iff_drop_bit_and [code]: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1049 |
\<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close> for a :: \<open>'a::len word\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1050 |
by (simp add: bit_iff_odd_drop_bit odd_iff_mod_2_eq_one and_one_eq) |
72079 | 1051 |
|
1052 |
lemma [code]: |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1053 |
\<open>test_bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close> for a :: \<open>'a::len word\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1054 |
by (simp add: test_bit_word_eq bit_word_iff_drop_bit_and) |
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
1055 |
|
72079 | 1056 |
lift_definition shiftl_word :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close> |
1057 |
is \<open>\<lambda>k n. push_bit n k\<close> |
|
1058 |
proof - |
|
1059 |
show \<open>take_bit LENGTH('a) (push_bit n k) = take_bit LENGTH('a) (push_bit n l)\<close> |
|
1060 |
if \<open>take_bit LENGTH('a) k = take_bit LENGTH('a) l\<close> for k l :: int and n :: nat |
|
1061 |
proof - |
|
1062 |
from that |
|
1063 |
have \<open>take_bit (LENGTH('a) - n) (take_bit LENGTH('a) k) |
|
1064 |
= take_bit (LENGTH('a) - n) (take_bit LENGTH('a) l)\<close> |
|
1065 |
by simp |
|
1066 |
moreover have \<open>min (LENGTH('a) - n) LENGTH('a) = LENGTH('a) - n\<close> |
|
1067 |
by simp |
|
1068 |
ultimately show ?thesis |
|
1069 |
by (simp add: take_bit_push_bit) |
|
1070 |
qed |
|
1071 |
qed |
|
1072 |
||
71952
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
1073 |
lemma shiftl_word_eq: |
2efc5b8c7456
canonical bit shifts for word type, leaving duplicates as they are at the moment
haftmann
parents:
71951
diff
changeset
|
1074 |
\<open>w << n = push_bit n w\<close> for w :: \<open>'a::len word\<close> |
72079 | 1075 |
by transfer rule |
1076 |
||
1077 |
lift_definition shiftr_word :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close> |
|
1078 |
is \<open>\<lambda>k n. drop_bit n (take_bit LENGTH('a) k)\<close> by simp |
|
1079 |
||
72000 | 1080 |
lemma shiftr_word_eq: |
1081 |
\<open>w >> n = drop_bit n w\<close> for w :: \<open>'a::len word\<close> |
|
72079 | 1082 |
by transfer simp |
1083 |
||
1084 |
instance |
|
1085 |
by (standard; transfer) simp_all |
|
72000 | 1086 |
|
1087 |
end |
|
1088 |
||
72079 | 1089 |
lemma shiftl_code [code]: |
1090 |
\<open>w << n = w * 2 ^ n\<close> |
|
1091 |
for w :: \<open>'a::len word\<close> |
|
1092 |
by transfer (simp add: push_bit_eq_mult) |
|
1093 |
||
1094 |
lemma shiftl1_code [code]: |
|
1095 |
\<open>shiftl1 w = w << 1\<close> |
|
1096 |
by transfer (simp add: push_bit_eq_mult ac_simps) |
|
1097 |
||
1098 |
lemma uint_shiftr_eq [code]: |
|
1099 |
\<open>uint (w >> n) = uint w div 2 ^ n\<close> |
|
1100 |
for w :: \<open>'a::len word\<close> |
|
1101 |
by transfer (simp flip: drop_bit_eq_div add: drop_bit_take_bit min_def le_less less_diff_conv) |
|
1102 |
||
1103 |
lemma shiftr1_code [code]: |
|
1104 |
\<open>shiftr1 w = w >> 1\<close> |
|
1105 |
by transfer (simp add: drop_bit_Suc) |
|
1106 |
||
1107 |
lemma word_test_bit_def: |
|
72128 | 1108 |
\<open>test_bit a = bit (uint a)\<close> |
72079 | 1109 |
by transfer (simp add: fun_eq_iff bit_take_bit_iff) |
1110 |
||
1111 |
lemma shiftl_def: |
|
1112 |
\<open>w << n = (shiftl1 ^^ n) w\<close> |
|
1113 |
proof - |
|
1114 |
have \<open>push_bit n = (((*) 2 ^^ n) :: int \<Rightarrow> int)\<close> for n |
|
1115 |
by (induction n) (simp_all add: fun_eq_iff funpow_swap1, simp add: ac_simps) |
|
1116 |
then show ?thesis |
|
1117 |
by transfer simp |
|
1118 |
qed |
|
1119 |
||
1120 |
lemma shiftr_def: |
|
1121 |
\<open>w >> n = (shiftr1 ^^ n) w\<close> |
|
1122 |
proof - |
|
1123 |
have \<open>drop_bit n = (((\<lambda>k::int. k div 2) ^^ n))\<close> for n |
|
1124 |
by (rule sym, induction n) |
|
1125 |
(simp_all add: fun_eq_iff drop_bit_Suc flip: drop_bit_half) |
|
1126 |
then show ?thesis |
|
1127 |
apply transfer |
|
1128 |
apply simp |
|
1129 |
apply (metis bintrunc_bintrunc rco_bintr) |
|
1130 |
done |
|
1131 |
qed |
|
1132 |
||
71990 | 1133 |
lemma bit_shiftl_word_iff: |
1134 |
\<open>bit (w << m) n \<longleftrightarrow> m \<le> n \<and> n < LENGTH('a) \<and> bit w (n - m)\<close> |
|
1135 |
for w :: \<open>'a::len word\<close> |
|
1136 |
by (simp add: shiftl_word_eq bit_push_bit_iff exp_eq_zero_iff not_le) |
|
1137 |
||
71955 | 1138 |
lemma [code]: |
1139 |
\<open>push_bit n w = w << n\<close> for w :: \<open>'a::len word\<close> |
|
1140 |
by (simp add: shiftl_word_eq) |
|
1141 |
||
71990 | 1142 |
lemma bit_shiftr_word_iff: |
1143 |
\<open>bit (w >> m) n \<longleftrightarrow> bit w (m + n)\<close> |
|
1144 |
for w :: \<open>'a::len word\<close> |
|
1145 |
by (simp add: shiftr_word_eq bit_drop_bit_eq) |
|
1146 |
||
71955 | 1147 |
lemma [code]: |
1148 |
\<open>drop_bit n w = w >> n\<close> for w :: \<open>'a::len word\<close> |
|
1149 |
by (simp add: shiftr_word_eq) |
|
1150 |
||
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
1151 |
lemma [code]: |
72083
3ec876181527
further refinement of code equations for mask operation
haftmann
parents:
72082
diff
changeset
|
1152 |
\<open>uint (take_bit n w) = (if n < LENGTH('a::len) then take_bit n (uint w) else uint w)\<close> |
3ec876181527
further refinement of code equations for mask operation
haftmann
parents:
72082
diff
changeset
|
1153 |
for w :: \<open>'a::len word\<close> |
3ec876181527
further refinement of code equations for mask operation
haftmann
parents:
72082
diff
changeset
|
1154 |
by transfer (simp add: min_def) |
71965
d45f5d4c41bd
more class operations for the sake of efficient generated code
haftmann
parents:
71958
diff
changeset
|
1155 |
|
72082 | 1156 |
lemma [code]: |
72083
3ec876181527
further refinement of code equations for mask operation
haftmann
parents:
72082
diff
changeset
|
1157 |
\<open>uint (mask n :: 'a::len word) = mask (min LENGTH('a) n)\<close> |
3ec876181527
further refinement of code equations for mask operation
haftmann
parents:
72082
diff
changeset
|
1158 |
by transfer simp |
72082 | 1159 |
|
71955 | 1160 |
lemma [code_abbrev]: |
1161 |
\<open>push_bit n 1 = (2 :: 'a::len word) ^ n\<close> |
|
1162 |
by (fact push_bit_of_1) |
|
1163 |
||
72079 | 1164 |
lemma |
1165 |
word_not_def [code]: "NOT (a::'a::len word) = word_of_int (NOT (uint a))" |
|
65268 | 1166 |
and word_and_def: "(a::'a word) AND b = word_of_int (uint a AND uint b)" |
1167 |
and word_or_def: "(a::'a word) OR b = word_of_int (uint a OR uint b)" |
|
1168 |
and word_xor_def: "(a::'a word) XOR b = word_of_int (uint a XOR uint b)" |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1169 |
by (transfer, simp add: take_bit_not_take_bit)+ |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
1170 |
|
72079 | 1171 |
lemma [code abstract]: |
1172 |
\<open>uint (v AND w) = uint v AND uint w\<close> |
|
1173 |
by transfer simp |
|
1174 |
||
1175 |
lemma [code abstract]: |
|
1176 |
\<open>uint (v OR w) = uint v OR uint w\<close> |
|
1177 |
by transfer simp |
|
1178 |
||
1179 |
lemma [code abstract]: |
|
1180 |
\<open>uint (v XOR w) = uint v XOR uint w\<close> |
|
1181 |
by transfer simp |
|
1182 |
||
1183 |
lift_definition setBit :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close> |
|
1184 |
is \<open>\<lambda>k n. set_bit n k\<close> |
|
1185 |
by (simp add: take_bit_set_bit_eq) |
|
1186 |
||
1187 |
lemma set_Bit_eq: |
|
1188 |
\<open>setBit w n = set_bit n w\<close> |
|
1189 |
by transfer simp |
|
71990 | 1190 |
|
1191 |
lemma bit_setBit_iff: |
|
1192 |
\<open>bit (setBit w m) n \<longleftrightarrow> (m = n \<and> n < LENGTH('a) \<or> bit w n)\<close> |
|
1193 |
for w :: \<open>'a::len word\<close> |
|
72079 | 1194 |
by transfer (auto simp add: bit_set_bit_iff) |
1195 |
||
1196 |
lift_definition clearBit :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close> |
|
1197 |
is \<open>\<lambda>k n. unset_bit n k\<close> |
|
1198 |
by (simp add: take_bit_unset_bit_eq) |
|
1199 |
||
1200 |
lemma clear_Bit_eq: |
|
1201 |
\<open>clearBit w n = unset_bit n w\<close> |
|
1202 |
by transfer simp |
|
71990 | 1203 |
|
1204 |
lemma bit_clearBit_iff: |
|
1205 |
\<open>bit (clearBit w m) n \<longleftrightarrow> m \<noteq> n \<and> bit w n\<close> |
|
1206 |
for w :: \<open>'a::len word\<close> |
|
72079 | 1207 |
by transfer (auto simp add: bit_unset_bit_iff) |
71990 | 1208 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1209 |
definition even_word :: \<open>'a::len word \<Rightarrow> bool\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1210 |
where [code_abbrev]: \<open>even_word = even\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1211 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1212 |
lemma even_word_iff [code]: |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1213 |
\<open>even_word a \<longleftrightarrow> a AND 1 = 0\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1214 |
by (simp add: and_one_eq even_iff_mod_2_eq_zero even_word_def) |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1215 |
|
72079 | 1216 |
lemma map_bit_range_eq_if_take_bit_eq: |
1217 |
\<open>map (bit k) [0..<n] = map (bit l) [0..<n]\<close> |
|
1218 |
if \<open>take_bit n k = take_bit n l\<close> for k l :: int |
|
1219 |
using that proof (induction n arbitrary: k l) |
|
1220 |
case 0 |
|
1221 |
then show ?case |
|
1222 |
by simp |
|
1223 |
next |
|
1224 |
case (Suc n) |
|
1225 |
from Suc.prems have \<open>take_bit n (k div 2) = take_bit n (l div 2)\<close> |
|
1226 |
by (simp add: take_bit_Suc) |
|
1227 |
then have \<open>map (bit (k div 2)) [0..<n] = map (bit (l div 2)) [0..<n]\<close> |
|
1228 |
by (rule Suc.IH) |
|
1229 |
moreover have \<open>bit (r div 2) = bit r \<circ> Suc\<close> for r :: int |
|
1230 |
by (simp add: fun_eq_iff bit_Suc) |
|
1231 |
moreover from Suc.prems have \<open>even k \<longleftrightarrow> even l\<close> |
|
1232 |
by (auto simp add: take_bit_Suc elim!: evenE oddE) arith+ |
|
1233 |
ultimately show ?case |
|
1234 |
by (simp only: map_Suc_upt upt_conv_Cons flip: list.map_comp) simp |
|
1235 |
qed |
|
1236 |
||
1237 |
||
1238 |
subsection \<open>More shift operations\<close> |
|
1239 |
||
1240 |
lift_definition sshiftr1 :: \<open>'a::len word \<Rightarrow> 'a word\<close> |
|
1241 |
is \<open>\<lambda>k. take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - 1) k div 2)\<close> |
|
1242 |
by (simp flip: signed_take_bit_decr_length_iff) |
|
1243 |
||
1244 |
lift_definition sshiftr :: \<open>'a::len word \<Rightarrow> nat \<Rightarrow> 'a word\<close> (infixl \<open>>>>\<close> 55) |
|
1245 |
is \<open>\<lambda>k n. take_bit LENGTH('a) (drop_bit n (signed_take_bit (LENGTH('a) - 1) k))\<close> |
|
1246 |
by (simp flip: signed_take_bit_decr_length_iff) |
|
1247 |
||
1248 |
lift_definition bshiftr1 :: \<open>bool \<Rightarrow> 'a::len word \<Rightarrow> 'a word\<close> |
|
1249 |
is \<open>\<lambda>b k. take_bit LENGTH('a) k div 2 + of_bool b * 2 ^ (LENGTH('a) - Suc 0)\<close> |
|
1250 |
by (fact arg_cong) |
|
1251 |
||
1252 |
lemma sshiftr1_eq: |
|
72128 | 1253 |
\<open>sshiftr1 w = word_of_int (sint w div 2)\<close> |
72079 | 1254 |
by transfer simp |
1255 |
||
1256 |
lemma sshiftr_eq: |
|
1257 |
\<open>w >>> n = (sshiftr1 ^^ n) w\<close> |
|
1258 |
proof - |
|
1259 |
have *: \<open>(\<lambda>k. take_bit LENGTH('a) (signed_take_bit (LENGTH('a) - Suc 0) k div 2)) ^^ Suc n = |
|
1260 |
take_bit LENGTH('a) \<circ> drop_bit (Suc n) \<circ> signed_take_bit (LENGTH('a) - Suc 0)\<close> |
|
1261 |
for n |
|
1262 |
apply (induction n) |
|
1263 |
apply (auto simp add: fun_eq_iff drop_bit_Suc) |
|
1264 |
apply (metis (no_types, lifting) Suc_pred funpow_swap1 len_gt_0 sbintrunc_bintrunc sbintrunc_rest) |
|
1265 |
done |
|
1266 |
show ?thesis |
|
1267 |
apply transfer |
|
1268 |
apply simp |
|
1269 |
subgoal for k n |
|
1270 |
apply (cases n) |
|
1271 |
apply (simp_all only: *) |
|
1272 |
apply simp_all |
|
1273 |
done |
|
1274 |
done |
|
1275 |
qed |
|
1276 |
||
1277 |
lemma mask_eq: |
|
72082 | 1278 |
\<open>mask n = (1 << n) - (1 :: 'a::len word)\<close> |
72079 | 1279 |
by transfer (simp add: mask_eq_exp_minus_1 push_bit_of_1) |
1280 |
||
1281 |
lemma uint_sshiftr_eq [code]: |
|
1282 |
\<open>uint (w >>> n) = take_bit LENGTH('a) (sint w div 2 ^ n)\<close> |
|
1283 |
for w :: \<open>'a::len word\<close> |
|
1284 |
by transfer (simp flip: drop_bit_eq_div) |
|
1285 |
||
1286 |
lemma sshift1_code [code]: |
|
1287 |
\<open>sshiftr1 w = w >>> 1\<close> |
|
1288 |
by transfer (simp add: drop_bit_Suc) |
|
65268 | 1289 |
|
37660 | 1290 |
|
61799 | 1291 |
subsection \<open>Rotation\<close> |
37660 | 1292 |
|
72079 | 1293 |
lift_definition word_rotr :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close> |
1294 |
is \<open>\<lambda>n k. concat_bit (LENGTH('a) - n mod LENGTH('a)) |
|
1295 |
(drop_bit (n mod LENGTH('a)) (take_bit LENGTH('a) k)) |
|
1296 |
(take_bit (n mod LENGTH('a)) k)\<close> |
|
1297 |
subgoal for n k l |
|
1298 |
apply (simp add: concat_bit_def nat_le_iff less_imp_le |
|
1299 |
take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>n mod LENGTH('a::len)\<close>]) |
|
1300 |
done |
|
1301 |
done |
|
1302 |
||
1303 |
lift_definition word_rotl :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close> |
|
1304 |
is \<open>\<lambda>n k. concat_bit (n mod LENGTH('a)) |
|
1305 |
(drop_bit (LENGTH('a) - n mod LENGTH('a)) (take_bit LENGTH('a) k)) |
|
1306 |
(take_bit (LENGTH('a) - n mod LENGTH('a)) k)\<close> |
|
1307 |
subgoal for n k l |
|
1308 |
apply (simp add: concat_bit_def nat_le_iff less_imp_le |
|
1309 |
take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>LENGTH('a) - n mod LENGTH('a::len)\<close>]) |
|
1310 |
done |
|
1311 |
done |
|
1312 |
||
1313 |
lift_definition word_roti :: \<open>int \<Rightarrow> 'a::len word \<Rightarrow> 'a::len word\<close> |
|
1314 |
is \<open>\<lambda>r k. concat_bit (LENGTH('a) - nat (r mod int LENGTH('a))) |
|
1315 |
(drop_bit (nat (r mod int LENGTH('a))) (take_bit LENGTH('a) k)) |
|
1316 |
(take_bit (nat (r mod int LENGTH('a))) k)\<close> |
|
1317 |
subgoal for r k l |
|
1318 |
apply (simp add: concat_bit_def nat_le_iff less_imp_le |
|
1319 |
take_bit_tightened [of \<open>LENGTH('a)\<close> k l \<open>nat (r mod int LENGTH('a::len))\<close>]) |
|
1320 |
done |
|
1321 |
done |
|
1322 |
||
1323 |
lemma word_rotl_eq_word_rotr [code]: |
|
1324 |
\<open>word_rotl n = (word_rotr (LENGTH('a) - n mod LENGTH('a)) :: 'a::len word \<Rightarrow> 'a word)\<close> |
|
1325 |
by (rule ext, cases \<open>n mod LENGTH('a) = 0\<close>; transfer) simp_all |
|
1326 |
||
1327 |
lemma word_roti_eq_word_rotr_word_rotl [code]: |
|
1328 |
\<open>word_roti i w = |
|
1329 |
(if i \<ge> 0 then word_rotr (nat i) w else word_rotl (nat (- i)) w)\<close> |
|
1330 |
proof (cases \<open>i \<ge> 0\<close>) |
|
1331 |
case True |
|
1332 |
moreover define n where \<open>n = nat i\<close> |
|
1333 |
ultimately have \<open>i = int n\<close> |
|
1334 |
by simp |
|
1335 |
moreover have \<open>word_roti (int n) = (word_rotr n :: _ \<Rightarrow> 'a word)\<close> |
|
1336 |
by (rule ext, transfer) (simp add: nat_mod_distrib) |
|
1337 |
ultimately show ?thesis |
|
1338 |
by simp |
|
1339 |
next |
|
1340 |
case False |
|
1341 |
moreover define n where \<open>n = nat (- i)\<close> |
|
1342 |
ultimately have \<open>i = - int n\<close> \<open>n > 0\<close> |
|
1343 |
by simp_all |
|
1344 |
moreover have \<open>word_roti (- int n) = (word_rotl n :: _ \<Rightarrow> 'a word)\<close> |
|
1345 |
by (rule ext, transfer) |
|
1346 |
(simp add: zmod_zminus1_eq_if flip: of_nat_mod of_nat_diff) |
|
1347 |
ultimately show ?thesis |
|
1348 |
by simp |
|
1349 |
qed |
|
1350 |
||
1351 |
lemma bit_word_rotr_iff: |
|
1352 |
\<open>bit (word_rotr m w) n \<longleftrightarrow> |
|
1353 |
n < LENGTH('a) \<and> bit w ((n + m) mod LENGTH('a))\<close> |
|
1354 |
for w :: \<open>'a::len word\<close> |
|
1355 |
proof transfer |
|
1356 |
fix k :: int and m n :: nat |
|
1357 |
define q where \<open>q = m mod LENGTH('a)\<close> |
|
1358 |
have \<open>q < LENGTH('a)\<close> |
|
1359 |
by (simp add: q_def) |
|
1360 |
then have \<open>q \<le> LENGTH('a)\<close> |
|
1361 |
by simp |
|
1362 |
have \<open>m mod LENGTH('a) = q\<close> |
|
1363 |
by (simp add: q_def) |
|
1364 |
moreover have \<open>(n + m) mod LENGTH('a) = (n + q) mod LENGTH('a)\<close> |
|
1365 |
by (subst mod_add_right_eq [symmetric]) (simp add: \<open>m mod LENGTH('a) = q\<close>) |
|
1366 |
moreover have \<open>n < LENGTH('a) \<and> |
|
1367 |
bit (concat_bit (LENGTH('a) - q) (drop_bit q (take_bit LENGTH('a) k)) (take_bit q k)) n \<longleftrightarrow> |
|
1368 |
n < LENGTH('a) \<and> bit k ((n + q) mod LENGTH('a))\<close> |
|
1369 |
using \<open>q < LENGTH('a)\<close> |
|
1370 |
by (cases \<open>q + n \<ge> LENGTH('a)\<close>) |
|
1371 |
(auto simp add: bit_concat_bit_iff bit_drop_bit_eq |
|
1372 |
bit_take_bit_iff le_mod_geq ac_simps) |
|
1373 |
ultimately show \<open>n < LENGTH('a) \<and> |
|
1374 |
bit (concat_bit (LENGTH('a) - m mod LENGTH('a)) |
|
1375 |
(drop_bit (m mod LENGTH('a)) (take_bit LENGTH('a) k)) |
|
1376 |
(take_bit (m mod LENGTH('a)) k)) n |
|
1377 |
\<longleftrightarrow> n < LENGTH('a) \<and> |
|
1378 |
(n + m) mod LENGTH('a) < LENGTH('a) \<and> |
|
1379 |
bit k ((n + m) mod LENGTH('a))\<close> |
|
1380 |
by simp |
|
1381 |
qed |
|
1382 |
||
1383 |
lemma bit_word_rotl_iff: |
|
1384 |
\<open>bit (word_rotl m w) n \<longleftrightarrow> |
|
1385 |
n < LENGTH('a) \<and> bit w ((n + (LENGTH('a) - m mod LENGTH('a))) mod LENGTH('a))\<close> |
|
1386 |
for w :: \<open>'a::len word\<close> |
|
1387 |
by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff) |
|
1388 |
||
1389 |
lemma bit_word_roti_iff: |
|
1390 |
\<open>bit (word_roti k w) n \<longleftrightarrow> |
|
1391 |
n < LENGTH('a) \<and> bit w (nat ((int n + k) mod int LENGTH('a)))\<close> |
|
1392 |
for w :: \<open>'a::len word\<close> |
|
1393 |
proof transfer |
|
1394 |
fix k l :: int and n :: nat |
|
1395 |
define m where \<open>m = nat (k mod int LENGTH('a))\<close> |
|
1396 |
have \<open>m < LENGTH('a)\<close> |
|
1397 |
by (simp add: nat_less_iff m_def) |
|
1398 |
then have \<open>m \<le> LENGTH('a)\<close> |
|
1399 |
by simp |
|
1400 |
have \<open>k mod int LENGTH('a) = int m\<close> |
|
1401 |
by (simp add: nat_less_iff m_def) |
|
1402 |
moreover have \<open>(int n + k) mod int LENGTH('a) = int ((n + m) mod LENGTH('a))\<close> |
|
1403 |
by (subst mod_add_right_eq [symmetric]) (simp add: of_nat_mod \<open>k mod int LENGTH('a) = int m\<close>) |
|
1404 |
moreover have \<open>n < LENGTH('a) \<and> |
|
1405 |
bit (concat_bit (LENGTH('a) - m) (drop_bit m (take_bit LENGTH('a) l)) (take_bit m l)) n \<longleftrightarrow> |
|
1406 |
n < LENGTH('a) \<and> bit l ((n + m) mod LENGTH('a))\<close> |
|
1407 |
using \<open>m < LENGTH('a)\<close> |
|
1408 |
by (cases \<open>m + n \<ge> LENGTH('a)\<close>) |
|
1409 |
(auto simp add: bit_concat_bit_iff bit_drop_bit_eq |
|
1410 |
bit_take_bit_iff nat_less_iff not_le not_less ac_simps |
|
1411 |
le_diff_conv le_mod_geq) |
|
1412 |
ultimately show \<open>n < LENGTH('a) |
|
1413 |
\<and> bit (concat_bit (LENGTH('a) - nat (k mod int LENGTH('a))) |
|
1414 |
(drop_bit (nat (k mod int LENGTH('a))) (take_bit LENGTH('a) l)) |
|
1415 |
(take_bit (nat (k mod int LENGTH('a))) l)) n \<longleftrightarrow> |
|
1416 |
n < LENGTH('a) |
|
1417 |
\<and> nat ((int n + k) mod int LENGTH('a)) < LENGTH('a) |
|
1418 |
\<and> bit l (nat ((int n + k) mod int LENGTH('a)))\<close> |
|
1419 |
by simp |
|
1420 |
qed |
|
1421 |
||
1422 |
lemma uint_word_rotr_eq [code]: |
|
1423 |
\<open>uint (word_rotr n w) = concat_bit (LENGTH('a) - n mod LENGTH('a)) |
|
1424 |
(drop_bit (n mod LENGTH('a)) (uint w)) |
|
1425 |
(uint (take_bit (n mod LENGTH('a)) w))\<close> |
|
1426 |
for w :: \<open>'a::len word\<close> |
|
1427 |
apply transfer |
|
1428 |
apply (simp add: concat_bit_def take_bit_drop_bit push_bit_take_bit min_def) |
|
1429 |
using mod_less_divisor not_less apply blast |
|
1430 |
done |
|
1431 |
||
1432 |
||
61799 | 1433 |
subsection \<open>Split and cat operations\<close> |
37660 | 1434 |
|
72079 | 1435 |
lift_definition word_cat :: \<open>'a::len word \<Rightarrow> 'b::len word \<Rightarrow> 'c::len word\<close> |
1436 |
is \<open>\<lambda>k l. concat_bit LENGTH('b) l (take_bit LENGTH('a) k)\<close> |
|
1437 |
by (simp add: bit_eq_iff bit_concat_bit_iff bit_take_bit_iff) |
|
65268 | 1438 |
|
71990 | 1439 |
lemma word_cat_eq: |
1440 |
\<open>(word_cat v w :: 'c::len word) = push_bit LENGTH('b) (ucast v) + ucast w\<close> |
|
1441 |
for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close> |
|
72128 | 1442 |
by transfer (simp add: concat_bit_eq ac_simps) |
72079 | 1443 |
|
1444 |
lemma word_cat_eq' [code]: |
|
1445 |
\<open>word_cat a b = word_of_int (concat_bit LENGTH('b) (uint b) (uint a))\<close> |
|
1446 |
for a :: \<open>'a::len word\<close> and b :: \<open>'b::len word\<close> |
|
1447 |
by transfer simp |
|
71990 | 1448 |
|
1449 |
lemma bit_word_cat_iff: |
|
1450 |
\<open>bit (word_cat v w :: 'c::len word) n \<longleftrightarrow> n < LENGTH('c) \<and> (if n < LENGTH('b) then bit w n else bit v (n - LENGTH('b)))\<close> |
|
1451 |
for v :: \<open>'a::len word\<close> and w :: \<open>'b::len word\<close> |
|
72079 | 1452 |
by transfer (simp add: bit_concat_bit_iff bit_take_bit_iff) |
71990 | 1453 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1454 |
definition word_split :: "'a::len word \<Rightarrow> 'b::len word \<times> 'c::len word" |
65268 | 1455 |
where "word_split a = |
70185 | 1456 |
(case bin_split (LENGTH('c)) (uint a) of |
65268 | 1457 |
(u, v) \<Rightarrow> (word_of_int u, word_of_int v))" |
1458 |
||
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1459 |
definition word_rcat :: \<open>'a::len word list \<Rightarrow> 'b::len word\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1460 |
where \<open>word_rcat = word_of_int \<circ> horner_sum uint (2 ^ LENGTH('a)) \<circ> rev\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1461 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1462 |
lemma word_rcat_eq: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1463 |
\<open>word_rcat ws = word_of_int (bin_rcat (LENGTH('a::len)) (map uint ws))\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1464 |
for ws :: \<open>'a::len word list\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1465 |
apply (simp add: word_rcat_def bin_rcat_def rev_map) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1466 |
apply transfer |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1467 |
apply (simp add: horner_sum_foldr foldr_map comp_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
1468 |
done |
65268 | 1469 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1470 |
definition word_rsplit :: "'a::len word \<Rightarrow> 'b::len word list" |
70185 | 1471 |
where "word_rsplit w = map word_of_int (bin_rsplit (LENGTH('b)) (LENGTH('a), uint w))" |
65268 | 1472 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1473 |
abbreviation (input) max_word :: \<open>'a::len word\<close> |
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67408
diff
changeset
|
1474 |
\<comment> \<open>Largest representable machine integer.\<close> |
71946 | 1475 |
where "max_word \<equiv> - 1" |
37660 | 1476 |
|
1477 |
||
61799 | 1478 |
subsection \<open>Theorems about typedefs\<close> |
46010 | 1479 |
|
72128 | 1480 |
lemma sint_sbintrunc': "sint (word_of_int bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) bin" |
65268 | 1481 |
by (auto simp: sint_uint word_ubin.eq_norm sbintrunc_bintrunc_lt) |
1482 |
||
72128 | 1483 |
lemma uint_sint: "uint w = take_bit (LENGTH('a)) (sint w)" |
65328 | 1484 |
for w :: "'a::len word" |
65268 | 1485 |
by (auto simp: sint_uint bintrunc_sbintrunc_le) |
1486 |
||
72128 | 1487 |
lemma bintr_uint: "LENGTH('a) \<le> n \<Longrightarrow> take_bit n (uint w) = uint w" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1488 |
for w :: "'a::len word" |
65268 | 1489 |
apply (subst word_ubin.norm_Rep [symmetric]) |
37660 | 1490 |
apply (simp only: bintrunc_bintrunc_min word_size) |
54863
82acc20ded73
prefer more canonical names for lemmas on min/max
haftmann
parents:
54854
diff
changeset
|
1491 |
apply (simp add: min.absorb2) |
37660 | 1492 |
done |
1493 |
||
46057 | 1494 |
lemma wi_bintr: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1495 |
"LENGTH('a::len) \<le> n \<Longrightarrow> |
72128 | 1496 |
word_of_int (take_bit n w) = (word_of_int w :: 'a word)" |
65268 | 1497 |
by (auto simp: word_ubin.norm_eq_iff [symmetric] min.absorb1) |
1498 |
||
1499 |
lemma td_ext_sbin: |
|
70185 | 1500 |
"td_ext (sint :: 'a word \<Rightarrow> int) word_of_int (sints (LENGTH('a::len))) |
72128 | 1501 |
(signed_take_bit (LENGTH('a) - 1))" |
37660 | 1502 |
apply (unfold td_ext_def' sint_uint) |
1503 |
apply (simp add : word_ubin.eq_norm) |
|
70185 | 1504 |
apply (cases "LENGTH('a)") |
37660 | 1505 |
apply (auto simp add : sints_def) |
1506 |
apply (rule sym [THEN trans]) |
|
65268 | 1507 |
apply (rule word_ubin.Abs_norm) |
37660 | 1508 |
apply (simp only: bintrunc_sbintrunc) |
1509 |
apply (drule sym) |
|
1510 |
apply simp |
|
1511 |
done |
|
1512 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
1513 |
lemma td_ext_sint: |
70185 | 1514 |
"td_ext (sint :: 'a word \<Rightarrow> int) word_of_int (sints (LENGTH('a::len))) |
1515 |
(\<lambda>w. (w + 2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - |
|
1516 |
2 ^ (LENGTH('a) - 1))" |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
1517 |
using td_ext_sbin [where ?'a = 'a] by (simp add: no_sbintr_alt2) |
37660 | 1518 |
|
67408 | 1519 |
text \<open> |
1520 |
We do \<open>sint\<close> before \<open>sbin\<close>, before \<open>sint\<close> is the user version |
|
1521 |
and interpretations do not produce thm duplicates. I.e. |
|
1522 |
we get the name \<open>word_sint.Rep_eqD\<close>, but not \<open>word_sbin.Req_eqD\<close>, |
|
1523 |
because the latter is the same thm as the former. |
|
1524 |
\<close> |
|
37660 | 1525 |
interpretation word_sint: |
65268 | 1526 |
td_ext |
1527 |
"sint ::'a::len word \<Rightarrow> int" |
|
1528 |
word_of_int |
|
70185 | 1529 |
"sints (LENGTH('a::len))" |
1530 |
"\<lambda>w. (w + 2^(LENGTH('a::len) - 1)) mod 2^LENGTH('a::len) - |
|
1531 |
2 ^ (LENGTH('a::len) - 1)" |
|
37660 | 1532 |
by (rule td_ext_sint) |
1533 |
||
1534 |
interpretation word_sbin: |
|
65268 | 1535 |
td_ext |
1536 |
"sint ::'a::len word \<Rightarrow> int" |
|
1537 |
word_of_int |
|
70185 | 1538 |
"sints (LENGTH('a::len))" |
72128 | 1539 |
"signed_take_bit (LENGTH('a::len) - 1)" |
37660 | 1540 |
by (rule td_ext_sbin) |
1541 |
||
45604 | 1542 |
lemmas int_word_sint = td_ext_sint [THEN td_ext.eq_norm] |
37660 | 1543 |
|
1544 |
lemmas td_sint = word_sint.td |
|
1545 |
||
45805 | 1546 |
lemma uints_mod: "uints n = range (\<lambda>w. w mod 2 ^ n)" |
1547 |
by (fact uints_def [unfolded no_bintr_alt1]) |
|
1548 |
||
65268 | 1549 |
lemma word_numeral_alt: "numeral b = word_of_int (numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1550 |
by (induct b, simp_all only: numeral.simps word_of_int_homs) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1551 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1552 |
declare word_numeral_alt [symmetric, code_abbrev] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1553 |
|
65268 | 1554 |
lemma word_neg_numeral_alt: "- numeral b = word_of_int (- numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
1555 |
by (simp only: word_numeral_alt wi_hom_neg) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1556 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1557 |
declare word_neg_numeral_alt [symmetric, code_abbrev] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1558 |
|
45805 | 1559 |
lemma uint_bintrunc [simp]: |
65268 | 1560 |
"uint (numeral bin :: 'a word) = |
72128 | 1561 |
take_bit (LENGTH('a::len)) (numeral bin)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1562 |
unfolding word_numeral_alt by (rule word_ubin.eq_norm) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1563 |
|
65268 | 1564 |
lemma uint_bintrunc_neg [simp]: |
72128 | 1565 |
"uint (- numeral bin :: 'a word) = take_bit (LENGTH('a::len)) (- numeral bin)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1566 |
by (simp only: word_neg_numeral_alt word_ubin.eq_norm) |
37660 | 1567 |
|
45805 | 1568 |
lemma sint_sbintrunc [simp]: |
72128 | 1569 |
"sint (numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (numeral bin)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1570 |
by (simp only: word_numeral_alt word_sbin.eq_norm) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1571 |
|
65268 | 1572 |
lemma sint_sbintrunc_neg [simp]: |
72128 | 1573 |
"sint (- numeral bin :: 'a word) = signed_take_bit (LENGTH('a::len) - 1) (- numeral bin)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1574 |
by (simp only: word_neg_numeral_alt word_sbin.eq_norm) |
37660 | 1575 |
|
45805 | 1576 |
lemma unat_bintrunc [simp]: |
72128 | 1577 |
"unat (numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (numeral bin))" |
72079 | 1578 |
by transfer simp |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1579 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1580 |
lemma unat_bintrunc_neg [simp]: |
72128 | 1581 |
"unat (- numeral bin :: 'a::len word) = nat (take_bit (LENGTH('a)) (- numeral bin))" |
72079 | 1582 |
by transfer simp |
37660 | 1583 |
|
65328 | 1584 |
lemma size_0_eq: "size w = 0 \<Longrightarrow> v = w" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1585 |
for v w :: "'a::len word" |
37660 | 1586 |
apply (unfold word_size) |
1587 |
apply (rule word_uint.Rep_eqD) |
|
1588 |
apply (rule box_equals) |
|
1589 |
defer |
|
1590 |
apply (rule word_ubin.norm_Rep)+ |
|
1591 |
apply simp |
|
1592 |
done |
|
1593 |
||
65268 | 1594 |
lemma uint_ge_0 [iff]: "0 \<le> uint x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1595 |
for x :: "'a::len word" |
45805 | 1596 |
using word_uint.Rep [of x] by (simp add: uints_num) |
1597 |
||
70185 | 1598 |
lemma uint_lt2p [iff]: "uint x < 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1599 |
for x :: "'a::len word" |
45805 | 1600 |
using word_uint.Rep [of x] by (simp add: uints_num) |
1601 |
||
71946 | 1602 |
lemma word_exp_length_eq_0 [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1603 |
\<open>(2 :: 'a::len word) ^ LENGTH('a) = 0\<close> |
72128 | 1604 |
by transfer (simp add: take_bit_eq_mod) |
71946 | 1605 |
|
70185 | 1606 |
lemma sint_ge: "- (2 ^ (LENGTH('a) - 1)) \<le> sint x" |
65268 | 1607 |
for x :: "'a::len word" |
45805 | 1608 |
using word_sint.Rep [of x] by (simp add: sints_num) |
1609 |
||
70185 | 1610 |
lemma sint_lt: "sint x < 2 ^ (LENGTH('a) - 1)" |
65268 | 1611 |
for x :: "'a::len word" |
45805 | 1612 |
using word_sint.Rep [of x] by (simp add: sints_num) |
37660 | 1613 |
|
65268 | 1614 |
lemma sign_uint_Pls [simp]: "bin_sign (uint x) = 0" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1615 |
by (simp add: sign_Pls_ge_0) |
37660 | 1616 |
|
70185 | 1617 |
lemma uint_m2p_neg: "uint x - 2 ^ LENGTH('a) < 0" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1618 |
for x :: "'a::len word" |
45805 | 1619 |
by (simp only: diff_less_0_iff_less uint_lt2p) |
1620 |
||
70185 | 1621 |
lemma uint_m2p_not_non_neg: "\<not> 0 \<le> uint x - 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1622 |
for x :: "'a::len word" |
45805 | 1623 |
by (simp only: not_le uint_m2p_neg) |
37660 | 1624 |
|
70185 | 1625 |
lemma lt2p_lem: "LENGTH('a) \<le> n \<Longrightarrow> uint w < 2 ^ n" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1626 |
for w :: "'a::len word" |
71997 | 1627 |
by (metis bintr_lt2p bintr_uint) |
37660 | 1628 |
|
45805 | 1629 |
lemma uint_le_0_iff [simp]: "uint x \<le> 0 \<longleftrightarrow> uint x = 0" |
70749
5d06b7bb9d22
More type class generalisations. Note that linorder_antisym_conv1 and linorder_antisym_conv2 no longer exist.
paulson <lp15@cam.ac.uk>
parents:
70342
diff
changeset
|
1630 |
by (fact uint_ge_0 [THEN leD, THEN antisym_conv1]) |
37660 | 1631 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
1632 |
lemma uint_nat: "uint w = int (unat w)" |
72079 | 1633 |
by transfer simp |
65268 | 1634 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1635 |
lemma uint_numeral: "uint (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)" |
65268 | 1636 |
by (simp only: word_numeral_alt int_word_uint) |
1637 |
||
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1638 |
lemma uint_neg_numeral: "uint (- numeral b :: 'a::len word) = - numeral b mod 2 ^ LENGTH('a)" |
65268 | 1639 |
by (simp only: word_neg_numeral_alt int_word_uint) |
1640 |
||
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1641 |
lemma unat_numeral: "unat (numeral b :: 'a::len word) = numeral b mod 2 ^ LENGTH('a)" |
72079 | 1642 |
by transfer (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq) |
37660 | 1643 |
|
65268 | 1644 |
lemma sint_numeral: |
1645 |
"sint (numeral b :: 'a::len word) = |
|
1646 |
(numeral b + |
|
70185 | 1647 |
2 ^ (LENGTH('a) - 1)) mod 2 ^ LENGTH('a) - |
1648 |
2 ^ (LENGTH('a) - 1)" |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1649 |
unfolding word_numeral_alt by (rule int_word_sint) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1650 |
|
65268 | 1651 |
lemma word_of_int_0 [simp, code_post]: "word_of_int 0 = 0" |
45958 | 1652 |
unfolding word_0_wi .. |
1653 |
||
65268 | 1654 |
lemma word_of_int_1 [simp, code_post]: "word_of_int 1 = 1" |
45958 | 1655 |
unfolding word_1_wi .. |
1656 |
||
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
1657 |
lemma word_of_int_neg_1 [simp]: "word_of_int (- 1) = - 1" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
1658 |
by (simp add: wi_hom_syms) |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
1659 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1660 |
lemma word_of_int_numeral [simp] : "(word_of_int (numeral bin) :: 'a::len word) = numeral bin" |
65268 | 1661 |
by (simp only: word_numeral_alt) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1662 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1663 |
lemma word_of_int_neg_numeral [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1664 |
"(word_of_int (- numeral bin) :: 'a::len word) = - numeral bin" |
65268 | 1665 |
by (simp only: word_numeral_alt wi_hom_syms) |
1666 |
||
1667 |
lemma word_int_case_wi: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1668 |
"word_int_case f (word_of_int i :: 'b word) = f (i mod 2 ^ LENGTH('b::len))" |
72079 | 1669 |
by transfer (simp add: take_bit_eq_mod) |
65268 | 1670 |
|
1671 |
lemma word_int_split: |
|
1672 |
"P (word_int_case f x) = |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1673 |
(\<forall>i. x = (word_of_int i :: 'b::len word) \<and> 0 \<le> i \<and> i < 2 ^ LENGTH('b) \<longrightarrow> P (f i))" |
72079 | 1674 |
by transfer (auto simp add: take_bit_eq_mod) |
65268 | 1675 |
|
1676 |
lemma word_int_split_asm: |
|
1677 |
"P (word_int_case f x) = |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1678 |
(\<nexists>n. x = (word_of_int n :: 'b::len word) \<and> 0 \<le> n \<and> n < 2 ^ LENGTH('b::len) \<and> \<not> P (f n))" |
72079 | 1679 |
by transfer (auto simp add: take_bit_eq_mod) |
45805 | 1680 |
|
45604 | 1681 |
lemmas uint_range' = word_uint.Rep [unfolded uints_num mem_Collect_eq] |
1682 |
lemmas sint_range' = word_sint.Rep [unfolded One_nat_def sints_num mem_Collect_eq] |
|
37660 | 1683 |
|
65268 | 1684 |
lemma uint_range_size: "0 \<le> uint w \<and> uint w < 2 ^ size w" |
37660 | 1685 |
unfolding word_size by (rule uint_range') |
1686 |
||
65268 | 1687 |
lemma sint_range_size: "- (2 ^ (size w - Suc 0)) \<le> sint w \<and> sint w < 2 ^ (size w - Suc 0)" |
37660 | 1688 |
unfolding word_size by (rule sint_range') |
1689 |
||
65268 | 1690 |
lemma sint_above_size: "2 ^ (size w - 1) \<le> x \<Longrightarrow> sint w < x" |
1691 |
for w :: "'a::len word" |
|
45805 | 1692 |
unfolding word_size by (rule less_le_trans [OF sint_lt]) |
1693 |
||
65268 | 1694 |
lemma sint_below_size: "x \<le> - (2 ^ (size w - 1)) \<Longrightarrow> x \<le> sint w" |
1695 |
for w :: "'a::len word" |
|
45805 | 1696 |
unfolding word_size by (rule order_trans [OF _ sint_ge]) |
37660 | 1697 |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
1698 |
|
61799 | 1699 |
subsection \<open>Testing bits\<close> |
46010 | 1700 |
|
65268 | 1701 |
lemma test_bit_eq_iff: "test_bit u = test_bit v \<longleftrightarrow> u = v" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1702 |
for u v :: "'a::len word" |
37660 | 1703 |
unfolding word_test_bit_def by (simp add: bin_nth_eq_iff) |
1704 |
||
65268 | 1705 |
lemma test_bit_size [rule_format] : "w !! n \<longrightarrow> n < size w" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1706 |
for w :: "'a::len word" |
37660 | 1707 |
apply (unfold word_test_bit_def) |
1708 |
apply (subst word_ubin.norm_Rep [symmetric]) |
|
1709 |
apply (simp only: nth_bintr word_size) |
|
1710 |
apply fast |
|
1711 |
done |
|
1712 |
||
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1713 |
lemma word_eq_iff: "x = y \<longleftrightarrow> (\<forall>n<LENGTH('a). x !! n = y !! n)" (is \<open>?P \<longleftrightarrow> ?Q\<close>) |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1714 |
for x y :: "'a::len word" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1715 |
proof |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1716 |
assume ?P |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1717 |
then show ?Q |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1718 |
by simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1719 |
next |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1720 |
assume ?Q |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1721 |
then have *: \<open>bit (uint x) n \<longleftrightarrow> bit (uint y) n\<close> if \<open>n < LENGTH('a)\<close> for n |
71949 | 1722 |
using that by (simp add: word_test_bit_def) |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1723 |
show ?P |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1724 |
proof (rule word_uint_eqI, rule bit_eqI, rule iffI) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1725 |
fix n |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1726 |
assume \<open>bit (uint x) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1727 |
then have \<open>n < LENGTH('a)\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1728 |
by (simp add: bit_take_bit_iff uint.rep_eq) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1729 |
with * \<open>bit (uint x) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1730 |
show \<open>bit (uint y) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1731 |
by simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1732 |
next |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1733 |
fix n |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1734 |
assume \<open>bit (uint y) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1735 |
then have \<open>n < LENGTH('a)\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1736 |
by (simp add: bit_take_bit_iff uint.rep_eq) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1737 |
with * \<open>bit (uint y) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1738 |
show \<open>bit (uint x) n\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1739 |
by simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1740 |
qed |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
1741 |
qed |
46021 | 1742 |
|
65268 | 1743 |
lemma word_eqI: "(\<And>n. n < size u \<longrightarrow> u !! n = v !! n) \<Longrightarrow> u = v" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1744 |
for u :: "'a::len word" |
46021 | 1745 |
by (simp add: word_size word_eq_iff) |
37660 | 1746 |
|
65268 | 1747 |
lemma word_eqD: "u = v \<Longrightarrow> u !! x = v !! x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1748 |
for u v :: "'a::len word" |
45805 | 1749 |
by simp |
37660 | 1750 |
|
65268 | 1751 |
lemma test_bit_bin': "w !! n \<longleftrightarrow> n < size w \<and> bin_nth (uint w) n" |
1752 |
by (simp add: word_test_bit_def word_size nth_bintr [symmetric]) |
|
37660 | 1753 |
|
1754 |
lemmas test_bit_bin = test_bit_bin' [unfolded word_size] |
|
1755 |
||
70185 | 1756 |
lemma bin_nth_uint_imp: "bin_nth (uint w) n \<Longrightarrow> n < LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1757 |
for w :: "'a::len word" |
37660 | 1758 |
apply (rule nth_bintr [THEN iffD1, THEN conjunct1]) |
1759 |
apply (subst word_ubin.norm_Rep) |
|
1760 |
apply assumption |
|
1761 |
done |
|
1762 |
||
46057 | 1763 |
lemma bin_nth_sint: |
70185 | 1764 |
"LENGTH('a) \<le> n \<Longrightarrow> |
1765 |
bin_nth (sint w) n = bin_nth (sint w) (LENGTH('a) - 1)" |
|
65268 | 1766 |
for w :: "'a::len word" |
37660 | 1767 |
apply (subst word_sbin.norm_Rep [symmetric]) |
46057 | 1768 |
apply (auto simp add: nth_sbintr) |
37660 | 1769 |
done |
1770 |
||
65268 | 1771 |
lemmas bintr_num = |
1772 |
word_ubin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b |
|
1773 |
lemmas sbintr_num = |
|
1774 |
word_sbin.norm_eq_iff [of "numeral a" "numeral b", symmetric, folded word_numeral_alt] for a b |
|
37660 | 1775 |
|
1776 |
lemma num_of_bintr': |
|
72128 | 1777 |
"take_bit (LENGTH('a::len)) (numeral a :: int) = (numeral b) \<Longrightarrow> |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1778 |
numeral a = (numeral b :: 'a word)" |
46962
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1779 |
unfolding bintr_num by (erule subst, simp) |
37660 | 1780 |
|
1781 |
lemma num_of_sbintr': |
|
72128 | 1782 |
"signed_take_bit (LENGTH('a::len) - 1) (numeral a) = (numeral b) \<Longrightarrow> |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1783 |
numeral a = (numeral b :: 'a word)" |
46962
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1784 |
unfolding sbintr_num by (erule subst, simp) |
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1785 |
|
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1786 |
lemma num_abs_bintr: |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1787 |
"(numeral x :: 'a word) = |
72128 | 1788 |
word_of_int (take_bit (LENGTH('a::len)) (numeral x))" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1789 |
by (simp only: word_ubin.Abs_norm word_numeral_alt) |
46962
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1790 |
|
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1791 |
lemma num_abs_sbintr: |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1792 |
"(numeral x :: 'a word) = |
72128 | 1793 |
word_of_int (signed_take_bit (LENGTH('a::len) - 1) (numeral x))" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1794 |
by (simp only: word_sbin.Abs_norm word_numeral_alt) |
46962
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
1795 |
|
67408 | 1796 |
text \<open> |
1797 |
\<open>cast\<close> -- note, no arg for new length, as it's determined by type of result, |
|
1798 |
thus in \<open>cast w = w\<close>, the type means cast to length of \<open>w\<close>! |
|
1799 |
\<close> |
|
37660 | 1800 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1801 |
lemma bit_ucast_iff: |
72079 | 1802 |
\<open>bit (ucast a :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a::len) \<and> Parity.bit a n\<close> |
1803 |
by transfer (simp add: bit_take_bit_iff) |
|
1804 |
||
1805 |
lemma ucast_id [simp]: "ucast w = w" |
|
1806 |
by transfer simp |
|
1807 |
||
1808 |
lemma scast_id [simp]: "scast w = w" |
|
1809 |
by transfer simp |
|
37660 | 1810 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1811 |
lemma nth_ucast: "(ucast w::'a::len word) !! n = (w !! n \<and> n < LENGTH('a))" |
72079 | 1812 |
by transfer (simp add: bit_take_bit_iff ac_simps) |
37660 | 1813 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1814 |
lemma ucast_mask_eq: |
72082 | 1815 |
\<open>ucast (mask n :: 'b word) = mask (min LENGTH('b::len) n)\<close> |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1816 |
by (simp add: bit_eq_iff) (auto simp add: bit_mask_iff bit_ucast_iff exp_eq_zero_iff) |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
1817 |
|
67408 | 1818 |
\<comment> \<open>literal u(s)cast\<close> |
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
1819 |
lemma ucast_bintr [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1820 |
"ucast (numeral w :: 'a::len word) = |
72128 | 1821 |
word_of_int (take_bit (LENGTH('a)) (numeral w))" |
72079 | 1822 |
by transfer simp |
65268 | 1823 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1824 |
(* TODO: neg_numeral *) |
37660 | 1825 |
|
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
1826 |
lemma scast_sbintr [simp]: |
65268 | 1827 |
"scast (numeral w ::'a::len word) = |
72128 | 1828 |
word_of_int (signed_take_bit (LENGTH('a) - Suc 0) (numeral w))" |
72079 | 1829 |
by transfer simp |
37660 | 1830 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1831 |
lemma source_size: "source_size (c::'a::len word \<Rightarrow> _) = LENGTH('a)" |
72079 | 1832 |
by transfer simp |
46011 | 1833 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1834 |
lemma target_size: "target_size (c::_ \<Rightarrow> 'b::len word) = LENGTH('b)" |
72079 | 1835 |
by transfer simp |
46011 | 1836 |
|
70185 | 1837 |
lemma is_down: "is_down c \<longleftrightarrow> LENGTH('b) \<le> LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1838 |
for c :: "'a::len word \<Rightarrow> 'b::len word" |
72079 | 1839 |
by transfer simp |
65268 | 1840 |
|
70185 | 1841 |
lemma is_up: "is_up c \<longleftrightarrow> LENGTH('a) \<le> LENGTH('b)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1842 |
for c :: "'a::len word \<Rightarrow> 'b::len word" |
72079 | 1843 |
by transfer simp |
1844 |
||
1845 |
lemma is_up_down: |
|
1846 |
\<open>is_up c \<longleftrightarrow> is_down d\<close> |
|
1847 |
for c :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
1848 |
and d :: \<open>'b::len word \<Rightarrow> 'a::len word\<close> |
|
1849 |
by transfer simp |
|
1850 |
||
1851 |
context |
|
1852 |
fixes dummy_types :: \<open>'a::len \<times> 'b::len\<close> |
|
1853 |
begin |
|
1854 |
||
1855 |
private abbreviation (input) UCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
1856 |
where \<open>UCAST == ucast\<close> |
|
1857 |
||
1858 |
private abbreviation (input) SCAST :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
|
1859 |
where \<open>SCAST == scast\<close> |
|
1860 |
||
1861 |
lemma down_cast_same: |
|
1862 |
\<open>UCAST = scast\<close> if \<open>is_down UCAST\<close> |
|
1863 |
by (rule ext, use that in transfer) (simp add: take_bit_signed_take_bit) |
|
1864 |
||
1865 |
lemma sint_up_scast: |
|
1866 |
\<open>sint (SCAST w) = sint w\<close> if \<open>is_up SCAST\<close> |
|
1867 |
using that by transfer (simp add: min_def Suc_leI le_diff_iff) |
|
1868 |
||
1869 |
lemma uint_up_ucast: |
|
1870 |
\<open>uint (UCAST w) = uint w\<close> if \<open>is_up UCAST\<close> |
|
1871 |
using that by transfer (simp add: min_def) |
|
1872 |
||
1873 |
lemma ucast_up_ucast: |
|
1874 |
\<open>ucast (UCAST w) = ucast w\<close> if \<open>is_up UCAST\<close> |
|
1875 |
using that by transfer (simp add: ac_simps) |
|
1876 |
||
1877 |
lemma ucast_up_ucast_id: |
|
1878 |
\<open>ucast (UCAST w) = w\<close> if \<open>is_up UCAST\<close> |
|
1879 |
using that by (simp add: ucast_up_ucast) |
|
1880 |
||
1881 |
lemma scast_up_scast: |
|
1882 |
\<open>scast (SCAST w) = scast w\<close> if \<open>is_up SCAST\<close> |
|
1883 |
using that by transfer (simp add: ac_simps) |
|
1884 |
||
1885 |
lemma scast_up_scast_id: |
|
1886 |
\<open>scast (SCAST w) = w\<close> if \<open>is_up SCAST\<close> |
|
1887 |
using that by (simp add: scast_up_scast) |
|
1888 |
||
1889 |
lemma isduu: |
|
1890 |
\<open>is_up UCAST\<close> if \<open>is_down d\<close> |
|
1891 |
for d :: \<open>'b word \<Rightarrow> 'a word\<close> |
|
1892 |
using that is_up_down [of UCAST d] by simp |
|
1893 |
||
1894 |
lemma isdus: |
|
1895 |
\<open>is_up SCAST\<close> if \<open>is_down d\<close> |
|
1896 |
for d :: \<open>'b word \<Rightarrow> 'a word\<close> |
|
1897 |
using that is_up_down [of SCAST d] by simp |
|
1898 |
||
37660 | 1899 |
lemmas ucast_down_ucast_id = isduu [THEN ucast_up_ucast_id] |
72079 | 1900 |
lemmas scast_down_scast_id = isdus [THEN scast_up_scast_id] |
37660 | 1901 |
|
1902 |
lemma up_ucast_surj: |
|
72079 | 1903 |
\<open>surj (ucast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up UCAST\<close> |
1904 |
by (rule surjI) (use that in \<open>rule ucast_up_ucast_id\<close>) |
|
37660 | 1905 |
|
1906 |
lemma up_scast_surj: |
|
72079 | 1907 |
\<open>surj (scast :: 'b word \<Rightarrow> 'a word)\<close> if \<open>is_up SCAST\<close> |
1908 |
by (rule surjI) (use that in \<open>rule scast_up_scast_id\<close>) |
|
37660 | 1909 |
|
1910 |
lemma down_ucast_inj: |
|
72079 | 1911 |
\<open>inj_on UCAST A\<close> if \<open>is_down (ucast :: 'b word \<Rightarrow> 'a word)\<close> |
1912 |
by (rule inj_on_inverseI) (use that in \<open>rule ucast_down_ucast_id\<close>) |
|
1913 |
||
1914 |
lemma down_scast_inj: |
|
1915 |
\<open>inj_on SCAST A\<close> if \<open>is_down (scast :: 'b word \<Rightarrow> 'a word)\<close> |
|
1916 |
by (rule inj_on_inverseI) (use that in \<open>rule scast_down_scast_id\<close>) |
|
1917 |
||
1918 |
lemma ucast_down_wi: |
|
1919 |
\<open>UCAST (word_of_int x) = word_of_int x\<close> if \<open>is_down UCAST\<close> |
|
1920 |
using that by transfer simp |
|
1921 |
||
1922 |
lemma ucast_down_no: |
|
1923 |
\<open>UCAST (numeral bin) = numeral bin\<close> if \<open>is_down UCAST\<close> |
|
1924 |
using that by transfer simp |
|
1925 |
||
1926 |
end |
|
37660 | 1927 |
|
1928 |
lemmas test_bit_def' = word_test_bit_def [THEN fun_cong] |
|
1929 |
||
1930 |
lemmas word_log_defs = word_and_def word_or_def word_xor_def word_not_def |
|
1931 |
||
72000 | 1932 |
lemma bit_last_iff: |
1933 |
\<open>bit w (LENGTH('a) - Suc 0) \<longleftrightarrow> sint w < 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) |
|
1934 |
for w :: \<open>'a::len word\<close> |
|
1935 |
proof - |
|
1936 |
have \<open>?P \<longleftrightarrow> bit (uint w) (LENGTH('a) - Suc 0)\<close> |
|
1937 |
by (simp add: bit_uint_iff) |
|
1938 |
also have \<open>\<dots> \<longleftrightarrow> ?Q\<close> |
|
72010 | 1939 |
by (simp add: sint_uint) |
72000 | 1940 |
finally show ?thesis . |
1941 |
qed |
|
1942 |
||
1943 |
lemma drop_bit_eq_zero_iff_not_bit_last: |
|
1944 |
\<open>drop_bit (LENGTH('a) - Suc 0) w = 0 \<longleftrightarrow> \<not> bit w (LENGTH('a) - Suc 0)\<close> |
|
1945 |
for w :: "'a::len word" |
|
1946 |
apply (cases \<open>LENGTH('a)\<close>) |
|
1947 |
apply simp_all |
|
1948 |
apply (simp add: bit_iff_odd_drop_bit) |
|
1949 |
apply transfer |
|
1950 |
apply (simp add: take_bit_drop_bit) |
|
1951 |
apply (auto simp add: drop_bit_eq_div take_bit_eq_mod min_def) |
|
1952 |
apply (auto elim!: evenE) |
|
1953 |
apply (metis div_exp_eq mod_div_trivial mult.commute nonzero_mult_div_cancel_left power_Suc0_right power_add zero_neq_numeral) |
|
1954 |
done |
|
1955 |
||
37660 | 1956 |
|
61799 | 1957 |
subsection \<open>Word Arithmetic\<close> |
37660 | 1958 |
|
65268 | 1959 |
lemma word_less_alt: "a < b \<longleftrightarrow> uint a < uint b" |
55818 | 1960 |
by (fact word_less_def) |
37660 | 1961 |
|
1962 |
lemma signed_linorder: "class.linorder word_sle word_sless" |
|
72079 | 1963 |
by (standard; transfer) (auto simp add: signed_take_bit_decr_length_iff) |
37660 | 1964 |
|
1965 |
interpretation signed: linorder "word_sle" "word_sless" |
|
1966 |
by (rule signed_linorder) |
|
1967 |
||
65268 | 1968 |
lemma udvdI: "0 \<le> n \<Longrightarrow> uint b = n * uint a \<Longrightarrow> a udvd b" |
37660 | 1969 |
by (auto simp: udvd_def) |
1970 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1971 |
lemmas word_div_no [simp] = word_div_def [of "numeral a" "numeral b"] for a b |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1972 |
lemmas word_mod_no [simp] = word_mod_def [of "numeral a" "numeral b"] for a b |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1973 |
lemmas word_less_no [simp] = word_less_def [of "numeral a" "numeral b"] for a b |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
1974 |
lemmas word_le_no [simp] = word_le_def [of "numeral a" "numeral b"] for a b |
72079 | 1975 |
lemmas word_sless_no [simp] = word_sless_eq [of "numeral a" "numeral b"] for a b |
1976 |
lemmas word_sle_no [simp] = word_sle_eq [of "numeral a" "numeral b"] for a b |
|
37660 | 1977 |
|
65268 | 1978 |
lemma word_m1_wi: "- 1 = word_of_int (- 1)" |
1979 |
by (simp add: word_neg_numeral_alt [of Num.One]) |
|
37660 | 1980 |
|
65268 | 1981 |
lemma uint_0_iff: "uint x = 0 \<longleftrightarrow> x = 0" |
55818 | 1982 |
by (simp add: word_uint_eq_iff) |
1983 |
||
65268 | 1984 |
lemma unat_0_iff: "unat x = 0 \<longleftrightarrow> x = 0" |
72079 | 1985 |
by transfer (auto intro: antisym) |
65268 | 1986 |
|
1987 |
lemma unat_0 [simp]: "unat 0 = 0" |
|
72079 | 1988 |
by transfer simp |
65268 | 1989 |
|
1990 |
lemma size_0_same': "size w = 0 \<Longrightarrow> w = v" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
1991 |
for v w :: "'a::len word" |
72079 | 1992 |
by (unfold word_size) simp |
37660 | 1993 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
1994 |
lemmas size_0_same = size_0_same' [unfolded word_size] |
37660 | 1995 |
|
1996 |
lemmas unat_eq_0 = unat_0_iff |
|
1997 |
lemmas unat_eq_zero = unat_0_iff |
|
1998 |
||
65268 | 1999 |
lemma unat_gt_0: "0 < unat x \<longleftrightarrow> x \<noteq> 0" |
2000 |
by (auto simp: unat_0_iff [symmetric]) |
|
37660 | 2001 |
|
45958 | 2002 |
lemma ucast_0 [simp]: "ucast 0 = 0" |
72079 | 2003 |
by transfer simp |
45958 | 2004 |
|
2005 |
lemma sint_0 [simp]: "sint 0 = 0" |
|
65268 | 2006 |
by (simp add: sint_uint) |
45958 | 2007 |
|
2008 |
lemma scast_0 [simp]: "scast 0 = 0" |
|
72079 | 2009 |
by transfer simp |
37660 | 2010 |
|
58410
6d46ad54a2ab
explicit separation of signed and unsigned numerals using existing lexical categories num and xnum
haftmann
parents:
58061
diff
changeset
|
2011 |
lemma sint_n1 [simp] : "sint (- 1) = - 1" |
72079 | 2012 |
by transfer simp |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2013 |
|
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2014 |
lemma scast_n1 [simp]: "scast (- 1) = - 1" |
72079 | 2015 |
by transfer simp |
45958 | 2016 |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
2017 |
lemma uint_1: "uint (1::'a::len word) = 1" |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
2018 |
by (fact uint_1_eq) |
45958 | 2019 |
|
2020 |
lemma unat_1 [simp]: "unat (1::'a::len word) = 1" |
|
72079 | 2021 |
by transfer simp |
45958 | 2022 |
|
2023 |
lemma ucast_1 [simp]: "ucast (1::'a::len word) = 1" |
|
72079 | 2024 |
by transfer simp |
37660 | 2025 |
|
67408 | 2026 |
\<comment> \<open>now, to get the weaker results analogous to \<open>word_div\<close>/\<open>mod_def\<close>\<close> |
37660 | 2027 |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2028 |
|
61799 | 2029 |
subsection \<open>Transferring goals from words to ints\<close> |
37660 | 2030 |
|
65268 | 2031 |
lemma word_ths: |
2032 |
shows word_succ_p1: "word_succ a = a + 1" |
|
2033 |
and word_pred_m1: "word_pred a = a - 1" |
|
2034 |
and word_pred_succ: "word_pred (word_succ a) = a" |
|
2035 |
and word_succ_pred: "word_succ (word_pred a) = a" |
|
2036 |
and word_mult_succ: "word_succ a * b = b + a * b" |
|
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
2037 |
by (transfer, simp add: algebra_simps)+ |
37660 | 2038 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2039 |
lemma uint_cong: "x = y \<Longrightarrow> uint x = uint y" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2040 |
by simp |
37660 | 2041 |
|
55818 | 2042 |
lemma uint_word_ariths: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2043 |
fixes a b :: "'a::len word" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2044 |
shows "uint (a + b) = (uint a + uint b) mod 2 ^ LENGTH('a::len)" |
70185 | 2045 |
and "uint (a - b) = (uint a - uint b) mod 2 ^ LENGTH('a)" |
2046 |
and "uint (a * b) = uint a * uint b mod 2 ^ LENGTH('a)" |
|
2047 |
and "uint (- a) = - uint a mod 2 ^ LENGTH('a)" |
|
2048 |
and "uint (word_succ a) = (uint a + 1) mod 2 ^ LENGTH('a)" |
|
2049 |
and "uint (word_pred a) = (uint a - 1) mod 2 ^ LENGTH('a)" |
|
2050 |
and "uint (0 :: 'a word) = 0 mod 2 ^ LENGTH('a)" |
|
2051 |
and "uint (1 :: 'a word) = 1 mod 2 ^ LENGTH('a)" |
|
55818 | 2052 |
by (simp_all add: word_arith_wis [THEN trans [OF uint_cong int_word_uint]]) |
2053 |
||
2054 |
lemma uint_word_arith_bintrs: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2055 |
fixes a b :: "'a::len word" |
72128 | 2056 |
shows "uint (a + b) = take_bit (LENGTH('a)) (uint a + uint b)" |
2057 |
and "uint (a - b) = take_bit (LENGTH('a)) (uint a - uint b)" |
|
2058 |
and "uint (a * b) = take_bit (LENGTH('a)) (uint a * uint b)" |
|
2059 |
and "uint (- a) = take_bit (LENGTH('a)) (- uint a)" |
|
2060 |
and "uint (word_succ a) = take_bit (LENGTH('a)) (uint a + 1)" |
|
2061 |
and "uint (word_pred a) = take_bit (LENGTH('a)) (uint a - 1)" |
|
2062 |
and "uint (0 :: 'a word) = take_bit (LENGTH('a)) 0" |
|
2063 |
and "uint (1 :: 'a word) = take_bit (LENGTH('a)) 1" |
|
2064 |
by (simp_all add: uint_word_ariths take_bit_eq_mod) |
|
55818 | 2065 |
|
2066 |
lemma sint_word_ariths: |
|
2067 |
fixes a b :: "'a::len word" |
|
72128 | 2068 |
shows "sint (a + b) = signed_take_bit (LENGTH('a) - 1) (sint a + sint b)" |
2069 |
and "sint (a - b) = signed_take_bit (LENGTH('a) - 1) (sint a - sint b)" |
|
2070 |
and "sint (a * b) = signed_take_bit (LENGTH('a) - 1) (sint a * sint b)" |
|
2071 |
and "sint (- a) = signed_take_bit (LENGTH('a) - 1) (- sint a)" |
|
2072 |
and "sint (word_succ a) = signed_take_bit (LENGTH('a) - 1) (sint a + 1)" |
|
2073 |
and "sint (word_pred a) = signed_take_bit (LENGTH('a) - 1) (sint a - 1)" |
|
2074 |
and "sint (0 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 0" |
|
2075 |
and "sint (1 :: 'a word) = signed_take_bit (LENGTH('a) - 1) 1" |
|
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
2076 |
apply (simp_all only: word_sbin.inverse_norm [symmetric]) |
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
2077 |
apply (simp_all add: wi_hom_syms) |
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
2078 |
apply transfer apply simp |
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
2079 |
apply transfer apply simp |
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
2080 |
done |
45604 | 2081 |
|
2082 |
lemmas uint_div_alt = word_div_def [THEN trans [OF uint_cong int_word_uint]] |
|
2083 |
lemmas uint_mod_alt = word_mod_def [THEN trans [OF uint_cong int_word_uint]] |
|
37660 | 2084 |
|
58410
6d46ad54a2ab
explicit separation of signed and unsigned numerals using existing lexical categories num and xnum
haftmann
parents:
58061
diff
changeset
|
2085 |
lemma word_pred_0_n1: "word_pred 0 = word_of_int (- 1)" |
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
2086 |
unfolding word_pred_m1 by simp |
37660 | 2087 |
|
2088 |
lemma succ_pred_no [simp]: |
|
65268 | 2089 |
"word_succ (numeral w) = numeral w + 1" |
2090 |
"word_pred (numeral w) = numeral w - 1" |
|
2091 |
"word_succ (- numeral w) = - numeral w + 1" |
|
2092 |
"word_pred (- numeral w) = - numeral w - 1" |
|
2093 |
by (simp_all add: word_succ_p1 word_pred_m1) |
|
2094 |
||
2095 |
lemma word_sp_01 [simp]: |
|
2096 |
"word_succ (- 1) = 0 \<and> word_succ 0 = 1 \<and> word_pred 0 = - 1 \<and> word_pred 1 = 0" |
|
2097 |
by (simp_all add: word_succ_p1 word_pred_m1) |
|
37660 | 2098 |
|
67408 | 2099 |
\<comment> \<open>alternative approach to lifting arithmetic equalities\<close> |
65268 | 2100 |
lemma word_of_int_Ex: "\<exists>y. x = word_of_int y" |
37660 | 2101 |
by (rule_tac x="uint x" in exI) simp |
2102 |
||
2103 |
||
61799 | 2104 |
subsection \<open>Order on fixed-length words\<close> |
37660 | 2105 |
|
65328 | 2106 |
lemma word_zero_le [simp]: "0 \<le> y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2107 |
for y :: "'a::len word" |
37660 | 2108 |
unfolding word_le_def by auto |
65268 | 2109 |
|
65328 | 2110 |
lemma word_m1_ge [simp] : "word_pred 0 \<ge> y" (* FIXME: delete *) |
71997 | 2111 |
by transfer (simp add: take_bit_minus_one_eq_mask mask_eq_exp_minus_1 bintr_lt2p) |
65328 | 2112 |
|
2113 |
lemma word_n1_ge [simp]: "y \<le> -1" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2114 |
for y :: "'a::len word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2115 |
by (fact word_order.extremum) |
37660 | 2116 |
|
65268 | 2117 |
lemmas word_not_simps [simp] = |
37660 | 2118 |
word_zero_le [THEN leD] word_m1_ge [THEN leD] word_n1_ge [THEN leD] |
2119 |
||
65328 | 2120 |
lemma word_gt_0: "0 < y \<longleftrightarrow> 0 \<noteq> y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2121 |
for y :: "'a::len word" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2122 |
by (simp add: less_le) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2123 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2124 |
lemmas word_gt_0_no [simp] = word_gt_0 [of "numeral y"] for y |
37660 | 2125 |
|
65328 | 2126 |
lemma word_sless_alt: "a <s b \<longleftrightarrow> sint a < sint b" |
72079 | 2127 |
by (auto simp add: word_sle_eq word_sless_eq less_le) |
65328 | 2128 |
|
2129 |
lemma word_le_nat_alt: "a \<le> b \<longleftrightarrow> unat a \<le> unat b" |
|
72079 | 2130 |
by transfer (simp add: nat_le_eq_zle) |
37660 | 2131 |
|
65328 | 2132 |
lemma word_less_nat_alt: "a < b \<longleftrightarrow> unat a < unat b" |
72079 | 2133 |
by transfer (auto simp add: less_le [of 0]) |
65268 | 2134 |
|
70900 | 2135 |
lemmas unat_mono = word_less_nat_alt [THEN iffD1] |
2136 |
||
2137 |
instance word :: (len) wellorder |
|
2138 |
proof |
|
2139 |
fix P :: "'a word \<Rightarrow> bool" and a |
|
2140 |
assume *: "(\<And>b. (\<And>a. a < b \<Longrightarrow> P a) \<Longrightarrow> P b)" |
|
2141 |
have "wf (measure unat)" .. |
|
2142 |
moreover have "{(a, b :: ('a::len) word). a < b} \<subseteq> measure unat" |
|
2143 |
by (auto simp add: word_less_nat_alt) |
|
2144 |
ultimately have "wf {(a, b :: ('a::len) word). a < b}" |
|
2145 |
by (rule wf_subset) |
|
2146 |
then show "P a" using * |
|
2147 |
by induction blast |
|
2148 |
qed |
|
2149 |
||
65268 | 2150 |
lemma wi_less: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2151 |
"(word_of_int n < (word_of_int m :: 'a::len word)) = |
70185 | 2152 |
(n mod 2 ^ LENGTH('a) < m mod 2 ^ LENGTH('a))" |
37660 | 2153 |
unfolding word_less_alt by (simp add: word_uint.eq_norm) |
2154 |
||
65268 | 2155 |
lemma wi_le: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2156 |
"(word_of_int n \<le> (word_of_int m :: 'a::len word)) = |
70185 | 2157 |
(n mod 2 ^ LENGTH('a) \<le> m mod 2 ^ LENGTH('a))" |
37660 | 2158 |
unfolding word_le_def by (simp add: word_uint.eq_norm) |
2159 |
||
65328 | 2160 |
lemma udvd_nat_alt: "a udvd b \<longleftrightarrow> (\<exists>n\<ge>0. unat b = n * unat a)" |
72079 | 2161 |
supply nat_uint_eq [simp del] |
37660 | 2162 |
apply (unfold udvd_def) |
2163 |
apply safe |
|
72079 | 2164 |
apply (simp add: unat_eq_nat_uint nat_mult_distrib) |
65328 | 2165 |
apply (simp add: uint_nat) |
37660 | 2166 |
apply (rule exI) |
2167 |
apply safe |
|
2168 |
prefer 2 |
|
2169 |
apply (erule notE) |
|
2170 |
apply (rule refl) |
|
2171 |
apply force |
|
2172 |
done |
|
2173 |
||
61941 | 2174 |
lemma udvd_iff_dvd: "x udvd y \<longleftrightarrow> unat x dvd unat y" |
37660 | 2175 |
unfolding dvd_def udvd_nat_alt by force |
2176 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2177 |
lemma unat_minus_one: |
72079 | 2178 |
\<open>unat (w - 1) = unat w - 1\<close> if \<open>w \<noteq> 0\<close> |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2179 |
proof - |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2180 |
have "0 \<le> uint w" by (fact uint_nonnegative) |
72079 | 2181 |
moreover from that have "0 \<noteq> uint w" |
65328 | 2182 |
by (simp add: uint_0_iff) |
2183 |
ultimately have "1 \<le> uint w" |
|
2184 |
by arith |
|
70185 | 2185 |
from uint_lt2p [of w] have "uint w - 1 < 2 ^ LENGTH('a)" |
65328 | 2186 |
by arith |
70185 | 2187 |
with \<open>1 \<le> uint w\<close> have "(uint w - 1) mod 2 ^ LENGTH('a) = uint w - 1" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2188 |
by (auto intro: mod_pos_pos_trivial) |
70185 | 2189 |
with \<open>1 \<le> uint w\<close> have "nat ((uint w - 1) mod 2 ^ LENGTH('a)) = nat (uint w) - 1" |
72079 | 2190 |
by (auto simp del: nat_uint_eq) |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2191 |
then show ?thesis |
72079 | 2192 |
by (simp only: unat_eq_nat_uint int_word_uint word_arith_wis mod_diff_right_eq) |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2193 |
qed |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2194 |
|
65328 | 2195 |
lemma measure_unat: "p \<noteq> 0 \<Longrightarrow> unat (p - 1) < unat p" |
37660 | 2196 |
by (simp add: unat_minus_one) (simp add: unat_0_iff [symmetric]) |
65268 | 2197 |
|
45604 | 2198 |
lemmas uint_add_ge0 [simp] = add_nonneg_nonneg [OF uint_ge_0 uint_ge_0] |
2199 |
lemmas uint_mult_ge0 [simp] = mult_nonneg_nonneg [OF uint_ge_0 uint_ge_0] |
|
37660 | 2200 |
|
70185 | 2201 |
lemma uint_sub_lt2p [simp]: "uint x - uint y < 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2202 |
for x :: "'a::len word" and y :: "'b::len word" |
37660 | 2203 |
using uint_ge_0 [of y] uint_lt2p [of x] by arith |
2204 |
||
2205 |
||
61799 | 2206 |
subsection \<open>Conditions for the addition (etc) of two words to overflow\<close> |
37660 | 2207 |
|
65268 | 2208 |
lemma uint_add_lem: |
70185 | 2209 |
"(uint x + uint y < 2 ^ LENGTH('a)) = |
65328 | 2210 |
(uint (x + y) = uint x + uint y)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2211 |
for x y :: "'a::len word" |
71997 | 2212 |
by (metis add.right_neutral add_mono_thms_linordered_semiring(1) mod_pos_pos_trivial of_nat_0_le_iff uint_lt2p uint_nat uint_word_ariths(1)) |
37660 | 2213 |
|
65268 | 2214 |
lemma uint_mult_lem: |
70185 | 2215 |
"(uint x * uint y < 2 ^ LENGTH('a)) = |
65328 | 2216 |
(uint (x * y) = uint x * uint y)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2217 |
for x y :: "'a::len word" |
71997 | 2218 |
by (metis mod_pos_pos_trivial uint_lt2p uint_mult_ge0 uint_word_ariths(3)) |
37660 | 2219 |
|
65328 | 2220 |
lemma uint_sub_lem: "uint x \<ge> uint y \<longleftrightarrow> uint (x - y) = uint x - uint y" |
71997 | 2221 |
by (metis (mono_tags, hide_lams) diff_ge_0_iff_ge mod_pos_pos_trivial of_nat_0_le_iff take_bit_eq_mod uint_nat uint_sub_lt2p word_sub_wi word_ubin.eq_norm) find_theorems uint \<open>- _\<close> |
65328 | 2222 |
|
2223 |
lemma uint_add_le: "uint (x + y) \<le> uint x + uint y" |
|
71997 | 2224 |
unfolding uint_word_ariths by (simp add: zmod_le_nonneg_dividend) |
37660 | 2225 |
|
65328 | 2226 |
lemma uint_sub_ge: "uint (x - y) \<ge> uint x - uint y" |
71997 | 2227 |
unfolding uint_word_ariths by (simp add: int_mod_ge) |
2228 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2229 |
lemma mod_add_if_z: |
65328 | 2230 |
"x < z \<Longrightarrow> y < z \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> z \<Longrightarrow> |
2231 |
(x + y) mod z = (if x + y < z then x + y else x + y - z)" |
|
2232 |
for x y z :: int |
|
71997 | 2233 |
apply (auto simp add: not_less) |
2234 |
apply (rule antisym) |
|
2235 |
apply (metis diff_ge_0_iff_ge minus_mod_self2 zmod_le_nonneg_dividend) |
|
2236 |
apply (simp only: flip: minus_mod_self2 [of \<open>x + y\<close> z]) |
|
2237 |
apply (rule int_mod_ge) |
|
2238 |
apply simp_all |
|
2239 |
done |
|
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2240 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2241 |
lemma uint_plus_if': |
65328 | 2242 |
"uint (a + b) = |
70185 | 2243 |
(if uint a + uint b < 2 ^ LENGTH('a) then uint a + uint b |
2244 |
else uint a + uint b - 2 ^ LENGTH('a))" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2245 |
for a b :: "'a::len word" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2246 |
using mod_add_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2247 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2248 |
lemma mod_sub_if_z: |
65328 | 2249 |
"x < z \<Longrightarrow> y < z \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> z \<Longrightarrow> |
2250 |
(x - y) mod z = (if y \<le> x then x - y else x - y + z)" |
|
2251 |
for x y z :: int |
|
71997 | 2252 |
apply (auto simp add: not_le) |
2253 |
apply (rule antisym) |
|
2254 |
apply (simp only: flip: mod_add_self2 [of \<open>x - y\<close> z]) |
|
2255 |
apply (rule zmod_le_nonneg_dividend) |
|
2256 |
apply simp |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
2257 |
apply (metis add.commute add.right_neutral add_le_cancel_left diff_ge_0_iff_ge int_mod_ge le_less le_less_trans mod_add_self1 not_less) |
71997 | 2258 |
done |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2259 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2260 |
lemma uint_sub_if': |
65328 | 2261 |
"uint (a - b) = |
2262 |
(if uint b \<le> uint a then uint a - uint b |
|
70185 | 2263 |
else uint a - uint b + 2 ^ LENGTH('a))" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2264 |
for a b :: "'a::len word" |
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2265 |
using mod_sub_if_z [of "uint a" _ "uint b"] by (simp add: uint_word_ariths) |
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2266 |
|
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
2267 |
|
61799 | 2268 |
subsection \<open>Definition of \<open>uint_arith\<close>\<close> |
37660 | 2269 |
|
2270 |
lemma word_of_int_inverse: |
|
70185 | 2271 |
"word_of_int r = a \<Longrightarrow> 0 \<le> r \<Longrightarrow> r < 2 ^ LENGTH('a) \<Longrightarrow> uint a = r" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2272 |
for a :: "'a::len word" |
37660 | 2273 |
apply (erule word_uint.Abs_inverse' [rotated]) |
2274 |
apply (simp add: uints_num) |
|
2275 |
done |
|
2276 |
||
2277 |
lemma uint_split: |
|
70185 | 2278 |
"P (uint x) = (\<forall>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<longrightarrow> P i)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2279 |
for x :: "'a::len word" |
72079 | 2280 |
by transfer (auto simp add: take_bit_eq_mod take_bit_int_less_exp) |
37660 | 2281 |
|
2282 |
lemma uint_split_asm: |
|
70185 | 2283 |
"P (uint x) = (\<nexists>i. word_of_int i = x \<and> 0 \<le> i \<and> i < 2^LENGTH('a) \<and> \<not> P i)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2284 |
for x :: "'a::len word" |
65268 | 2285 |
by (auto dest!: word_of_int_inverse |
71942 | 2286 |
simp: int_word_uint |
65328 | 2287 |
split: uint_split) |
37660 | 2288 |
|
2289 |
lemmas uint_splits = uint_split uint_split_asm |
|
2290 |
||
65268 | 2291 |
lemmas uint_arith_simps = |
37660 | 2292 |
word_le_def word_less_alt |
65268 | 2293 |
word_uint.Rep_inject [symmetric] |
37660 | 2294 |
uint_sub_if' uint_plus_if' |
2295 |
||
70185 | 2296 |
\<comment> \<open>use this to stop, eg. \<open>2 ^ LENGTH(32)\<close> being simplified\<close> |
65268 | 2297 |
lemma power_False_cong: "False \<Longrightarrow> a ^ b = c ^ d" |
37660 | 2298 |
by auto |
2299 |
||
67408 | 2300 |
\<comment> \<open>\<open>uint_arith_tac\<close>: reduce to arithmetic on int, try to solve by arith\<close> |
61799 | 2301 |
ML \<open> |
65268 | 2302 |
fun uint_arith_simpset ctxt = |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2303 |
ctxt addsimps @{thms uint_arith_simps} |
37660 | 2304 |
delsimps @{thms word_uint.Rep_inject} |
62390 | 2305 |
|> fold Splitter.add_split @{thms if_split_asm} |
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
2306 |
|> fold Simplifier.add_cong @{thms power_False_cong} |
37660 | 2307 |
|
65268 | 2308 |
fun uint_arith_tacs ctxt = |
37660 | 2309 |
let |
2310 |
fun arith_tac' n t = |
|
59657
2441a80fb6c1
eliminated unused arith "verbose" flag -- tools that need options can use the context;
wenzelm
parents:
59498
diff
changeset
|
2311 |
Arith_Data.arith_tac ctxt n t |
37660 | 2312 |
handle Cooper.COOPER _ => Seq.empty; |
65268 | 2313 |
in |
42793 | 2314 |
[ clarify_tac ctxt 1, |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2315 |
full_simp_tac (uint_arith_simpset ctxt) 1, |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2316 |
ALLGOALS (full_simp_tac |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2317 |
(put_simpset HOL_ss ctxt |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2318 |
|> fold Splitter.add_split @{thms uint_splits} |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2319 |
|> fold Simplifier.add_cong @{thms power_False_cong})), |
65268 | 2320 |
rewrite_goals_tac ctxt @{thms word_size}, |
59498
50b60f501b05
proper context for resolve_tac, eresolve_tac, dresolve_tac, forward_tac etc.;
wenzelm
parents:
59487
diff
changeset
|
2321 |
ALLGOALS (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN |
60754 | 2322 |
REPEAT (eresolve_tac ctxt [conjE] n) THEN |
65268 | 2323 |
REPEAT (dresolve_tac ctxt @{thms word_of_int_inverse} n |
2324 |
THEN assume_tac ctxt n |
|
58963
26bf09b95dda
proper context for assume_tac (atac remains as fall-back without context);
wenzelm
parents:
58874
diff
changeset
|
2325 |
THEN assume_tac ctxt n)), |
37660 | 2326 |
TRYALL arith_tac' ] |
2327 |
end |
|
2328 |
||
2329 |
fun uint_arith_tac ctxt = SELECT_GOAL (EVERY (uint_arith_tacs ctxt)) |
|
61799 | 2330 |
\<close> |
37660 | 2331 |
|
65268 | 2332 |
method_setup uint_arith = |
61799 | 2333 |
\<open>Scan.succeed (SIMPLE_METHOD' o uint_arith_tac)\<close> |
37660 | 2334 |
"solving word arithmetic via integers and arith" |
2335 |
||
2336 |
||
61799 | 2337 |
subsection \<open>More on overflows and monotonicity\<close> |
37660 | 2338 |
|
65328 | 2339 |
lemma no_plus_overflow_uint_size: "x \<le> x + y \<longleftrightarrow> uint x + uint y < 2 ^ size x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2340 |
for x y :: "'a::len word" |
37660 | 2341 |
unfolding word_size by uint_arith |
2342 |
||
2343 |
lemmas no_olen_add = no_plus_overflow_uint_size [unfolded word_size] |
|
2344 |
||
65328 | 2345 |
lemma no_ulen_sub: "x \<ge> x - y \<longleftrightarrow> uint y \<le> uint x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2346 |
for x y :: "'a::len word" |
37660 | 2347 |
by uint_arith |
2348 |
||
70185 | 2349 |
lemma no_olen_add': "x \<le> y + x \<longleftrightarrow> uint y + uint x < 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2350 |
for x y :: "'a::len word" |
57514
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
haftmann
parents:
57512
diff
changeset
|
2351 |
by (simp add: ac_simps no_olen_add) |
37660 | 2352 |
|
45604 | 2353 |
lemmas olen_add_eqv = trans [OF no_olen_add no_olen_add' [symmetric]] |
2354 |
||
2355 |
lemmas uint_plus_simple_iff = trans [OF no_olen_add uint_add_lem] |
|
2356 |
lemmas uint_plus_simple = uint_plus_simple_iff [THEN iffD1] |
|
2357 |
lemmas uint_minus_simple_iff = trans [OF no_ulen_sub uint_sub_lem] |
|
37660 | 2358 |
lemmas uint_minus_simple_alt = uint_sub_lem [folded word_le_def] |
2359 |
lemmas word_sub_le_iff = no_ulen_sub [folded word_le_def] |
|
45604 | 2360 |
lemmas word_sub_le = word_sub_le_iff [THEN iffD2] |
37660 | 2361 |
|
65328 | 2362 |
lemma word_less_sub1: "x \<noteq> 0 \<Longrightarrow> 1 < x \<longleftrightarrow> 0 < x - 1" |
2363 |
for x :: "'a::len word" |
|
37660 | 2364 |
by uint_arith |
2365 |
||
65328 | 2366 |
lemma word_le_sub1: "x \<noteq> 0 \<Longrightarrow> 1 \<le> x \<longleftrightarrow> 0 \<le> x - 1" |
2367 |
for x :: "'a::len word" |
|
37660 | 2368 |
by uint_arith |
2369 |
||
65328 | 2370 |
lemma sub_wrap_lt: "x < x - z \<longleftrightarrow> x < z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2371 |
for x z :: "'a::len word" |
37660 | 2372 |
by uint_arith |
2373 |
||
65328 | 2374 |
lemma sub_wrap: "x \<le> x - z \<longleftrightarrow> z = 0 \<or> x < z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2375 |
for x z :: "'a::len word" |
37660 | 2376 |
by uint_arith |
2377 |
||
65328 | 2378 |
lemma plus_minus_not_NULL_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> c \<noteq> 0 \<Longrightarrow> x + c \<noteq> 0" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2379 |
for x ab c :: "'a::len word" |
37660 | 2380 |
by uint_arith |
2381 |
||
65328 | 2382 |
lemma plus_minus_no_overflow_ab: "x \<le> ab - c \<Longrightarrow> c \<le> ab \<Longrightarrow> x \<le> x + c" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2383 |
for x ab c :: "'a::len word" |
37660 | 2384 |
by uint_arith |
2385 |
||
65328 | 2386 |
lemma le_minus': "a + c \<le> b \<Longrightarrow> a \<le> a + c \<Longrightarrow> c \<le> b - a" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2387 |
for a b c :: "'a::len word" |
37660 | 2388 |
by uint_arith |
2389 |
||
65328 | 2390 |
lemma le_plus': "a \<le> b \<Longrightarrow> c \<le> b - a \<Longrightarrow> a + c \<le> b" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2391 |
for a b c :: "'a::len word" |
37660 | 2392 |
by uint_arith |
2393 |
||
2394 |
lemmas le_plus = le_plus' [rotated] |
|
2395 |
||
46011 | 2396 |
lemmas le_minus = leD [THEN thin_rl, THEN le_minus'] (* FIXME *) |
37660 | 2397 |
|
65328 | 2398 |
lemma word_plus_mono_right: "y \<le> z \<Longrightarrow> x \<le> x + z \<Longrightarrow> x + y \<le> x + z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2399 |
for x y z :: "'a::len word" |
37660 | 2400 |
by uint_arith |
2401 |
||
65328 | 2402 |
lemma word_less_minus_cancel: "y - x < z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y < z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2403 |
for x y z :: "'a::len word" |
37660 | 2404 |
by uint_arith |
2405 |
||
65328 | 2406 |
lemma word_less_minus_mono_left: "y < z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x < z - x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2407 |
for x y z :: "'a::len word" |
37660 | 2408 |
by uint_arith |
2409 |
||
65328 | 2410 |
lemma word_less_minus_mono: "a < c \<Longrightarrow> d < b \<Longrightarrow> a - b < a \<Longrightarrow> c - d < c \<Longrightarrow> a - b < c - d" |
2411 |
for a b c d :: "'a::len word" |
|
37660 | 2412 |
by uint_arith |
2413 |
||
65328 | 2414 |
lemma word_le_minus_cancel: "y - x \<le> z - x \<Longrightarrow> x \<le> z \<Longrightarrow> y \<le> z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2415 |
for x y z :: "'a::len word" |
37660 | 2416 |
by uint_arith |
2417 |
||
65328 | 2418 |
lemma word_le_minus_mono_left: "y \<le> z \<Longrightarrow> x \<le> y \<Longrightarrow> y - x \<le> z - x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2419 |
for x y z :: "'a::len word" |
37660 | 2420 |
by uint_arith |
2421 |
||
65268 | 2422 |
lemma word_le_minus_mono: |
65328 | 2423 |
"a \<le> c \<Longrightarrow> d \<le> b \<Longrightarrow> a - b \<le> a \<Longrightarrow> c - d \<le> c \<Longrightarrow> a - b \<le> c - d" |
2424 |
for a b c d :: "'a::len word" |
|
37660 | 2425 |
by uint_arith |
2426 |
||
65328 | 2427 |
lemma plus_le_left_cancel_wrap: "x + y' < x \<Longrightarrow> x + y < x \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2428 |
for x y y' :: "'a::len word" |
37660 | 2429 |
by uint_arith |
2430 |
||
65328 | 2431 |
lemma plus_le_left_cancel_nowrap: "x \<le> x + y' \<Longrightarrow> x \<le> x + y \<Longrightarrow> x + y' < x + y \<longleftrightarrow> y' < y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2432 |
for x y y' :: "'a::len word" |
37660 | 2433 |
by uint_arith |
2434 |
||
65328 | 2435 |
lemma word_plus_mono_right2: "a \<le> a + b \<Longrightarrow> c \<le> b \<Longrightarrow> a \<le> a + c" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2436 |
for a b c :: "'a::len word" |
65328 | 2437 |
by uint_arith |
2438 |
||
2439 |
lemma word_less_add_right: "x < y - z \<Longrightarrow> z \<le> y \<Longrightarrow> x + z < y" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2440 |
for x y z :: "'a::len word" |
37660 | 2441 |
by uint_arith |
2442 |
||
65328 | 2443 |
lemma word_less_sub_right: "x < y + z \<Longrightarrow> y \<le> x \<Longrightarrow> x - y < z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2444 |
for x y z :: "'a::len word" |
37660 | 2445 |
by uint_arith |
2446 |
||
65328 | 2447 |
lemma word_le_plus_either: "x \<le> y \<or> x \<le> z \<Longrightarrow> y \<le> y + z \<Longrightarrow> x \<le> y + z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2448 |
for x y z :: "'a::len word" |
37660 | 2449 |
by uint_arith |
2450 |
||
65328 | 2451 |
lemma word_less_nowrapI: "x < z - k \<Longrightarrow> k \<le> z \<Longrightarrow> 0 < k \<Longrightarrow> x < x + k" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2452 |
for x z k :: "'a::len word" |
37660 | 2453 |
by uint_arith |
2454 |
||
65328 | 2455 |
lemma inc_le: "i < m \<Longrightarrow> i + 1 \<le> m" |
2456 |
for i m :: "'a::len word" |
|
37660 | 2457 |
by uint_arith |
2458 |
||
65328 | 2459 |
lemma inc_i: "1 \<le> i \<Longrightarrow> i < m \<Longrightarrow> 1 \<le> i + 1 \<and> i + 1 \<le> m" |
2460 |
for i m :: "'a::len word" |
|
37660 | 2461 |
by uint_arith |
2462 |
||
2463 |
lemma udvd_incr_lem: |
|
65268 | 2464 |
"up < uq \<Longrightarrow> up = ua + n * uint K \<Longrightarrow> |
65328 | 2465 |
uq = ua + n' * uint K \<Longrightarrow> up + uint K \<le> uq" |
71997 | 2466 |
by auto (metis int_distrib(1) linorder_not_less mult.left_neutral mult_right_mono uint_nonnegative zless_imp_add1_zle) |
37660 | 2467 |
|
65268 | 2468 |
lemma udvd_incr': |
2469 |
"p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow> |
|
65328 | 2470 |
uint q = ua + n' * uint K \<Longrightarrow> p + K \<le> q" |
37660 | 2471 |
apply (unfold word_less_alt word_le_def) |
2472 |
apply (drule (2) udvd_incr_lem) |
|
2473 |
apply (erule uint_add_le [THEN order_trans]) |
|
2474 |
done |
|
2475 |
||
65268 | 2476 |
lemma udvd_decr': |
2477 |
"p < q \<Longrightarrow> uint p = ua + n * uint K \<Longrightarrow> |
|
65328 | 2478 |
uint q = ua + n' * uint K \<Longrightarrow> p \<le> q - K" |
37660 | 2479 |
apply (unfold word_less_alt word_le_def) |
2480 |
apply (drule (2) udvd_incr_lem) |
|
2481 |
apply (drule le_diff_eq [THEN iffD2]) |
|
2482 |
apply (erule order_trans) |
|
2483 |
apply (rule uint_sub_ge) |
|
2484 |
done |
|
2485 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2486 |
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
|
2487 |
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
|
2488 |
lemmas udvd_decr0 = udvd_decr' [where ua=0, unfolded add_0_left] |
37660 | 2489 |
|
65328 | 2490 |
lemma udvd_minus_le': "xy < k \<Longrightarrow> z udvd xy \<Longrightarrow> z udvd k \<Longrightarrow> xy \<le> k - z" |
37660 | 2491 |
apply (unfold udvd_def) |
2492 |
apply clarify |
|
2493 |
apply (erule (2) udvd_decr0) |
|
2494 |
done |
|
2495 |
||
65268 | 2496 |
lemma udvd_incr2_K: |
65328 | 2497 |
"p < a + s \<Longrightarrow> a \<le> a + s \<Longrightarrow> K udvd s \<Longrightarrow> K udvd p - a \<Longrightarrow> a \<le> p \<Longrightarrow> |
2498 |
0 < K \<Longrightarrow> p \<le> p + K \<and> p + K \<le> a + s" |
|
2499 |
supply [[simproc del: linordered_ring_less_cancel_factor]] |
|
37660 | 2500 |
apply (unfold udvd_def) |
2501 |
apply clarify |
|
62390 | 2502 |
apply (simp add: uint_arith_simps split: if_split_asm) |
65268 | 2503 |
prefer 2 |
37660 | 2504 |
apply (insert uint_range' [of s])[1] |
2505 |
apply arith |
|
71997 | 2506 |
apply (drule add.commute [THEN xtrans(1)]) |
2507 |
apply (simp flip: diff_less_eq) |
|
2508 |
apply (subst (asm) mult_less_cancel_right) |
|
37660 | 2509 |
apply simp |
71997 | 2510 |
apply (simp add: diff_eq_eq not_less) |
2511 |
apply (subst (asm) (3) zless_iff_Suc_zadd) |
|
2512 |
apply auto |
|
2513 |
apply (auto simp add: algebra_simps) |
|
2514 |
apply (drule less_le_trans [of _ \<open>2 ^ LENGTH('a)\<close>]) apply assumption |
|
2515 |
apply (simp add: mult_less_0_iff) |
|
37660 | 2516 |
done |
2517 |
||
2518 |
||
61799 | 2519 |
subsection \<open>Arithmetic type class instantiations\<close> |
37660 | 2520 |
|
2521 |
lemmas word_le_0_iff [simp] = |
|
70749
5d06b7bb9d22
More type class generalisations. Note that linorder_antisym_conv1 and linorder_antisym_conv2 no longer exist.
paulson <lp15@cam.ac.uk>
parents:
70342
diff
changeset
|
2522 |
word_zero_le [THEN leD, THEN antisym_conv1] |
37660 | 2523 |
|
65328 | 2524 |
lemma word_of_int_nat: "0 \<le> x \<Longrightarrow> word_of_int x = of_nat (nat x)" |
2525 |
by (simp add: word_of_int) |
|
37660 | 2526 |
|
67408 | 2527 |
text \<open> |
2528 |
note that \<open>iszero_def\<close> is only for class \<open>comm_semiring_1_cancel\<close>, |
|
2529 |
which requires word length \<open>\<ge> 1\<close>, ie \<open>'a::len word\<close> |
|
2530 |
\<close> |
|
46603 | 2531 |
lemma iszero_word_no [simp]: |
65268 | 2532 |
"iszero (numeral bin :: 'a::len word) = |
72128 | 2533 |
iszero (take_bit LENGTH('a) (numeral bin :: int))" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2534 |
using word_ubin.norm_eq_iff [where 'a='a, of "numeral bin" 0] |
46603 | 2535 |
by (simp add: iszero_def [symmetric]) |
65268 | 2536 |
|
61799 | 2537 |
text \<open>Use \<open>iszero\<close> to simplify equalities between word numerals.\<close> |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2538 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2539 |
lemmas word_eq_numeral_iff_iszero [simp] = |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2540 |
eq_numeral_iff_iszero [where 'a="'a::len word"] |
46603 | 2541 |
|
37660 | 2542 |
|
61799 | 2543 |
subsection \<open>Word and nat\<close> |
37660 | 2544 |
|
45811 | 2545 |
lemma td_ext_unat [OF refl]: |
70185 | 2546 |
"n = LENGTH('a::len) \<Longrightarrow> |
65328 | 2547 |
td_ext (unat :: 'a word \<Rightarrow> nat) of_nat (unats n) (\<lambda>i. i mod 2 ^ n)" |
72079 | 2548 |
apply (standard; transfer) |
2549 |
apply (simp_all add: unats_def take_bit_int_less_exp take_bit_of_nat take_bit_eq_self) |
|
2550 |
apply (simp add: take_bit_eq_mod) |
|
37660 | 2551 |
done |
2552 |
||
45604 | 2553 |
lemmas unat_of_nat = td_ext_unat [THEN td_ext.eq_norm] |
37660 | 2554 |
|
2555 |
interpretation word_unat: |
|
65328 | 2556 |
td_ext |
2557 |
"unat::'a::len word \<Rightarrow> nat" |
|
2558 |
of_nat |
|
70185 | 2559 |
"unats (LENGTH('a::len))" |
2560 |
"\<lambda>i. i mod 2 ^ LENGTH('a::len)" |
|
37660 | 2561 |
by (rule td_ext_unat) |
2562 |
||
2563 |
lemmas td_unat = word_unat.td_thm |
|
2564 |
||
2565 |
lemmas unat_lt2p [iff] = word_unat.Rep [unfolded unats_def mem_Collect_eq] |
|
2566 |
||
70185 | 2567 |
lemma unat_le: "y \<le> unat z \<Longrightarrow> y \<in> unats (LENGTH('a))" |
65328 | 2568 |
for z :: "'a::len word" |
37660 | 2569 |
apply (unfold unats_def) |
2570 |
apply clarsimp |
|
65268 | 2571 |
apply (rule xtrans, rule unat_lt2p, assumption) |
37660 | 2572 |
done |
2573 |
||
70185 | 2574 |
lemma word_nchotomy: "\<forall>w :: 'a::len word. \<exists>n. w = of_nat n \<and> n < 2 ^ LENGTH('a)" |
37660 | 2575 |
apply (rule allI) |
2576 |
apply (rule word_unat.Abs_cases) |
|
2577 |
apply (unfold unats_def) |
|
2578 |
apply auto |
|
2579 |
done |
|
2580 |
||
70185 | 2581 |
lemma of_nat_eq: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ LENGTH('a))" |
65328 | 2582 |
for w :: "'a::len word" |
68157 | 2583 |
using mod_div_mult_eq [of n "2 ^ LENGTH('a)", symmetric] |
2584 |
by (auto simp add: word_unat.inverse_norm) |
|
37660 | 2585 |
|
65328 | 2586 |
lemma of_nat_eq_size: "of_nat n = w \<longleftrightarrow> (\<exists>q. n = unat w + q * 2 ^ size w)" |
37660 | 2587 |
unfolding word_size by (rule of_nat_eq) |
2588 |
||
70185 | 2589 |
lemma of_nat_0: "of_nat m = (0::'a::len word) \<longleftrightarrow> (\<exists>q. m = q * 2 ^ LENGTH('a))" |
37660 | 2590 |
by (simp add: of_nat_eq) |
2591 |
||
70185 | 2592 |
lemma of_nat_2p [simp]: "of_nat (2 ^ LENGTH('a)) = (0::'a::len word)" |
45805 | 2593 |
by (fact mult_1 [symmetric, THEN iffD2 [OF of_nat_0 exI]]) |
37660 | 2594 |
|
65328 | 2595 |
lemma of_nat_gt_0: "of_nat k \<noteq> 0 \<Longrightarrow> 0 < k" |
37660 | 2596 |
by (cases k) auto |
2597 |
||
70185 | 2598 |
lemma of_nat_neq_0: "0 < k \<Longrightarrow> k < 2 ^ LENGTH('a::len) \<Longrightarrow> of_nat k \<noteq> (0 :: 'a word)" |
65328 | 2599 |
by (auto simp add : of_nat_0) |
2600 |
||
2601 |
lemma Abs_fnat_hom_add: "of_nat a + of_nat b = of_nat (a + b)" |
|
37660 | 2602 |
by simp |
2603 |
||
65328 | 2604 |
lemma Abs_fnat_hom_mult: "of_nat a * of_nat b = (of_nat (a * b) :: 'a::len word)" |
61649
268d88ec9087
Tweaks for "real": Removal of [iff] status for some lemmas, adding [simp] for others. Plus fixes.
paulson <lp15@cam.ac.uk>
parents:
61424
diff
changeset
|
2605 |
by (simp add: word_of_nat wi_hom_mult) |
37660 | 2606 |
|
65328 | 2607 |
lemma Abs_fnat_hom_Suc: "word_succ (of_nat a) = of_nat (Suc a)" |
57514
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
haftmann
parents:
57512
diff
changeset
|
2608 |
by (simp add: word_of_nat wi_hom_succ ac_simps) |
37660 | 2609 |
|
2610 |
lemma Abs_fnat_hom_0: "(0::'a::len word) = of_nat 0" |
|
45995
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
2611 |
by simp |
37660 | 2612 |
|
2613 |
lemma Abs_fnat_hom_1: "(1::'a::len word) = of_nat (Suc 0)" |
|
45995
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
2614 |
by simp |
37660 | 2615 |
|
65268 | 2616 |
lemmas Abs_fnat_homs = |
2617 |
Abs_fnat_hom_add Abs_fnat_hom_mult Abs_fnat_hom_Suc |
|
37660 | 2618 |
Abs_fnat_hom_0 Abs_fnat_hom_1 |
2619 |
||
65328 | 2620 |
lemma word_arith_nat_add: "a + b = of_nat (unat a + unat b)" |
2621 |
by simp |
|
2622 |
||
2623 |
lemma word_arith_nat_mult: "a * b = of_nat (unat a * unat b)" |
|
37660 | 2624 |
by simp |
2625 |
||
65328 | 2626 |
lemma word_arith_nat_Suc: "word_succ a = of_nat (Suc (unat a))" |
37660 | 2627 |
by (subst Abs_fnat_hom_Suc [symmetric]) simp |
2628 |
||
65328 | 2629 |
lemma word_arith_nat_div: "a div b = of_nat (unat a div unat b)" |
37660 | 2630 |
by (simp add: word_div_def word_of_nat zdiv_int uint_nat) |
2631 |
||
65328 | 2632 |
lemma word_arith_nat_mod: "a mod b = of_nat (unat a mod unat b)" |
37660 | 2633 |
by (simp add: word_mod_def word_of_nat zmod_int uint_nat) |
2634 |
||
2635 |
lemmas word_arith_nat_defs = |
|
2636 |
word_arith_nat_add word_arith_nat_mult |
|
2637 |
word_arith_nat_Suc Abs_fnat_hom_0 |
|
2638 |
Abs_fnat_hom_1 word_arith_nat_div |
|
65268 | 2639 |
word_arith_nat_mod |
37660 | 2640 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2641 |
lemma unat_cong: "x = y \<Longrightarrow> unat x = unat y" |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2642 |
by simp |
65268 | 2643 |
|
37660 | 2644 |
lemmas unat_word_ariths = word_arith_nat_defs |
45604 | 2645 |
[THEN trans [OF unat_cong unat_of_nat]] |
37660 | 2646 |
|
2647 |
lemmas word_sub_less_iff = word_sub_le_iff |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
2648 |
[unfolded linorder_not_less [symmetric] Not_eq_iff] |
37660 | 2649 |
|
65268 | 2650 |
lemma unat_add_lem: |
70185 | 2651 |
"unat x + unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x + y) = unat x + unat y" |
65328 | 2652 |
for x y :: "'a::len word" |
71997 | 2653 |
apply (auto simp: unat_word_ariths) |
2654 |
apply (metis unat_lt2p word_unat.eq_norm) |
|
2655 |
done |
|
37660 | 2656 |
|
65268 | 2657 |
lemma unat_mult_lem: |
70185 | 2658 |
"unat x * unat y < 2 ^ LENGTH('a) \<longleftrightarrow> unat (x * y) = unat x * unat y" |
65363 | 2659 |
for x y :: "'a::len word" |
71997 | 2660 |
apply (auto simp: unat_word_ariths) |
2661 |
apply (metis unat_lt2p word_unat.eq_norm) |
|
2662 |
done |
|
2663 |
||
2664 |
lemma unat_plus_if': |
|
2665 |
\<open>unat (a + b) = |
|
2666 |
(if unat a + unat b < 2 ^ LENGTH('a) |
|
2667 |
then unat a + unat b |
|
2668 |
else unat a + unat b - 2 ^ LENGTH('a))\<close> for a b :: \<open>'a::len word\<close> |
|
2669 |
apply (auto simp: unat_word_ariths not_less) |
|
2670 |
apply (subst (asm) le_iff_add) |
|
2671 |
apply auto |
|
2672 |
apply (metis add_less_cancel_left add_less_cancel_right le_less_trans less_imp_le mod_less unat_lt2p) |
|
2673 |
done |
|
65328 | 2674 |
|
2675 |
lemma le_no_overflow: "x \<le> b \<Longrightarrow> a \<le> a + b \<Longrightarrow> x \<le> a + b" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2676 |
for a b x :: "'a::len word" |
37660 | 2677 |
apply (erule order_trans) |
2678 |
apply (erule olen_add_eqv [THEN iffD1]) |
|
2679 |
done |
|
2680 |
||
65328 | 2681 |
lemmas un_ui_le = |
2682 |
trans [OF word_le_nat_alt [symmetric] word_le_def] |
|
37660 | 2683 |
|
2684 |
lemma unat_sub_if_size: |
|
65328 | 2685 |
"unat (x - y) = |
2686 |
(if unat y \<le> unat x |
|
2687 |
then unat x - unat y |
|
2688 |
else unat x + 2 ^ size x - unat y)" |
|
72079 | 2689 |
supply nat_uint_eq [simp del] |
37660 | 2690 |
apply (unfold word_size) |
2691 |
apply (simp add: un_ui_le) |
|
72079 | 2692 |
apply (auto simp add: unat_eq_nat_uint uint_sub_if') |
37660 | 2693 |
apply (rule nat_diff_distrib) |
2694 |
prefer 3 |
|
2695 |
apply (simp add: algebra_simps) |
|
2696 |
apply (rule nat_diff_distrib [THEN trans]) |
|
2697 |
prefer 3 |
|
2698 |
apply (subst nat_add_distrib) |
|
2699 |
prefer 3 |
|
2700 |
apply (simp add: nat_power_eq) |
|
2701 |
apply auto |
|
2702 |
apply uint_arith |
|
2703 |
done |
|
2704 |
||
2705 |
lemmas unat_sub_if' = unat_sub_if_size [unfolded word_size] |
|
2706 |
||
71997 | 2707 |
lemma uint_div: |
2708 |
\<open>uint (x div y) = uint x div uint y\<close> |
|
2709 |
by (metis div_le_dividend le_less_trans mod_less uint_nat unat_lt2p unat_word_ariths(6) zdiv_int) |
|
2710 |
||
2711 |
lemma unat_div: |
|
2712 |
\<open>unat (x div y) = unat x div unat y\<close> |
|
72079 | 2713 |
by (simp add: uint_div nat_div_distrib flip: nat_uint_eq) |
71997 | 2714 |
|
2715 |
lemma uint_mod: |
|
2716 |
\<open>uint (x mod y) = uint x mod uint y\<close> |
|
2717 |
by (metis (no_types, lifting) le_less_trans mod_by_0 mod_le_divisor mod_less neq0_conv uint_nat unat_lt2p unat_word_ariths(7) zmod_int) |
|
2718 |
||
72079 | 2719 |
lemma unat_mod: |
2720 |
\<open>unat (x mod y) = unat x mod unat y\<close> |
|
2721 |
by (simp add: uint_mod nat_mod_distrib flip: nat_uint_eq) |
|
71997 | 2722 |
|
37660 | 2723 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2724 |
text \<open>Definition of \<open>unat_arith\<close> tactic\<close> |
37660 | 2725 |
|
70185 | 2726 |
lemma unat_split: "P (unat x) \<longleftrightarrow> (\<forall>n. of_nat n = x \<and> n < 2^LENGTH('a) \<longrightarrow> P n)" |
65328 | 2727 |
for x :: "'a::len word" |
37660 | 2728 |
by (auto simp: unat_of_nat) |
2729 |
||
70185 | 2730 |
lemma unat_split_asm: "P (unat x) \<longleftrightarrow> (\<nexists>n. of_nat n = x \<and> n < 2^LENGTH('a) \<and> \<not> P n)" |
65328 | 2731 |
for x :: "'a::len word" |
37660 | 2732 |
by (auto simp: unat_of_nat) |
2733 |
||
65268 | 2734 |
lemmas of_nat_inverse = |
37660 | 2735 |
word_unat.Abs_inverse' [rotated, unfolded unats_def, simplified] |
2736 |
||
2737 |
lemmas unat_splits = unat_split unat_split_asm |
|
2738 |
||
2739 |
lemmas unat_arith_simps = |
|
2740 |
word_le_nat_alt word_less_nat_alt |
|
2741 |
word_unat.Rep_inject [symmetric] |
|
2742 |
unat_sub_if' unat_plus_if' unat_div unat_mod |
|
2743 |
||
67408 | 2744 |
\<comment> \<open>\<open>unat_arith_tac\<close>: tactic to reduce word arithmetic to \<open>nat\<close>, try to solve via \<open>arith\<close>\<close> |
61799 | 2745 |
ML \<open> |
65268 | 2746 |
fun unat_arith_simpset ctxt = |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2747 |
ctxt addsimps @{thms unat_arith_simps} |
37660 | 2748 |
delsimps @{thms word_unat.Rep_inject} |
62390 | 2749 |
|> fold Splitter.add_split @{thms if_split_asm} |
45620
f2a587696afb
modernized some old-style infix operations, which were left over from the time of ML proof scripts;
wenzelm
parents:
45604
diff
changeset
|
2750 |
|> fold Simplifier.add_cong @{thms power_False_cong} |
37660 | 2751 |
|
65268 | 2752 |
fun unat_arith_tacs ctxt = |
37660 | 2753 |
let |
2754 |
fun arith_tac' n t = |
|
59657
2441a80fb6c1
eliminated unused arith "verbose" flag -- tools that need options can use the context;
wenzelm
parents:
59498
diff
changeset
|
2755 |
Arith_Data.arith_tac ctxt n t |
37660 | 2756 |
handle Cooper.COOPER _ => Seq.empty; |
65268 | 2757 |
in |
42793 | 2758 |
[ clarify_tac ctxt 1, |
51717
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2759 |
full_simp_tac (unat_arith_simpset ctxt) 1, |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2760 |
ALLGOALS (full_simp_tac |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2761 |
(put_simpset HOL_ss ctxt |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2762 |
|> fold Splitter.add_split @{thms unat_splits} |
9e7d1c139569
simplifier uses proper Proof.context instead of historic type simpset;
wenzelm
parents:
51375
diff
changeset
|
2763 |
|> fold Simplifier.add_cong @{thms power_False_cong})), |
65268 | 2764 |
rewrite_goals_tac ctxt @{thms word_size}, |
60754 | 2765 |
ALLGOALS (fn n => REPEAT (resolve_tac ctxt [allI, impI] n) THEN |
2766 |
REPEAT (eresolve_tac ctxt [conjE] n) THEN |
|
2767 |
REPEAT (dresolve_tac ctxt @{thms of_nat_inverse} n THEN assume_tac ctxt n)), |
|
65268 | 2768 |
TRYALL arith_tac' ] |
37660 | 2769 |
end |
2770 |
||
2771 |
fun unat_arith_tac ctxt = SELECT_GOAL (EVERY (unat_arith_tacs ctxt)) |
|
61799 | 2772 |
\<close> |
37660 | 2773 |
|
65268 | 2774 |
method_setup unat_arith = |
61799 | 2775 |
\<open>Scan.succeed (SIMPLE_METHOD' o unat_arith_tac)\<close> |
37660 | 2776 |
"solving word arithmetic via natural numbers and arith" |
2777 |
||
65328 | 2778 |
lemma no_plus_overflow_unat_size: "x \<le> x + y \<longleftrightarrow> unat x + unat y < 2 ^ size x" |
2779 |
for x y :: "'a::len word" |
|
37660 | 2780 |
unfolding word_size by unat_arith |
2781 |
||
65328 | 2782 |
lemmas no_olen_add_nat = |
2783 |
no_plus_overflow_unat_size [unfolded word_size] |
|
2784 |
||
2785 |
lemmas unat_plus_simple = |
|
2786 |
trans [OF no_olen_add_nat unat_add_lem] |
|
2787 |
||
70185 | 2788 |
lemma word_div_mult: "0 < y \<Longrightarrow> unat x * unat y < 2 ^ LENGTH('a) \<Longrightarrow> x * y div y = x" |
65328 | 2789 |
for x y :: "'a::len word" |
37660 | 2790 |
apply unat_arith |
2791 |
apply clarsimp |
|
2792 |
apply (subst unat_mult_lem [THEN iffD1]) |
|
65328 | 2793 |
apply auto |
37660 | 2794 |
done |
2795 |
||
70185 | 2796 |
lemma div_lt': "i \<le> k div x \<Longrightarrow> unat i * unat x < 2 ^ LENGTH('a)" |
65328 | 2797 |
for i k x :: "'a::len word" |
37660 | 2798 |
apply unat_arith |
2799 |
apply clarsimp |
|
2800 |
apply (drule mult_le_mono1) |
|
2801 |
apply (erule order_le_less_trans) |
|
71997 | 2802 |
apply (metis add_lessD1 div_mult_mod_eq unat_lt2p) |
37660 | 2803 |
done |
2804 |
||
2805 |
lemmas div_lt'' = order_less_imp_le [THEN div_lt'] |
|
2806 |
||
65328 | 2807 |
lemma div_lt_mult: "i < k div x \<Longrightarrow> 0 < x \<Longrightarrow> i * x < k" |
2808 |
for i k x :: "'a::len word" |
|
37660 | 2809 |
apply (frule div_lt'' [THEN unat_mult_lem [THEN iffD1]]) |
2810 |
apply (simp add: unat_arith_simps) |
|
2811 |
apply (drule (1) mult_less_mono1) |
|
2812 |
apply (erule order_less_le_trans) |
|
71997 | 2813 |
apply auto |
37660 | 2814 |
done |
2815 |
||
65328 | 2816 |
lemma div_le_mult: "i \<le> k div x \<Longrightarrow> 0 < x \<Longrightarrow> i * x \<le> k" |
2817 |
for i k x :: "'a::len word" |
|
37660 | 2818 |
apply (frule div_lt' [THEN unat_mult_lem [THEN iffD1]]) |
2819 |
apply (simp add: unat_arith_simps) |
|
2820 |
apply (drule mult_le_mono1) |
|
2821 |
apply (erule order_trans) |
|
71997 | 2822 |
apply auto |
37660 | 2823 |
done |
2824 |
||
70185 | 2825 |
lemma div_lt_uint': "i \<le> k div x \<Longrightarrow> uint i * uint x < 2 ^ LENGTH('a)" |
65328 | 2826 |
for i k x :: "'a::len word" |
37660 | 2827 |
apply (unfold uint_nat) |
2828 |
apply (drule div_lt') |
|
65328 | 2829 |
apply (metis of_nat_less_iff of_nat_mult of_nat_numeral of_nat_power) |
2830 |
done |
|
37660 | 2831 |
|
2832 |
lemmas div_lt_uint'' = order_less_imp_le [THEN div_lt_uint'] |
|
2833 |
||
70185 | 2834 |
lemma word_le_exists': "x \<le> y \<Longrightarrow> \<exists>z. y = x + z \<and> uint x + uint z < 2 ^ LENGTH('a)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2835 |
for x y z :: "'a::len word" |
71997 | 2836 |
by (metis add_diff_cancel_left' add_diff_eq uint_add_lem uint_plus_simple) |
2837 |
||
37660 | 2838 |
lemmas plus_minus_not_NULL = order_less_imp_le [THEN plus_minus_not_NULL_ab] |
2839 |
||
2840 |
lemmas plus_minus_no_overflow = |
|
2841 |
order_less_imp_le [THEN plus_minus_no_overflow_ab] |
|
65268 | 2842 |
|
37660 | 2843 |
lemmas mcs = word_less_minus_cancel word_less_minus_mono_left |
2844 |
word_le_minus_cancel word_le_minus_mono_left |
|
2845 |
||
45604 | 2846 |
lemmas word_l_diffs = mcs [where y = "w + x", unfolded add_diff_cancel] for w x |
2847 |
lemmas word_diff_ls = mcs [where z = "w + x", unfolded add_diff_cancel] for w x |
|
2848 |
lemmas word_plus_mcs = word_diff_ls [where y = "v + x", unfolded add_diff_cancel] for v x |
|
37660 | 2849 |
|
2850 |
lemmas le_unat_uoi = unat_le [THEN word_unat.Abs_inverse] |
|
2851 |
||
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66453
diff
changeset
|
2852 |
lemmas thd = times_div_less_eq_dividend |
37660 | 2853 |
|
71997 | 2854 |
lemmas uno_simps [THEN le_unat_uoi] = mod_le_divisor div_le_dividend |
37660 | 2855 |
|
65328 | 2856 |
lemma word_mod_div_equality: "(n div b) * b + (n mod b) = n" |
2857 |
for n b :: "'a::len word" |
|
71997 | 2858 |
by (fact div_mult_mod_eq) |
37660 | 2859 |
|
65328 | 2860 |
lemma word_div_mult_le: "a div b * b \<le> a" |
2861 |
for a b :: "'a::len word" |
|
71997 | 2862 |
by (metis div_le_mult mult_not_zero order.not_eq_order_implies_strict order_refl word_zero_le) |
37660 | 2863 |
|
65328 | 2864 |
lemma word_mod_less_divisor: "0 < n \<Longrightarrow> m mod n < n" |
2865 |
for m n :: "'a::len word" |
|
71997 | 2866 |
by (simp add: unat_arith_simps) |
2867 |
||
65328 | 2868 |
lemma word_of_int_power_hom: "word_of_int a ^ n = (word_of_int (a ^ n) :: 'a::len word)" |
45995
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
2869 |
by (induct n) (simp_all add: wi_hom_mult [symmetric]) |
37660 | 2870 |
|
65328 | 2871 |
lemma word_arith_power_alt: "a ^ n = (word_of_int (uint a ^ n) :: 'a::len word)" |
37660 | 2872 |
by (simp add : word_of_int_power_hom [symmetric]) |
2873 |
||
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2874 |
lemma unatSuc: "1 + n \<noteq> 0 \<Longrightarrow> unat (1 + n) = Suc (unat n)" |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2875 |
for n :: "'a::len word" |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2876 |
by unat_arith |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2877 |
|
37660 | 2878 |
|
61799 | 2879 |
subsection \<open>Cardinality, finiteness of set of words\<close> |
37660 | 2880 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2881 |
lemma inj_on_word_of_int: \<open>inj_on (word_of_int :: int \<Rightarrow> 'a word) {0..<2 ^ LENGTH('a::len)}\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2882 |
by (rule inj_onI) (simp add: word.abs_eq_iff take_bit_eq_mod) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2883 |
|
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2884 |
lemma inj_uint: \<open>inj uint\<close> |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2885 |
by (rule injI) simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2886 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2887 |
lemma range_uint: \<open>range (uint :: 'a word \<Rightarrow> int) = {0..<2 ^ LENGTH('a::len)}\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2888 |
by transfer (auto simp add: bintr_lt2p range_bintrunc) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2889 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2890 |
lemma UNIV_eq: \<open>(UNIV :: 'a word set) = word_of_int ` {0..<2 ^ LENGTH('a::len)}\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2891 |
proof - |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2892 |
have \<open>uint ` (UNIV :: 'a word set) = uint ` (word_of_int :: int \<Rightarrow> 'a word) ` {0..<2 ^ LENGTH('a::len)}\<close> |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2893 |
by (simp add: range_uint image_image uint.abs_eq take_bit_eq_mod) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2894 |
then show ?thesis |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2895 |
using inj_image_eq_iff [of \<open>uint :: 'a word \<Rightarrow> int\<close> \<open>UNIV :: 'a word set\<close> \<open>word_of_int ` {0..<2 ^ LENGTH('a)} :: 'a word set\<close>, OF inj_uint] |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2896 |
by simp |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2897 |
qed |
45809
2bee94cbae72
finite class instance for word type; remove unused lemmas
huffman
parents:
45808
diff
changeset
|
2898 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2899 |
lemma card_word: "CARD('a word) = 2 ^ LENGTH('a::len)" |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2900 |
by (simp add: UNIV_eq card_image inj_on_word_of_int) |
37660 | 2901 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
2902 |
lemma card_word_size: "CARD('a word) = 2 ^ size x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2903 |
for x :: "'a::len word" |
65328 | 2904 |
unfolding word_size by (rule card_word) |
37660 | 2905 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2906 |
instance word :: (len) finite |
71948
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2907 |
by standard (simp add: UNIV_eq) |
6ede899d26d3
fundamental construction of word type following existing transfer rules
haftmann
parents:
71947
diff
changeset
|
2908 |
|
37660 | 2909 |
|
61799 | 2910 |
subsection \<open>Bitwise Operations on Words\<close> |
37660 | 2911 |
|
2912 |
lemmas bin_log_bintrs = bin_trunc_not bin_trunc_xor bin_trunc_and bin_trunc_or |
|
65268 | 2913 |
|
67408 | 2914 |
\<comment> \<open>following definitions require both arithmetic and bit-wise word operations\<close> |
2915 |
||
2916 |
\<comment> \<open>to get \<open>word_no_log_defs\<close> from \<open>word_log_defs\<close>, using \<open>bin_log_bintrs\<close>\<close> |
|
37660 | 2917 |
lemmas wils1 = bin_log_bintrs [THEN word_ubin.norm_eq_iff [THEN iffD1], |
45604 | 2918 |
folded word_ubin.eq_norm, THEN eq_reflection] |
37660 | 2919 |
|
67408 | 2920 |
\<comment> \<open>the binary operations only\<close> (* BH: why is this needed? *) |
65268 | 2921 |
lemmas word_log_binary_defs = |
37660 | 2922 |
word_and_def word_or_def word_xor_def |
2923 |
||
46011 | 2924 |
lemma word_wi_log_defs: |
71149 | 2925 |
"NOT (word_of_int a) = word_of_int (NOT a)" |
46011 | 2926 |
"word_of_int a AND word_of_int b = word_of_int (a AND b)" |
2927 |
"word_of_int a OR word_of_int b = word_of_int (a OR b)" |
|
2928 |
"word_of_int a XOR word_of_int b = word_of_int (a XOR b)" |
|
47374
9475d524bafb
set up and use lift_definition for word operations
huffman
parents:
47372
diff
changeset
|
2929 |
by (transfer, rule refl)+ |
47372 | 2930 |
|
46011 | 2931 |
lemma word_no_log_defs [simp]: |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2932 |
"NOT (numeral a) = word_of_int (NOT (numeral a))" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2933 |
"NOT (- numeral a) = word_of_int (NOT (- numeral a))" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2934 |
"numeral a AND numeral b = word_of_int (numeral a AND numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2935 |
"numeral a AND - numeral b = word_of_int (numeral a AND - numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2936 |
"- numeral a AND numeral b = word_of_int (- numeral a AND numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2937 |
"- numeral a AND - numeral b = word_of_int (- numeral a AND - numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2938 |
"numeral a OR numeral b = word_of_int (numeral a OR numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2939 |
"numeral a OR - numeral b = word_of_int (numeral a OR - numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2940 |
"- numeral a OR numeral b = word_of_int (- numeral a OR numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2941 |
"- numeral a OR - numeral b = word_of_int (- numeral a OR - numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2942 |
"numeral a XOR numeral b = word_of_int (numeral a XOR numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2943 |
"numeral a XOR - numeral b = word_of_int (numeral a XOR - numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2944 |
"- numeral a XOR numeral b = word_of_int (- numeral a XOR numeral b)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2945 |
"- numeral a XOR - numeral b = word_of_int (- numeral a XOR - numeral b)" |
47372 | 2946 |
by (transfer, rule refl)+ |
37660 | 2947 |
|
61799 | 2948 |
text \<open>Special cases for when one of the arguments equals 1.\<close> |
46064
88ef116e0522
add simp rules for bitwise word operations with 1
huffman
parents:
46057
diff
changeset
|
2949 |
|
88ef116e0522
add simp rules for bitwise word operations with 1
huffman
parents:
46057
diff
changeset
|
2950 |
lemma word_bitwise_1_simps [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2951 |
"NOT (1::'a::len word) = -2" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2952 |
"1 AND numeral b = word_of_int (1 AND numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2953 |
"1 AND - numeral b = word_of_int (1 AND - numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2954 |
"numeral a AND 1 = word_of_int (numeral a AND 1)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2955 |
"- numeral a AND 1 = word_of_int (- numeral a AND 1)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2956 |
"1 OR numeral b = word_of_int (1 OR numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2957 |
"1 OR - numeral b = word_of_int (1 OR - numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2958 |
"numeral a OR 1 = word_of_int (numeral a OR 1)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2959 |
"- numeral a OR 1 = word_of_int (- numeral a OR 1)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2960 |
"1 XOR numeral b = word_of_int (1 XOR numeral b)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2961 |
"1 XOR - numeral b = word_of_int (1 XOR - numeral b)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
2962 |
"numeral a XOR 1 = word_of_int (numeral a XOR 1)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
2963 |
"- numeral a XOR 1 = word_of_int (- numeral a XOR 1)" |
47372 | 2964 |
by (transfer, simp)+ |
46064
88ef116e0522
add simp rules for bitwise word operations with 1
huffman
parents:
46057
diff
changeset
|
2965 |
|
61799 | 2966 |
text \<open>Special cases for when one of the arguments equals -1.\<close> |
56979 | 2967 |
|
2968 |
lemma word_bitwise_m1_simps [simp]: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2969 |
"NOT (-1::'a::len word) = 0" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2970 |
"(-1::'a::len word) AND x = x" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2971 |
"x AND (-1::'a::len word) = x" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2972 |
"(-1::'a::len word) OR x = -1" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2973 |
"x OR (-1::'a::len word) = -1" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2974 |
" (-1::'a::len word) XOR x = NOT x" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2975 |
"x XOR (-1::'a::len word) = NOT x" |
56979 | 2976 |
by (transfer, simp)+ |
2977 |
||
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2978 |
lemma uint_and: |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2979 |
\<open>uint (x AND y) = uint x AND uint y\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2980 |
by transfer simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2981 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2982 |
lemma uint_or: |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2983 |
\<open>uint (x OR y) = uint x OR uint y\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2984 |
by transfer simp |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2985 |
|
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2986 |
lemma uint_xor: |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2987 |
\<open>uint (x XOR y) = uint x XOR uint y\<close> |
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
2988 |
by transfer simp |
47372 | 2989 |
|
2990 |
lemma test_bit_wi [simp]: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2991 |
"(word_of_int x :: 'a::len word) !! n \<longleftrightarrow> n < LENGTH('a) \<and> bin_nth x n" |
65328 | 2992 |
by (simp add: word_test_bit_def word_ubin.eq_norm nth_bintr) |
47372 | 2993 |
|
2994 |
lemma word_test_bit_transfer [transfer_rule]: |
|
67399 | 2995 |
"(rel_fun pcr_word (rel_fun (=) (=))) |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
2996 |
(\<lambda>x n. n < LENGTH('a) \<and> bin_nth x n) (test_bit :: 'a::len word \<Rightarrow> _)" |
55945 | 2997 |
unfolding rel_fun_def word.pcr_cr_eq cr_word_def by simp |
37660 | 2998 |
|
2999 |
lemma word_ops_nth_size: |
|
65328 | 3000 |
"n < size x \<Longrightarrow> |
3001 |
(x OR y) !! n = (x !! n | y !! n) \<and> |
|
3002 |
(x AND y) !! n = (x !! n \<and> y !! n) \<and> |
|
3003 |
(x XOR y) !! n = (x !! n \<noteq> y !! n) \<and> |
|
3004 |
(NOT x) !! n = (\<not> x !! n)" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3005 |
for x :: "'a::len word" |
47372 | 3006 |
unfolding word_size by transfer (simp add: bin_nth_ops) |
37660 | 3007 |
|
3008 |
lemma word_ao_nth: |
|
65328 | 3009 |
"(x OR y) !! n = (x !! n | y !! n) \<and> |
3010 |
(x AND y) !! n = (x !! n \<and> y !! n)" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3011 |
for x :: "'a::len word" |
47372 | 3012 |
by transfer (auto simp add: bin_nth_ops) |
46023
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
3013 |
|
72000 | 3014 |
lemmas msb0 = len_gt_0 [THEN diff_Suc_less, THEN word_ops_nth_size [unfolded word_size]] |
3015 |
lemmas msb1 = msb0 [where i = 0] |
|
3016 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3017 |
lemma test_bit_numeral [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3018 |
"(numeral w :: 'a::len word) !! n \<longleftrightarrow> |
70185 | 3019 |
n < LENGTH('a) \<and> bin_nth (numeral w) n" |
47372 | 3020 |
by transfer (rule refl) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3021 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3022 |
lemma test_bit_neg_numeral [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3023 |
"(- numeral w :: 'a::len word) !! n \<longleftrightarrow> |
70185 | 3024 |
n < LENGTH('a) \<and> bin_nth (- numeral w) n" |
47372 | 3025 |
by transfer (rule refl) |
46023
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
3026 |
|
65328 | 3027 |
lemma test_bit_1 [simp]: "(1 :: 'a::len word) !! n \<longleftrightarrow> n = 0" |
47372 | 3028 |
by transfer auto |
65268 | 3029 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3030 |
lemma nth_0 [simp]: "\<not> (0 :: 'a::len word) !! n" |
47372 | 3031 |
by transfer simp |
46023
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
3032 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3033 |
lemma nth_minus1 [simp]: "(-1 :: 'a::len word) !! n \<longleftrightarrow> n < LENGTH('a)" |
47372 | 3034 |
by transfer simp |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3035 |
|
67408 | 3036 |
\<comment> \<open>get from commutativity, associativity etc of \<open>int_and\<close> etc to same for \<open>word_and etc\<close>\<close> |
65268 | 3037 |
lemmas bwsimps = |
46013 | 3038 |
wi_hom_add |
37660 | 3039 |
word_wi_log_defs |
3040 |
||
3041 |
lemma word_bw_assocs: |
|
3042 |
"(x AND y) AND z = x AND y AND z" |
|
3043 |
"(x OR y) OR z = x OR y OR z" |
|
3044 |
"(x XOR y) XOR z = x XOR y XOR z" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3045 |
for x :: "'a::len word" |
46022 | 3046 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
65268 | 3047 |
|
37660 | 3048 |
lemma word_bw_comms: |
3049 |
"x AND y = y AND x" |
|
3050 |
"x OR y = y OR x" |
|
3051 |
"x XOR y = y XOR x" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3052 |
for x :: "'a::len word" |
46022 | 3053 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
65268 | 3054 |
|
37660 | 3055 |
lemma word_bw_lcs: |
3056 |
"y AND x AND z = x AND y AND z" |
|
3057 |
"y OR x OR z = x OR y OR z" |
|
3058 |
"y XOR x XOR z = x XOR y XOR z" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3059 |
for x :: "'a::len word" |
46022 | 3060 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
37660 | 3061 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3062 |
lemma word_log_esimps: |
37660 | 3063 |
"x AND 0 = 0" |
3064 |
"x AND -1 = x" |
|
3065 |
"x OR 0 = x" |
|
3066 |
"x OR -1 = -1" |
|
3067 |
"x XOR 0 = x" |
|
3068 |
"x XOR -1 = NOT x" |
|
3069 |
"0 AND x = 0" |
|
3070 |
"-1 AND x = x" |
|
3071 |
"0 OR x = x" |
|
3072 |
"-1 OR x = -1" |
|
3073 |
"0 XOR x = x" |
|
3074 |
"-1 XOR x = NOT x" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3075 |
for x :: "'a::len word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3076 |
by simp_all |
37660 | 3077 |
|
3078 |
lemma word_not_dist: |
|
3079 |
"NOT (x OR y) = NOT x AND NOT y" |
|
3080 |
"NOT (x AND y) = NOT x OR NOT y" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3081 |
for x :: "'a::len word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3082 |
by simp_all |
37660 | 3083 |
|
3084 |
lemma word_bw_same: |
|
3085 |
"x AND x = x" |
|
3086 |
"x OR x = x" |
|
3087 |
"x XOR x = 0" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3088 |
for x :: "'a::len word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3089 |
by simp_all |
37660 | 3090 |
|
3091 |
lemma word_ao_absorbs [simp]: |
|
3092 |
"x AND (y OR x) = x" |
|
3093 |
"x OR y AND x = x" |
|
3094 |
"x AND (x OR y) = x" |
|
3095 |
"y AND x OR x = x" |
|
3096 |
"(y OR x) AND x = x" |
|
3097 |
"x OR x AND y = x" |
|
3098 |
"(x OR y) AND x = x" |
|
3099 |
"x AND y OR x = x" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3100 |
for x :: "'a::len word" |
46022 | 3101 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
37660 | 3102 |
|
71149 | 3103 |
lemma word_not_not [simp]: "NOT (NOT x) = x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3104 |
for x :: "'a::len word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3105 |
by simp |
37660 | 3106 |
|
65328 | 3107 |
lemma word_ao_dist: "(x OR y) AND z = x AND z OR y AND z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3108 |
for x :: "'a::len word" |
46022 | 3109 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
37660 | 3110 |
|
65328 | 3111 |
lemma word_oa_dist: "x AND y OR z = (x OR z) AND (y OR z)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3112 |
for x :: "'a::len word" |
65328 | 3113 |
by (auto simp: word_eq_iff word_ops_nth_size [unfolded word_size]) |
3114 |
||
3115 |
lemma word_add_not [simp]: "x + NOT x = -1" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3116 |
for x :: "'a::len word" |
47372 | 3117 |
by transfer (simp add: bin_add_not) |
37660 | 3118 |
|
65328 | 3119 |
lemma word_plus_and_or [simp]: "(x AND y) + (x OR y) = x + y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3120 |
for x :: "'a::len word" |
47372 | 3121 |
by transfer (simp add: plus_and_or) |
37660 | 3122 |
|
65328 | 3123 |
lemma leoa: "w = x OR y \<Longrightarrow> y = w AND y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3124 |
for x :: "'a::len word" |
65328 | 3125 |
by auto |
3126 |
||
3127 |
lemma leao: "w' = x' AND y' \<Longrightarrow> x' = x' OR w'" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3128 |
for x' :: "'a::len word" |
65328 | 3129 |
by auto |
3130 |
||
3131 |
lemma word_ao_equiv: "w = w OR w' \<longleftrightarrow> w' = w AND w'" |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3132 |
for w w' :: "'a::len word" |
48196 | 3133 |
by (auto intro: leoa leao) |
37660 | 3134 |
|
65328 | 3135 |
lemma le_word_or2: "x \<le> x OR y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3136 |
for x y :: "'a::len word" |
65328 | 3137 |
by (auto simp: word_le_def uint_or intro: le_int_or) |
37660 | 3138 |
|
71997 | 3139 |
lemmas le_word_or1 = xtrans(3) [OF word_bw_comms (2) le_word_or2] |
3140 |
lemmas word_and_le1 = xtrans(3) [OF word_ao_absorbs (4) [symmetric] le_word_or2] |
|
3141 |
lemmas word_and_le2 = xtrans(3) [OF word_ao_absorbs (8) [symmetric] le_word_or2] |
|
37660 | 3142 |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3143 |
lemma bit_horner_sum_bit_word_iff: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3144 |
\<open>bit (horner_sum of_bool (2 :: 'a::len word) bs) n |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3145 |
\<longleftrightarrow> n < min LENGTH('a) (length bs) \<and> bs ! n\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3146 |
by transfer (simp add: bit_horner_sum_bit_iff) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3147 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3148 |
definition word_reverse :: \<open>'a::len word \<Rightarrow> 'a word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3149 |
where \<open>word_reverse w = horner_sum of_bool 2 (rev (map (bit w) [0..<LENGTH('a)]))\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3150 |
|
71990 | 3151 |
lemma bit_word_reverse_iff: |
3152 |
\<open>bit (word_reverse w) n \<longleftrightarrow> n < LENGTH('a) \<and> bit w (LENGTH('a) - Suc n)\<close> |
|
3153 |
for w :: \<open>'a::len word\<close> |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3154 |
by (cases \<open>n < LENGTH('a)\<close>) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3155 |
(simp_all add: word_reverse_def bit_horner_sum_bit_word_iff rev_nth) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3156 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3157 |
lemma word_rev_rev [simp] : "word_reverse (word_reverse w) = w" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3158 |
by (rule bit_word_eqI) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3159 |
(auto simp add: bit_word_reverse_iff bit_imp_le_length Suc_diff_Suc) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3160 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3161 |
lemma word_rev_gal: "word_reverse w = u \<Longrightarrow> word_reverse u = w" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3162 |
by (metis word_rev_rev) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3163 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3164 |
lemma word_rev_gal': "u = word_reverse w \<Longrightarrow> w = word_reverse u" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3165 |
by simp |
37660 | 3166 |
|
45604 | 3167 |
lemmas lsb0 = len_gt_0 [THEN word_ops_nth_size [unfolded word_size]] |
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3168 |
|
65268 | 3169 |
lemma nth_sint: |
37660 | 3170 |
fixes w :: "'a::len word" |
70185 | 3171 |
defines "l \<equiv> LENGTH('a)" |
37660 | 3172 |
shows "bin_nth (sint w) n = (if n < l - 1 then w !! n else w !! (l - 1))" |
3173 |
unfolding sint_uint l_def |
|
65328 | 3174 |
by (auto simp: nth_sbintr word_test_bit_def [symmetric]) |
37660 | 3175 |
|
65328 | 3176 |
lemma setBit_no [simp]: "setBit (numeral bin) n = word_of_int (bin_sc n True (numeral bin))" |
72079 | 3177 |
by transfer (simp add: bin_sc_eq) |
72000 | 3178 |
|
45805 | 3179 |
lemma clearBit_no [simp]: |
54847
d6cf9a5b9be9
prefer plain bool over dedicated type for binary digits
haftmann
parents:
54743
diff
changeset
|
3180 |
"clearBit (numeral bin) n = word_of_int (bin_sc n False (numeral bin))" |
72079 | 3181 |
by transfer (simp add: bin_sc_eq) |
37660 | 3182 |
|
70185 | 3183 |
lemma test_bit_2p: "(word_of_int (2 ^ n)::'a::len word) !! m \<longleftrightarrow> m = n \<and> m < LENGTH('a)" |
65328 | 3184 |
by (auto simp: word_test_bit_def word_ubin.eq_norm nth_bintr nth_2p_bin) |
3185 |
||
70185 | 3186 |
lemma nth_w2p: "((2::'a::len word) ^ n) !! m \<longleftrightarrow> m = n \<and> m < LENGTH('a::len)" |
65328 | 3187 |
by (simp add: test_bit_2p [symmetric] word_of_int [symmetric]) |
3188 |
||
3189 |
lemma uint_2p: "(0::'a::len word) < 2 ^ n \<Longrightarrow> uint (2 ^ n::'a::len word) = 2 ^ n" |
|
37660 | 3190 |
apply (unfold word_arith_power_alt) |
70185 | 3191 |
apply (case_tac "LENGTH('a)") |
37660 | 3192 |
apply clarsimp |
3193 |
apply (case_tac "nat") |
|
3194 |
apply clarsimp |
|
3195 |
apply (case_tac "n") |
|
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3196 |
apply clarsimp |
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3197 |
apply clarsimp |
37660 | 3198 |
apply (drule word_gt_0 [THEN iffD1]) |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
3199 |
apply (safe intro!: word_eqI) |
65328 | 3200 |
apply (auto simp add: nth_2p_bin) |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
3201 |
apply (erule notE) |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
3202 |
apply (simp (no_asm_use) add: uint_word_of_int word_size) |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54225
diff
changeset
|
3203 |
apply (subst mod_pos_pos_trivial) |
65328 | 3204 |
apply simp |
3205 |
apply (rule power_strict_increasing) |
|
3206 |
apply simp_all |
|
37660 | 3207 |
done |
3208 |
||
65268 | 3209 |
lemma word_of_int_2p: "(word_of_int (2 ^ n) :: 'a::len word) = 2 ^ n" |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
3210 |
by (induct n) (simp_all add: wi_hom_syms) |
37660 | 3211 |
|
65328 | 3212 |
lemma bang_is_le: "x !! m \<Longrightarrow> 2 ^ m \<le> x" |
3213 |
for x :: "'a::len word" |
|
71997 | 3214 |
apply (rule xtrans(3)) |
65328 | 3215 |
apply (rule_tac [2] y = "x" in le_word_or2) |
37660 | 3216 |
apply (rule word_eqI) |
3217 |
apply (auto simp add: word_ao_nth nth_w2p word_size) |
|
3218 |
done |
|
3219 |
||
3220 |
||
70192 | 3221 |
subsection \<open>Bit comprehension\<close> |
3222 |
||
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3223 |
instantiation word :: (len) bit_comprehension |
70192 | 3224 |
begin |
3225 |
||
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3226 |
definition word_set_bits_def: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3227 |
\<open>(BITS n. P n) = (horner_sum of_bool 2 (map P [0..<LENGTH('a)]) :: 'a word)\<close> |
70192 | 3228 |
|
3229 |
instance .. |
|
3230 |
||
3231 |
end |
|
3232 |
||
71990 | 3233 |
lemma bit_set_bits_word_iff: |
3234 |
\<open>bit (set_bits P :: 'a::len word) n \<longleftrightarrow> n < LENGTH('a) \<and> P n\<close> |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3235 |
by (auto simp add: word_set_bits_def bit_horner_sum_bit_word_iff) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3236 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3237 |
lemma set_bits_bit_eq: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3238 |
\<open>set_bits (bit w) = w\<close> for w :: \<open>'a::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3239 |
by (rule bit_word_eqI) (auto simp add: bit_set_bits_word_iff bit_imp_le_length) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3240 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3241 |
lemma set_bits_K_False [simp]: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3242 |
\<open>set_bits (\<lambda>_. False) = (0 :: 'a :: len word)\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3243 |
by (rule bit_word_eqI) (simp add: bit_set_bits_word_iff) |
71990 | 3244 |
|
70192 | 3245 |
lemmas of_nth_def = word_set_bits_def (* FIXME duplicate *) |
3246 |
||
3247 |
interpretation test_bit: |
|
3248 |
td_ext |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3249 |
"(!!) :: 'a::len word \<Rightarrow> nat \<Rightarrow> bool" |
70192 | 3250 |
set_bits |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3251 |
"{f. \<forall>i. f i \<longrightarrow> i < LENGTH('a::len)}" |
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3252 |
"(\<lambda>h i. h i \<and> i < LENGTH('a::len))" |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3253 |
by standard |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3254 |
(auto simp add: test_bit_word_eq bit_imp_le_length bit_set_bits_word_iff set_bits_bit_eq) |
70192 | 3255 |
|
3256 |
lemmas td_nth = test_bit.td_thm |
|
3257 |
||
3258 |
||
61799 | 3259 |
subsection \<open>Shifting, Rotating, and Splitting Words\<close> |
37660 | 3260 |
|
71986 | 3261 |
lemma shiftl1_wi [simp]: "shiftl1 (word_of_int w) = word_of_int (2 * w)" |
72079 | 3262 |
by (fact shiftl1.abs_eq) |
37660 | 3263 |
|
65328 | 3264 |
lemma shiftl1_numeral [simp]: "shiftl1 (numeral w) = numeral (Num.Bit0 w)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3265 |
unfolding word_numeral_alt shiftl1_wi by simp |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3266 |
|
65328 | 3267 |
lemma shiftl1_neg_numeral [simp]: "shiftl1 (- numeral w) = - numeral (Num.Bit0 w)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3268 |
unfolding word_neg_numeral_alt shiftl1_wi by simp |
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3269 |
|
37660 | 3270 |
lemma shiftl1_0 [simp] : "shiftl1 0 = 0" |
72079 | 3271 |
by transfer simp |
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3272 |
|
71986 | 3273 |
lemma shiftl1_def_u: "shiftl1 w = word_of_int (2 * uint w)" |
72079 | 3274 |
by (fact shiftl1_eq) |
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3275 |
|
71986 | 3276 |
lemma shiftl1_def_s: "shiftl1 w = word_of_int (2 * sint w)" |
72079 | 3277 |
by (simp add: shiftl1_def_u wi_hom_syms) |
37660 | 3278 |
|
45995
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
3279 |
lemma shiftr1_0 [simp]: "shiftr1 0 = 0" |
72079 | 3280 |
by transfer simp |
45995
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
3281 |
|
b16070689726
declare word_of_int_{0,1} [simp], for consistency with word_of_int_bin
huffman
parents:
45958
diff
changeset
|
3282 |
lemma sshiftr1_0 [simp]: "sshiftr1 0 = 0" |
72079 | 3283 |
by transfer simp |
65328 | 3284 |
|
3285 |
lemma sshiftr1_n1 [simp]: "sshiftr1 (- 1) = - 1" |
|
72079 | 3286 |
by transfer simp |
65328 | 3287 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3288 |
lemma shiftl_0 [simp]: "(0::'a::len word) << n = 0" |
72079 | 3289 |
by transfer simp |
65328 | 3290 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3291 |
lemma shiftr_0 [simp]: "(0::'a::len word) >> n = 0" |
72079 | 3292 |
by transfer simp |
65328 | 3293 |
|
3294 |
lemma sshiftr_0 [simp]: "0 >>> n = 0" |
|
72079 | 3295 |
by transfer simp |
65328 | 3296 |
|
3297 |
lemma sshiftr_n1 [simp]: "-1 >>> n = -1" |
|
72079 | 3298 |
by transfer simp |
65328 | 3299 |
|
3300 |
lemma nth_shiftl1: "shiftl1 w !! n \<longleftrightarrow> n < size w \<and> n > 0 \<and> w !! (n - 1)" |
|
72079 | 3301 |
by transfer (auto simp add: bit_double_iff) |
37660 | 3302 |
|
65328 | 3303 |
lemma nth_shiftl': "(w << m) !! n \<longleftrightarrow> n < size w \<and> n >= m \<and> w !! (n - m)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3304 |
for w :: "'a::len word" |
72079 | 3305 |
by transfer (auto simp add: bit_push_bit_iff) |
37660 | 3306 |
|
65268 | 3307 |
lemmas nth_shiftl = nth_shiftl' [unfolded word_size] |
37660 | 3308 |
|
3309 |
lemma nth_shiftr1: "shiftr1 w !! n = w !! Suc n" |
|
72079 | 3310 |
by transfer (auto simp add: bit_take_bit_iff simp flip: bit_Suc) |
37660 | 3311 |
|
65328 | 3312 |
lemma nth_shiftr: "(w >> m) !! n = w !! (n + m)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3313 |
for w :: "'a::len word" |
37660 | 3314 |
apply (unfold shiftr_def) |
65328 | 3315 |
apply (induct "m" arbitrary: n) |
3316 |
apply (auto simp add: nth_shiftr1) |
|
37660 | 3317 |
done |
65268 | 3318 |
|
67408 | 3319 |
text \<open> |
3320 |
see paper page 10, (1), (2), \<open>shiftr1_def\<close> is of the form of (1), |
|
3321 |
where \<open>f\<close> (ie \<open>bin_rest\<close>) takes normal arguments to normal results, |
|
3322 |
thus we get (2) from (1) |
|
3323 |
\<close> |
|
37660 | 3324 |
|
65268 | 3325 |
lemma uint_shiftr1: "uint (shiftr1 w) = bin_rest (uint w)" |
72079 | 3326 |
by transfer simp |
37660 | 3327 |
|
71990 | 3328 |
lemma bit_sshiftr1_iff: |
3329 |
\<open>bit (sshiftr1 w) n \<longleftrightarrow> bit w (if n = LENGTH('a) - 1 then LENGTH('a) - 1 else Suc n)\<close> |
|
3330 |
for w :: \<open>'a::len word\<close> |
|
72079 | 3331 |
apply transfer |
3332 |
apply (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def simp flip: bit_Suc) |
|
3333 |
using le_less_Suc_eq apply fastforce |
|
3334 |
using le_less_Suc_eq apply fastforce |
|
71990 | 3335 |
done |
3336 |
||
3337 |
lemma bit_sshiftr_word_iff: |
|
3338 |
\<open>bit (w >>> m) n \<longleftrightarrow> bit w (if LENGTH('a) - m \<le> n \<and> n < LENGTH('a) then LENGTH('a) - 1 else (m + n))\<close> |
|
3339 |
for w :: \<open>'a::len word\<close> |
|
72079 | 3340 |
apply transfer |
3341 |
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le simp flip: bit_Suc) |
|
3342 |
using le_less_Suc_eq apply fastforce |
|
3343 |
using le_less_Suc_eq apply fastforce |
|
71990 | 3344 |
done |
3345 |
||
65328 | 3346 |
lemma nth_sshiftr1: "sshiftr1 w !! n = (if n = size w - 1 then w !! n else w !! Suc n)" |
72079 | 3347 |
apply transfer |
3348 |
apply (auto simp add: bit_take_bit_iff bit_signed_take_bit_iff min_def simp flip: bit_Suc) |
|
3349 |
using le_less_Suc_eq apply fastforce |
|
3350 |
using le_less_Suc_eq apply fastforce |
|
37660 | 3351 |
done |
3352 |
||
72079 | 3353 |
lemma nth_sshiftr : |
3354 |
"sshiftr w m !! n = |
|
65328 | 3355 |
(n < size w \<and> (if n + m \<ge> size w then w !! (size w - 1) else w !! (n + m)))" |
72079 | 3356 |
apply transfer |
3357 |
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq bit_signed_take_bit_iff min_def not_le ac_simps) |
|
3358 |
using le_less_Suc_eq apply fastforce |
|
3359 |
using le_less_Suc_eq apply fastforce |
|
37660 | 3360 |
done |
65268 | 3361 |
|
37660 | 3362 |
lemma shiftr1_div_2: "uint (shiftr1 w) = uint w div 2" |
72079 | 3363 |
by (fact uint_shiftr1) |
37660 | 3364 |
|
3365 |
lemma sshiftr1_div_2: "sint (sshiftr1 w) = sint w div 2" |
|
72079 | 3366 |
by transfer simp |
37660 | 3367 |
|
3368 |
lemma shiftr_div_2n: "uint (shiftr w n) = uint w div 2 ^ n" |
|
3369 |
apply (unfold shiftr_def) |
|
65328 | 3370 |
apply (induct n) |
37660 | 3371 |
apply simp |
65328 | 3372 |
apply (simp add: shiftr1_div_2 mult.commute zdiv_zmult2_eq [symmetric]) |
37660 | 3373 |
done |
3374 |
||
3375 |
lemma sshiftr_div_2n: "sint (sshiftr w n) = sint w div 2 ^ n" |
|
72079 | 3376 |
apply transfer |
3377 |
apply (auto simp add: bit_eq_iff bit_signed_take_bit_iff bit_drop_bit_eq min_def simp flip: drop_bit_eq_div) |
|
37660 | 3378 |
done |
3379 |
||
71990 | 3380 |
lemma bit_bshiftr1_iff: |
3381 |
\<open>bit (bshiftr1 b w) n \<longleftrightarrow> b \<and> n = LENGTH('a) - 1 \<or> bit w (Suc n)\<close> |
|
3382 |
for w :: \<open>'a::len word\<close> |
|
72079 | 3383 |
apply transfer |
3384 |
apply (simp add: bit_take_bit_iff flip: bit_Suc) |
|
3385 |
apply (subst disjunctive_add) |
|
3386 |
apply (auto simp add: bit_take_bit_iff bit_or_iff bit_exp_iff simp flip: bit_Suc) |
|
71990 | 3387 |
done |
3388 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
3389 |
|
61799 | 3390 |
subsubsection \<open>shift functions in terms of lists of bools\<close> |
37660 | 3391 |
|
65328 | 3392 |
lemma shiftl1_rev: "shiftl1 w = word_reverse (shiftr1 (word_reverse w))" |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3393 |
apply (rule bit_word_eqI) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3394 |
apply (auto simp add: bit_shiftl1_iff bit_word_reverse_iff bit_shiftr1_iff Suc_diff_Suc) |
37660 | 3395 |
done |
3396 |
||
65328 | 3397 |
lemma shiftl_rev: "shiftl w n = word_reverse (shiftr (word_reverse w) n)" |
3398 |
by (induct n) (auto simp add: shiftl_def shiftr_def shiftl1_rev) |
|
37660 | 3399 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3400 |
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
|
3401 |
by (simp add: shiftl_rev) |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3402 |
|
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3403 |
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
|
3404 |
by (simp add: rev_shiftl) |
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3405 |
|
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3406 |
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
|
3407 |
by (simp add: shiftr_rev) |
37660 | 3408 |
|
71997 | 3409 |
lemma shiftl_numeral [simp]: |
3410 |
\<open>numeral k << numeral l = (push_bit (numeral l) (numeral k) :: 'a::len word)\<close> |
|
3411 |
by (fact shiftl_word_eq) |
|
37660 | 3412 |
|
65328 | 3413 |
lemma shiftl_zero_size: "size x \<le> n \<Longrightarrow> x << n = 0" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3414 |
for x :: "'a::len word" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3415 |
apply transfer |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3416 |
apply (simp add: take_bit_push_bit) |
37660 | 3417 |
done |
3418 |
||
67408 | 3419 |
\<comment> \<open>note -- the following results use \<open>'a::len word < number_ring\<close>\<close> |
65268 | 3420 |
|
65328 | 3421 |
lemma shiftl1_2t: "shiftl1 w = 2 * w" |
3422 |
for w :: "'a::len word" |
|
72079 | 3423 |
by (simp add: shiftl1_eq wi_hom_mult [symmetric]) |
37660 | 3424 |
|
65328 | 3425 |
lemma shiftl1_p: "shiftl1 w = w + w" |
3426 |
for w :: "'a::len word" |
|
46001
0b562d564d5f
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
huffman
parents:
46000
diff
changeset
|
3427 |
by (simp add: shiftl1_2t) |
37660 | 3428 |
|
65328 | 3429 |
lemma shiftl_t2n: "shiftl w n = 2 ^ n * w" |
3430 |
for w :: "'a::len word" |
|
3431 |
by (induct n) (auto simp: shiftl_def shiftl1_2t) |
|
37660 | 3432 |
|
3433 |
lemma shiftr1_bintr [simp]: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3434 |
"(shiftr1 (numeral w) :: 'a::len word) = |
72128 | 3435 |
word_of_int (bin_rest (take_bit (LENGTH('a)) (numeral w)))" |
72079 | 3436 |
unfolding shiftr1_eq word_numeral_alt by (simp add: word_ubin.eq_norm) |
46962
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
3437 |
|
5bdcdb28be83
make more word theorems respect int/bin distinction
huffman
parents:
46656
diff
changeset
|
3438 |
lemma sshiftr1_sbintr [simp]: |
65268 | 3439 |
"(sshiftr1 (numeral w) :: 'a::len word) = |
72128 | 3440 |
word_of_int (bin_rest (signed_take_bit (LENGTH('a) - 1) (numeral w)))" |
72079 | 3441 |
unfolding sshiftr1_eq word_numeral_alt by (simp add: word_sbin.eq_norm) |
37660 | 3442 |
|
71997 | 3443 |
text \<open>TODO: rules for \<^term>\<open>- (numeral n)\<close>\<close> |
3444 |
||
3445 |
lemma drop_bit_word_numeral [simp]: |
|
3446 |
\<open>drop_bit (numeral n) (numeral k) = |
|
3447 |
(word_of_int (drop_bit (numeral n) (take_bit LENGTH('a) (numeral k))) :: 'a::len word)\<close> |
|
3448 |
by transfer simp |
|
3449 |
||
3450 |
lemma shiftr_numeral [simp]: |
|
3451 |
\<open>(numeral k >> numeral n :: 'a::len word) = drop_bit (numeral n) (numeral k)\<close> |
|
3452 |
by (fact shiftr_word_eq) |
|
3453 |
||
3454 |
lemma sshiftr_numeral [simp]: |
|
3455 |
\<open>(numeral k >>> numeral n :: 'a::len word) = |
|
72128 | 3456 |
word_of_int (drop_bit (numeral n) (signed_take_bit (LENGTH('a) - 1) (numeral k)))\<close> |
37660 | 3457 |
apply (rule word_eqI) |
71997 | 3458 |
apply (cases \<open>LENGTH('a)\<close>) |
3459 |
apply (simp_all add: word_size bit_drop_bit_eq nth_sshiftr nth_sbintr not_le not_less less_Suc_eq_le ac_simps) |
|
37660 | 3460 |
done |
3461 |
||
65328 | 3462 |
lemma zip_replicate: "n \<ge> length ys \<Longrightarrow> zip (replicate n x) ys = map (\<lambda>y. (x, y)) ys" |
3463 |
apply (induct ys arbitrary: n) |
|
3464 |
apply simp_all |
|
3465 |
apply (case_tac n) |
|
3466 |
apply simp_all |
|
57492
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56979
diff
changeset
|
3467 |
done |
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56979
diff
changeset
|
3468 |
|
37660 | 3469 |
lemma align_lem_or [rule_format] : |
65328 | 3470 |
"\<forall>x m. length x = n + m \<longrightarrow> length y = n + m \<longrightarrow> |
3471 |
drop m x = replicate n False \<longrightarrow> take m y = replicate m False \<longrightarrow> |
|
67399 | 3472 |
map2 (|) x y = take m x @ drop m y" |
65328 | 3473 |
apply (induct y) |
37660 | 3474 |
apply force |
3475 |
apply clarsimp |
|
65328 | 3476 |
apply (case_tac x) |
3477 |
apply force |
|
3478 |
apply (case_tac m) |
|
3479 |
apply auto |
|
59807 | 3480 |
apply (drule_tac t="length xs" for xs in sym) |
70193 | 3481 |
apply (auto simp: zip_replicate o_def) |
37660 | 3482 |
done |
3483 |
||
3484 |
lemma align_lem_and [rule_format] : |
|
65328 | 3485 |
"\<forall>x m. length x = n + m \<longrightarrow> length y = n + m \<longrightarrow> |
3486 |
drop m x = replicate n False \<longrightarrow> take m y = replicate m False \<longrightarrow> |
|
67399 | 3487 |
map2 (\<and>) x y = replicate (n + m) False" |
65328 | 3488 |
apply (induct y) |
37660 | 3489 |
apply force |
3490 |
apply clarsimp |
|
65328 | 3491 |
apply (case_tac x) |
3492 |
apply force |
|
3493 |
apply (case_tac m) |
|
3494 |
apply auto |
|
59807 | 3495 |
apply (drule_tac t="length xs" for xs in sym) |
70193 | 3496 |
apply (auto simp: zip_replicate o_def map_replicate_const) |
37660 | 3497 |
done |
3498 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
3499 |
|
61799 | 3500 |
subsubsection \<open>Mask\<close> |
37660 | 3501 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3502 |
lemma minus_1_eq_mask: |
72082 | 3503 |
\<open>- 1 = (mask LENGTH('a) :: 'a::len word)\<close> |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
3504 |
by (rule bit_eqI) (simp add: bit_exp_iff bit_mask_iff exp_eq_zero_iff) |
72079 | 3505 |
|
3506 |
lemma mask_eq_decr_exp: |
|
72082 | 3507 |
\<open>mask n = 2 ^ n - (1 :: 'a::len word)\<close> |
3508 |
by (fact mask_eq_exp_minus_1) |
|
71953 | 3509 |
|
3510 |
lemma mask_Suc_rec: |
|
72082 | 3511 |
\<open>mask (Suc n) = 2 * mask n + (1 :: 'a::len word)\<close> |
3512 |
by (simp add: mask_eq_exp_minus_1) |
|
71953 | 3513 |
|
3514 |
context |
|
3515 |
begin |
|
3516 |
||
71990 | 3517 |
qualified lemma bit_mask_iff: |
3518 |
\<open>bit (mask m :: 'a::len word) n \<longleftrightarrow> n < min LENGTH('a) m\<close> |
|
72082 | 3519 |
by (simp add: bit_mask_iff exp_eq_zero_iff not_le) |
71953 | 3520 |
|
3521 |
end |
|
3522 |
||
3523 |
lemma nth_mask [simp]: |
|
3524 |
\<open>(mask n :: 'a::len word) !! i \<longleftrightarrow> i < n \<and> i < size (mask n :: 'a word)\<close> |
|
71990 | 3525 |
by (auto simp add: test_bit_word_eq word_size Word.bit_mask_iff) |
37660 | 3526 |
|
72128 | 3527 |
lemma mask_bin: "mask n = word_of_int (take_bit n (- 1))" |
37660 | 3528 |
by (auto simp add: nth_bintr word_size intro: word_eqI) |
3529 |
||
72128 | 3530 |
lemma and_mask_bintr: "w AND mask n = word_of_int (take_bit n (uint w))" |
37660 | 3531 |
apply (rule word_eqI) |
3532 |
apply (simp add: nth_bintr word_size word_ops_nth_size) |
|
3533 |
apply (auto simp add: test_bit_bin) |
|
3534 |
done |
|
3535 |
||
72128 | 3536 |
lemma and_mask_wi: "word_of_int i AND mask n = word_of_int (take_bit n i)" |
46023
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
3537 |
by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff) |
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
3538 |
|
65328 | 3539 |
lemma and_mask_wi': |
72128 | 3540 |
"word_of_int i AND mask n = (word_of_int (take_bit (min LENGTH('a) n) i) :: 'a::len word)" |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
3541 |
by (auto simp add: nth_bintr word_size word_ops_nth_size word_eq_iff) |
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
3542 |
|
72128 | 3543 |
lemma and_mask_no: "numeral i AND mask n = word_of_int (take_bit n (numeral i))" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3544 |
unfolding word_numeral_alt by (rule and_mask_wi) |
37660 | 3545 |
|
45811 | 3546 |
lemma and_mask_mod_2p: "w AND mask n = word_of_int (uint w mod 2 ^ n)" |
72128 | 3547 |
by (simp only: and_mask_bintr take_bit_eq_mod) |
37660 | 3548 |
|
3549 |
lemma and_mask_lt_2p: "uint (w AND mask n) < 2 ^ n" |
|
71997 | 3550 |
by (simp add: and_mask_bintr uint.abs_eq min_def not_le lt2p_lem bintr_lt2p) |
37660 | 3551 |
|
65363 | 3552 |
lemma eq_mod_iff: "0 < n \<Longrightarrow> b = b mod n \<longleftrightarrow> 0 \<le> b \<and> b < n" |
3553 |
for b n :: int |
|
71997 | 3554 |
by auto (metis pos_mod_conj)+ |
37660 | 3555 |
|
65363 | 3556 |
lemma mask_eq_iff: "w AND mask n = w \<longleftrightarrow> uint w < 2 ^ n" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3557 |
apply (simp add: and_mask_bintr) |
37660 | 3558 |
apply (simp add: word_ubin.inverse_norm) |
72128 | 3559 |
apply (simp add: eq_mod_iff take_bit_eq_mod min_def) |
37660 | 3560 |
apply (fast intro!: lt2p_lem) |
3561 |
done |
|
3562 |
||
65328 | 3563 |
lemma and_mask_dvd: "2 ^ n dvd uint w \<longleftrightarrow> w AND mask n = 0" |
37660 | 3564 |
apply (simp add: dvd_eq_mod_eq_0 and_mask_mod_2p) |
65328 | 3565 |
apply (simp add: word_uint.norm_eq_iff [symmetric] word_of_int_homs del: word_of_int_0) |
37660 | 3566 |
apply (subst word_uint.norm_Rep [symmetric]) |
72128 | 3567 |
apply (simp only: bintrunc_bintrunc_min take_bit_eq_mod [symmetric] min_def) |
37660 | 3568 |
apply auto |
3569 |
done |
|
3570 |
||
65328 | 3571 |
lemma and_mask_dvd_nat: "2 ^ n dvd unat w \<longleftrightarrow> w AND mask n = 0" |
72079 | 3572 |
apply (simp flip: and_mask_dvd) |
3573 |
apply transfer |
|
3574 |
using dvd_nat_abs_iff [of _ \<open>take_bit LENGTH('a) k\<close> for k] |
|
3575 |
apply simp |
|
37660 | 3576 |
done |
3577 |
||
65328 | 3578 |
lemma word_2p_lem: "n < size w \<Longrightarrow> w < 2 ^ n = (uint w < 2 ^ n)" |
3579 |
for w :: "'a::len word" |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
3580 |
apply (unfold word_size word_less_alt word_numeral_alt) |
71942 | 3581 |
apply (auto simp add: word_of_int_power_hom word_uint.eq_norm |
65328 | 3582 |
simp del: word_of_int_numeral) |
37660 | 3583 |
done |
3584 |
||
65328 | 3585 |
lemma less_mask_eq: "x < 2 ^ n \<Longrightarrow> x AND mask n = x" |
3586 |
for x :: "'a::len word" |
|
71997 | 3587 |
apply (simp add: and_mask_bintr) |
3588 |
apply transfer |
|
3589 |
apply (simp add: ac_simps) |
|
3590 |
apply (auto simp add: min_def) |
|
3591 |
apply (metis bintrunc_bintrunc_ge mod_pos_pos_trivial mult.commute mult.left_neutral mult_zero_left not_le of_bool_def take_bit_eq_mod take_bit_nonnegative) |
|
37660 | 3592 |
done |
3593 |
||
45604 | 3594 |
lemmas mask_eq_iff_w2p = trans [OF mask_eq_iff word_2p_lem [symmetric]] |
3595 |
||
3596 |
lemmas and_mask_less' = iffD2 [OF word_2p_lem and_mask_lt_2p, simplified word_size] |
|
37660 | 3597 |
|
72082 | 3598 |
lemma and_mask_less_size: "n < size x \<Longrightarrow> x AND mask n < 2 ^ n" |
3599 |
for x :: \<open>'a::len word\<close> |
|
37660 | 3600 |
unfolding word_size by (erule and_mask_less') |
3601 |
||
65328 | 3602 |
lemma word_mod_2p_is_mask [OF refl]: "c = 2 ^ n \<Longrightarrow> c > 0 \<Longrightarrow> x mod c = x AND mask n" |
3603 |
for c x :: "'a::len word" |
|
3604 |
by (auto simp: word_mod_def uint_2p and_mask_mod_2p) |
|
37660 | 3605 |
|
3606 |
lemma mask_eqs: |
|
3607 |
"(a AND mask n) + b AND mask n = a + b AND mask n" |
|
3608 |
"a + (b AND mask n) AND mask n = a + b AND mask n" |
|
3609 |
"(a AND mask n) - b AND mask n = a - b AND mask n" |
|
3610 |
"a - (b AND mask n) AND mask n = a - b AND mask n" |
|
3611 |
"a * (b AND mask n) AND mask n = a * b AND mask n" |
|
3612 |
"(b AND mask n) * a AND mask n = b * a AND mask n" |
|
3613 |
"(a AND mask n) + (b AND mask n) AND mask n = a + b AND mask n" |
|
3614 |
"(a AND mask n) - (b AND mask n) AND mask n = a - b AND mask n" |
|
3615 |
"(a AND mask n) * (b AND mask n) AND mask n = a * b AND mask n" |
|
3616 |
"- (a AND mask n) AND mask n = - a AND mask n" |
|
3617 |
"word_succ (a AND mask n) AND mask n = word_succ a AND mask n" |
|
3618 |
"word_pred (a AND mask n) AND mask n = word_pred a AND mask n" |
|
3619 |
using word_of_int_Ex [where x=a] word_of_int_Ex [where x=b] |
|
72128 | 3620 |
by (auto simp: and_mask_wi' word_of_int_homs word.abs_eq_iff take_bit_eq_mod mod_simps) |
65328 | 3621 |
|
3622 |
lemma mask_power_eq: "(x AND mask n) ^ k AND mask n = x ^ k AND mask n" |
|
72082 | 3623 |
for x :: \<open>'a::len word\<close> |
37660 | 3624 |
using word_of_int_Ex [where x=x] |
72128 | 3625 |
by (auto simp: and_mask_wi' word_of_int_power_hom word.abs_eq_iff take_bit_eq_mod mod_simps) |
37660 | 3626 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
3627 |
lemma mask_full [simp]: "mask LENGTH('a) = (- 1 :: 'a::len word)" |
72079 | 3628 |
by transfer (simp add: take_bit_minus_one_eq_mask) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
3629 |
|
37660 | 3630 |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3631 |
subsubsection \<open>Slices\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3632 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3633 |
definition slice1 :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3634 |
where \<open>slice1 n w = (if n < LENGTH('a) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3635 |
then ucast (drop_bit (LENGTH('a) - n) w) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3636 |
else push_bit (n - LENGTH('a)) (ucast w))\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3637 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3638 |
lemma bit_slice1_iff: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3639 |
\<open>bit (slice1 m w :: 'b::len word) n \<longleftrightarrow> m - LENGTH('a) \<le> n \<and> n < min LENGTH('b) m |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3640 |
\<and> bit w (n + (LENGTH('a) - m) - (m - LENGTH('a)))\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3641 |
for w :: \<open>'a::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3642 |
by (auto simp add: slice1_def bit_ucast_iff bit_drop_bit_eq bit_push_bit_iff exp_eq_zero_iff not_less not_le ac_simps |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3643 |
dest: bit_imp_le_length) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3644 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3645 |
definition slice :: \<open>nat \<Rightarrow> 'a::len word \<Rightarrow> 'b::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3646 |
where \<open>slice n = slice1 (LENGTH('a) - n)\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3647 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3648 |
lemma bit_slice_iff: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3649 |
\<open>bit (slice m w :: 'b::len word) n \<longleftrightarrow> n < min LENGTH('b) (LENGTH('a) - m) \<and> bit w (n + LENGTH('a) - (LENGTH('a) - m))\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3650 |
for w :: \<open>'a::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3651 |
by (simp add: slice_def word_size bit_slice1_iff) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3652 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3653 |
lemma slice1_0 [simp] : "slice1 n 0 = 0" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3654 |
unfolding slice1_def by simp |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3655 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3656 |
lemma slice_0 [simp] : "slice n 0 = 0" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3657 |
unfolding slice_def by auto |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3658 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3659 |
lemma slice_shiftr: "slice n w = ucast (w >> n)" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3660 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3661 |
apply (cases \<open>n \<le> LENGTH('b)\<close>) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3662 |
apply (auto simp add: bit_slice_iff bit_ucast_iff bit_shiftr_word_iff ac_simps |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3663 |
dest: bit_imp_le_length) |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3664 |
done |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3665 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3666 |
lemma nth_slice: "(slice n w :: 'a::len word) !! m = (w !! (m + n) \<and> m < LENGTH('a))" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3667 |
by (simp add: slice_shiftr nth_ucast nth_shiftr) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3668 |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3669 |
lemma ucast_slice1: "ucast w = slice1 (size w) w" |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3670 |
apply (simp add: slice1_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3671 |
apply transfer |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3672 |
apply simp |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3673 |
done |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3674 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3675 |
lemma ucast_slice: "ucast w = slice 0 w" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3676 |
by (simp add: slice_def slice1_def) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3677 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3678 |
lemma slice_id: "slice 0 t = t" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3679 |
by (simp only: ucast_slice [symmetric] ucast_id) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3680 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3681 |
lemma rev_slice1: |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3682 |
\<open>slice1 n (word_reverse w :: 'b::len word) = word_reverse (slice1 k w :: 'a::len word)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3683 |
if \<open>n + k = LENGTH('a) + LENGTH('b)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3684 |
proof (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3685 |
fix m |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3686 |
assume *: \<open>m < LENGTH('a)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3687 |
from that have **: \<open>LENGTH('b) = n + k - LENGTH('a)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3688 |
by simp |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3689 |
show \<open>bit (slice1 n (word_reverse w :: 'b word) :: 'a word) m \<longleftrightarrow> bit (word_reverse (slice1 k w :: 'a word)) m\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3690 |
apply (simp add: bit_slice1_iff bit_word_reverse_iff) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3691 |
using * ** |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3692 |
apply (cases \<open>n \<le> LENGTH('a)\<close>; cases \<open>k \<le> LENGTH('a)\<close>) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3693 |
apply auto |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3694 |
done |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3695 |
qed |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3696 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3697 |
lemma rev_slice: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3698 |
"n + k + LENGTH('a::len) = LENGTH('b::len) \<Longrightarrow> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3699 |
slice n (word_reverse (w::'b word)) = word_reverse (slice k w :: 'a word)" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3700 |
apply (unfold slice_def word_size) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3701 |
apply (rule rev_slice1) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3702 |
apply arith |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3703 |
done |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3704 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3705 |
|
61799 | 3706 |
subsubsection \<open>Revcast\<close> |
37660 | 3707 |
|
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3708 |
definition revcast :: \<open>'a::len word \<Rightarrow> 'b::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3709 |
where \<open>revcast = slice1 LENGTH('b)\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3710 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3711 |
lemma bit_revcast_iff: |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3712 |
\<open>bit (revcast w :: 'b::len word) n \<longleftrightarrow> LENGTH('b) - LENGTH('a) \<le> n \<and> n < LENGTH('b) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3713 |
\<and> bit w (n + (LENGTH('a) - LENGTH('b)) - (LENGTH('b) - LENGTH('a)))\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3714 |
for w :: \<open>'a::len word\<close> |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3715 |
by (simp add: revcast_def bit_slice1_iff) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3716 |
|
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3717 |
lemma revcast_slice1 [OF refl]: "rc = revcast w \<Longrightarrow> slice1 (size rc) w = rc" |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3718 |
by (simp add: revcast_def word_size) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3719 |
|
65268 | 3720 |
lemma revcast_rev_ucast [OF refl refl refl]: |
3721 |
"cs = [rc, uc] \<Longrightarrow> rc = revcast (word_reverse w) \<Longrightarrow> uc = ucast w \<Longrightarrow> |
|
37660 | 3722 |
rc = word_reverse uc" |
72027
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3723 |
apply auto |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3724 |
apply (rule bit_word_eqI) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3725 |
apply (cases \<open>LENGTH('a) \<le> LENGTH('b)\<close>) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3726 |
apply (simp_all add: bit_revcast_iff bit_word_reverse_iff bit_ucast_iff not_le |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3727 |
bit_imp_le_length) |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3728 |
using bit_imp_le_length apply fastforce |
759532ef0885
prefer canonically oriented lists of bits and more direct characterizations in definitions
haftmann
parents:
72010
diff
changeset
|
3729 |
using bit_imp_le_length apply fastforce |
37660 | 3730 |
done |
3731 |
||
45811 | 3732 |
lemma revcast_ucast: "revcast w = word_reverse (ucast (word_reverse w))" |
3733 |
using revcast_rev_ucast [of "word_reverse w"] by simp |
|
3734 |
||
3735 |
lemma ucast_revcast: "ucast w = word_reverse (revcast (word_reverse w))" |
|
3736 |
by (fact revcast_rev_ucast [THEN word_rev_gal']) |
|
3737 |
||
3738 |
lemma ucast_rev_revcast: "ucast (word_reverse w) = word_reverse (revcast w)" |
|
3739 |
by (fact revcast_ucast [THEN word_rev_gal']) |
|
37660 | 3740 |
|
3741 |
||
65328 | 3742 |
text "linking revcast and cast via shift" |
37660 | 3743 |
|
3744 |
lemmas wsst_TYs = source_size target_size word_size |
|
3745 |
||
45811 | 3746 |
lemma revcast_down_uu [OF refl]: |
65328 | 3747 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >> n)" |
3748 |
for w :: "'a::len word" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3749 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3750 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3751 |
apply (simp add: bit_revcast_iff bit_ucast_iff bit_shiftr_word_iff ac_simps) |
37660 | 3752 |
done |
3753 |
||
45811 | 3754 |
lemma revcast_down_us [OF refl]: |
65328 | 3755 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = ucast (w >>> n)" |
3756 |
for w :: "'a::len word" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3757 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3758 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3759 |
apply (simp add: bit_revcast_iff bit_ucast_iff bit_sshiftr_word_iff ac_simps) |
37660 | 3760 |
done |
3761 |
||
45811 | 3762 |
lemma revcast_down_su [OF refl]: |
65328 | 3763 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >> n)" |
3764 |
for w :: "'a::len word" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3765 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3766 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3767 |
apply (simp add: bit_revcast_iff bit_word_scast_iff bit_shiftr_word_iff ac_simps) |
37660 | 3768 |
done |
3769 |
||
45811 | 3770 |
lemma revcast_down_ss [OF refl]: |
65328 | 3771 |
"rc = revcast \<Longrightarrow> source_size rc = target_size rc + n \<Longrightarrow> rc w = scast (w >>> n)" |
3772 |
for w :: "'a::len word" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3773 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3774 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3775 |
apply (simp add: bit_revcast_iff bit_word_scast_iff bit_sshiftr_word_iff ac_simps) |
37660 | 3776 |
done |
3777 |
||
72079 | 3778 |
lemma cast_down_rev [OF refl]: |
65328 | 3779 |
"uc = ucast \<Longrightarrow> source_size uc = target_size uc + n \<Longrightarrow> uc w = revcast (w << n)" |
3780 |
for w :: "'a::len word" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3781 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3782 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3783 |
apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff) |
37660 | 3784 |
done |
3785 |
||
45811 | 3786 |
lemma revcast_up [OF refl]: |
65268 | 3787 |
"rc = revcast \<Longrightarrow> source_size rc + n = target_size rc \<Longrightarrow> |
3788 |
rc w = (ucast w :: 'a::len word) << n" |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3789 |
apply (simp add: source_size_def target_size_def) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3790 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3791 |
apply (simp add: bit_revcast_iff bit_word_ucast_iff bit_shiftl_word_iff) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3792 |
apply auto |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3793 |
apply (metis add.commute add_diff_cancel_right) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3794 |
apply (metis diff_add_inverse2 diff_diff_add) |
37660 | 3795 |
done |
3796 |
||
65268 | 3797 |
lemmas rc1 = revcast_up [THEN |
37660 | 3798 |
revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]] |
65268 | 3799 |
lemmas rc2 = revcast_down_uu [THEN |
37660 | 3800 |
revcast_rev_ucast [symmetric, THEN trans, THEN word_rev_gal, symmetric]] |
3801 |
||
3802 |
lemmas ucast_up = |
|
3803 |
rc1 [simplified rev_shiftr [symmetric] revcast_ucast [symmetric]] |
|
65268 | 3804 |
lemmas ucast_down = |
37660 | 3805 |
rc2 [simplified rev_shiftr revcast_ucast [symmetric]] |
3806 |
||
65268 | 3807 |
lemmas sym_notr = |
37660 | 3808 |
not_iff [THEN iffD2, THEN not_sym, THEN not_iff [THEN iffD1]] |
3809 |
||
61799 | 3810 |
\<comment> \<open>problem posed by TPHOLs referee: |
3811 |
criterion for overflow of addition of signed integers\<close> |
|
37660 | 3812 |
|
3813 |
lemma sofl_test: |
|
72000 | 3814 |
\<open>sint x + sint y = sint (x + y) \<longleftrightarrow> |
3815 |
(x + y XOR x) AND (x + y XOR y) >> (size x - 1) = 0\<close> |
|
3816 |
for x y :: \<open>'a::len word\<close> |
|
3817 |
proof - |
|
3818 |
obtain n where n: \<open>LENGTH('a) = Suc n\<close> |
|
3819 |
by (cases \<open>LENGTH('a)\<close>) simp_all |
|
72010 | 3820 |
have *: \<open>sint x + sint y + 2 ^ Suc n > signed_take_bit n (sint x + sint y) \<Longrightarrow> sint x + sint y \<ge> - (2 ^ n)\<close> |
3821 |
\<open>signed_take_bit n (sint x + sint y) > sint x + sint y - 2 ^ Suc n \<Longrightarrow> 2 ^ n > sint x + sint y\<close> |
|
3822 |
using signed_take_bit_greater_eq [of \<open>sint x + sint y\<close> n] signed_take_bit_less_eq [of n \<open>sint x + sint y\<close>] |
|
3823 |
by (auto intro: ccontr) |
|
72000 | 3824 |
have \<open>sint x + sint y = sint (x + y) \<longleftrightarrow> |
3825 |
(sint (x + y) < 0 \<longleftrightarrow> sint x < 0) \<or> |
|
3826 |
(sint (x + y) < 0 \<longleftrightarrow> sint y < 0)\<close> |
|
72010 | 3827 |
using sint_range' [of x] sint_range' [of y] |
3828 |
apply (auto simp add: not_less) |
|
3829 |
apply (unfold sint_word_ariths word_sbin.set_iff_norm [symmetric] sints_num) |
|
3830 |
apply (auto simp add: signed_take_bit_eq_take_bit_minus take_bit_Suc_from_most n not_less intro!: *) |
|
72000 | 3831 |
done |
3832 |
then show ?thesis |
|
72010 | 3833 |
apply (simp add: word_size shiftr_word_eq drop_bit_eq_zero_iff_not_bit_last bit_and_iff bit_xor_iff) |
72000 | 3834 |
apply (simp add: bit_last_iff) |
3835 |
done |
|
3836 |
qed |
|
37660 | 3837 |
|
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
3838 |
lemma shiftr_zero_size: "size x \<le> n \<Longrightarrow> x >> n = 0" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3839 |
for x :: "'a :: len word" |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
3840 |
by (rule word_eqI) (auto simp add: nth_shiftr dest: test_bit_size) |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
3841 |
|
37660 | 3842 |
|
61799 | 3843 |
subsection \<open>Split and cat\<close> |
37660 | 3844 |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3845 |
lemmas word_split_bin' = word_split_def |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3846 |
lemmas word_cat_bin' = word_cat_eq |
37660 | 3847 |
|
3848 |
lemma word_rsplit_no: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3849 |
"(word_rsplit (numeral bin :: 'b::len word) :: 'a word list) = |
70185 | 3850 |
map word_of_int (bin_rsplit (LENGTH('a::len)) |
72128 | 3851 |
(LENGTH('b), take_bit (LENGTH('b)) (numeral bin)))" |
65336 | 3852 |
by (simp add: word_rsplit_def word_ubin.eq_norm) |
37660 | 3853 |
|
3854 |
lemmas word_rsplit_no_cl [simp] = word_rsplit_no |
|
3855 |
[unfolded bin_rsplitl_def bin_rsplit_l [symmetric]] |
|
3856 |
||
72079 | 3857 |
lemma test_bit_cat [OF refl]: |
65336 | 3858 |
"wc = word_cat a b \<Longrightarrow> wc !! n = (n < size wc \<and> |
37660 | 3859 |
(if n < size b then b !! n else a !! (n - size b)))" |
72079 | 3860 |
apply (simp add: word_size not_less; transfer) |
3861 |
apply (auto simp add: bit_concat_bit_iff bit_take_bit_iff) |
|
37660 | 3862 |
done |
3863 |
||
65336 | 3864 |
lemma split_uint_lem: "bin_split n (uint w) = (a, b) \<Longrightarrow> |
72128 | 3865 |
a = take_bit (LENGTH('a) - n) a \<and> b = take_bit (LENGTH('a)) b" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3866 |
for w :: "'a::len word" |
37660 | 3867 |
apply (frule word_ubin.norm_Rep [THEN ssubst]) |
3868 |
apply (drule bin_split_trunc1) |
|
3869 |
apply (drule sym [THEN trans]) |
|
65336 | 3870 |
apply assumption |
37660 | 3871 |
apply safe |
3872 |
done |
|
3873 |
||
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67408
diff
changeset
|
3874 |
\<comment> \<open>keep quantifiers for use in simplification\<close> |
37660 | 3875 |
lemma test_bit_split': |
65336 | 3876 |
"word_split c = (a, b) \<longrightarrow> |
3877 |
(\<forall>n m. |
|
3878 |
b !! n = (n < size b \<and> c !! n) \<and> |
|
3879 |
a !! m = (m < size a \<and> c !! (m + size b)))" |
|
37660 | 3880 |
apply (unfold word_split_bin' test_bit_bin) |
3881 |
apply (clarify) |
|
3882 |
apply (clarsimp simp: word_ubin.eq_norm nth_bintr word_size split: prod.splits) |
|
71949 | 3883 |
apply (auto simp add: bit_take_bit_iff bit_drop_bit_eq ac_simps bin_nth_uint_imp) |
37660 | 3884 |
done |
3885 |
||
3886 |
lemma test_bit_split: |
|
3887 |
"word_split c = (a, b) \<Longrightarrow> |
|
65336 | 3888 |
(\<forall>n::nat. b !! n \<longleftrightarrow> n < size b \<and> c !! n) \<and> |
3889 |
(\<forall>m::nat. a !! m \<longleftrightarrow> m < size a \<and> c !! (m + size b))" |
|
37660 | 3890 |
by (simp add: test_bit_split') |
3891 |
||
65336 | 3892 |
lemma test_bit_split_eq: |
3893 |
"word_split c = (a, b) \<longleftrightarrow> |
|
3894 |
((\<forall>n::nat. b !! n = (n < size b \<and> c !! n)) \<and> |
|
3895 |
(\<forall>m::nat. a !! m = (m < size a \<and> c !! (m + size b))))" |
|
37660 | 3896 |
apply (rule_tac iffI) |
3897 |
apply (rule_tac conjI) |
|
3898 |
apply (erule test_bit_split [THEN conjunct1]) |
|
3899 |
apply (erule test_bit_split [THEN conjunct2]) |
|
3900 |
apply (case_tac "word_split c") |
|
3901 |
apply (frule test_bit_split) |
|
3902 |
apply (erule trans) |
|
65336 | 3903 |
apply (fastforce intro!: word_eqI simp add: word_size) |
37660 | 3904 |
done |
3905 |
||
65268 | 3906 |
\<comment> \<open>this odd result is analogous to \<open>ucast_id\<close>, |
61799 | 3907 |
result to the length given by the result type\<close> |
37660 | 3908 |
|
3909 |
lemma word_cat_id: "word_cat a b = b" |
|
72079 | 3910 |
by transfer simp |
37660 | 3911 |
|
67443
3abf6a722518
standardized towards new-style formal comments: isabelle update_comments;
wenzelm
parents:
67408
diff
changeset
|
3912 |
\<comment> \<open>limited hom result\<close> |
37660 | 3913 |
lemma word_cat_hom: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
3914 |
"LENGTH('a::len) \<le> LENGTH('b::len) + LENGTH('c::len) \<Longrightarrow> |
65336 | 3915 |
(word_cat (word_of_int w :: 'b word) (b :: 'c word) :: 'a word) = |
3916 |
word_of_int (bin_cat w (size b) (uint b))" |
|
72079 | 3917 |
apply transfer |
3918 |
using bintr_cat by auto |
|
65336 | 3919 |
|
3920 |
lemma word_cat_split_alt: "size w \<le> size u + size v \<Longrightarrow> word_split w = (u, v) \<Longrightarrow> word_cat u v = w" |
|
37660 | 3921 |
apply (rule word_eqI) |
3922 |
apply (drule test_bit_split) |
|
3923 |
apply (clarsimp simp add : test_bit_cat word_size) |
|
3924 |
apply safe |
|
3925 |
apply arith |
|
3926 |
done |
|
3927 |
||
45604 | 3928 |
lemmas word_cat_split_size = sym [THEN [2] word_cat_split_alt [symmetric]] |
37660 | 3929 |
|
3930 |
||
61799 | 3931 |
subsubsection \<open>Split and slice\<close> |
37660 | 3932 |
|
65336 | 3933 |
lemma split_slices: "word_split w = (u, v) \<Longrightarrow> u = slice (size v) w \<and> v = slice 0 w" |
37660 | 3934 |
apply (drule test_bit_split) |
3935 |
apply (rule conjI) |
|
3936 |
apply (rule word_eqI, clarsimp simp: nth_slice word_size)+ |
|
3937 |
done |
|
3938 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
3939 |
lemma slice_cat1 [OF refl]: |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3940 |
"wc = word_cat a b \<Longrightarrow> size wc >= size a + size b \<Longrightarrow> slice (size b) wc = a" |
37660 | 3941 |
apply safe |
3942 |
apply (rule word_eqI) |
|
3943 |
apply (simp add: nth_slice test_bit_cat word_size) |
|
3944 |
done |
|
3945 |
||
3946 |
lemmas slice_cat2 = trans [OF slice_id word_cat_id] |
|
3947 |
||
3948 |
lemma cat_slices: |
|
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
3949 |
"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
|
3950 |
size a + size b >= size c \<Longrightarrow> word_cat a b = c" |
37660 | 3951 |
apply safe |
3952 |
apply (rule word_eqI) |
|
3953 |
apply (simp add: nth_slice test_bit_cat word_size) |
|
3954 |
apply safe |
|
3955 |
apply arith |
|
3956 |
done |
|
3957 |
||
3958 |
lemma word_split_cat_alt: |
|
65336 | 3959 |
"w = word_cat u v \<Longrightarrow> size u + size v \<le> size w \<Longrightarrow> word_split w = (u, v)" |
59807 | 3960 |
apply (case_tac "word_split w") |
37660 | 3961 |
apply (rule trans, assumption) |
3962 |
apply (drule test_bit_split) |
|
3963 |
apply safe |
|
3964 |
apply (rule word_eqI, clarsimp simp: test_bit_cat word_size)+ |
|
3965 |
done |
|
3966 |
||
65336 | 3967 |
text \<open> |
3968 |
This odd result arises from the fact that the statement of the |
|
3969 |
result implies that the decoded words are of the same type, |
|
3970 |
and therefore of the same length, as the original word.\<close> |
|
37660 | 3971 |
|
3972 |
lemma word_rsplit_same: "word_rsplit w = [w]" |
|
65336 | 3973 |
by (simp add: word_rsplit_def bin_rsplit_all) |
3974 |
||
3975 |
lemma word_rsplit_empty_iff_size: "word_rsplit w = [] \<longleftrightarrow> size w = 0" |
|
3976 |
by (simp add: word_rsplit_def bin_rsplit_def word_size bin_rsplit_aux_simp_alt Let_def |
|
3977 |
split: prod.split) |
|
37660 | 3978 |
|
3979 |
lemma test_bit_rsplit: |
|
65363 | 3980 |
"sw = word_rsplit w \<Longrightarrow> m < size (hd sw) \<Longrightarrow> |
3981 |
k < length sw \<Longrightarrow> (rev sw ! k) !! m = w !! (k * size (hd sw) + m)" |
|
3982 |
for sw :: "'a::len word list" |
|
37660 | 3983 |
apply (unfold word_rsplit_def word_test_bit_def) |
3984 |
apply (rule trans) |
|
65336 | 3985 |
apply (rule_tac f = "\<lambda>x. bin_nth x m" in arg_cong) |
37660 | 3986 |
apply (rule nth_map [symmetric]) |
3987 |
apply simp |
|
3988 |
apply (rule bin_nth_rsplit) |
|
3989 |
apply simp_all |
|
3990 |
apply (simp add : word_size rev_map) |
|
3991 |
apply (rule trans) |
|
3992 |
defer |
|
3993 |
apply (rule map_ident [THEN fun_cong]) |
|
3994 |
apply (rule refl [THEN map_cong]) |
|
3995 |
apply (simp add : word_ubin.eq_norm) |
|
3996 |
apply (erule bin_rsplit_size_sign [OF len_gt_0 refl]) |
|
3997 |
done |
|
3998 |
||
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
3999 |
lemma horner_sum_uint_exp_Cons_eq: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4000 |
\<open>horner_sum uint (2 ^ LENGTH('a)) (w # ws) = |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4001 |
concat_bit LENGTH('a) (uint w) (horner_sum uint (2 ^ LENGTH('a)) ws)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4002 |
for ws :: \<open>'a::len word list\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4003 |
by (simp add: concat_bit_eq push_bit_eq_mult) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4004 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4005 |
lemma bit_horner_sum_uint_exp_iff: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4006 |
\<open>bit (horner_sum uint (2 ^ LENGTH('a)) ws) n \<longleftrightarrow> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4007 |
n div LENGTH('a) < length ws \<and> bit (ws ! (n div LENGTH('a))) (n mod LENGTH('a))\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4008 |
for ws :: \<open>'a::len word list\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4009 |
proof (induction ws arbitrary: n) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4010 |
case Nil |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4011 |
then show ?case |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4012 |
by simp |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4013 |
next |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4014 |
case (Cons w ws) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4015 |
then show ?case |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4016 |
by (cases \<open>n \<ge> LENGTH('a)\<close>) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4017 |
(simp_all only: horner_sum_uint_exp_Cons_eq, simp_all add: bit_concat_bit_iff le_div_geq le_mod_geq bit_uint_iff Cons) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4018 |
qed |
37660 | 4019 |
|
4020 |
lemma test_bit_rcat: |
|
65363 | 4021 |
"sw = size (hd wl) \<Longrightarrow> rc = word_rcat wl \<Longrightarrow> rc !! n = |
65336 | 4022 |
(n < size rc \<and> n div sw < size wl \<and> (rev wl) ! (n div sw) !! (n mod sw))" |
65363 | 4023 |
for wl :: "'a::len word list" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4024 |
by (simp add: word_size word_rcat_def bin_rcat_def foldl_map rev_map bit_horner_sum_uint_exp_iff) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4025 |
(simp add: test_bit_eq_bit) |
37660 | 4026 |
|
4027 |
lemmas test_bit_cong = arg_cong [where f = "test_bit", THEN fun_cong] |
|
4028 |
||
71996 | 4029 |
lemma test_bit_rsplit_alt: |
4030 |
\<open>(word_rsplit w :: 'b::len word list) ! i !! m \<longleftrightarrow> |
|
4031 |
w !! ((length (word_rsplit w :: 'b::len word list) - Suc i) * size (hd (word_rsplit w :: 'b::len word list)) + m)\<close> |
|
4032 |
if \<open>i < length (word_rsplit w :: 'b::len word list)\<close> \<open>m < size (hd (word_rsplit w :: 'b::len word list))\<close> \<open>0 < length (word_rsplit w :: 'b::len word list)\<close> |
|
4033 |
for w :: \<open>'a::len word\<close> |
|
4034 |
apply (rule trans) |
|
4035 |
apply (rule test_bit_cong) |
|
71997 | 4036 |
apply (rule rev_nth [of _ \<open>rev (word_rsplit w)\<close>, simplified rev_rev_ident]) |
4037 |
apply simp |
|
71996 | 4038 |
apply (rule that(1)) |
71997 | 4039 |
apply simp |
71996 | 4040 |
apply (rule test_bit_rsplit) |
4041 |
apply (rule refl) |
|
4042 |
apply (rule asm_rl) |
|
4043 |
apply (rule that(2)) |
|
4044 |
apply (rule diff_Suc_less) |
|
4045 |
apply (rule that(3)) |
|
4046 |
done |
|
4047 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
4048 |
lemma word_rsplit_len_indep [OF refl refl refl refl]: |
65268 | 4049 |
"[u,v] = p \<Longrightarrow> [su,sv] = q \<Longrightarrow> word_rsplit u = su \<Longrightarrow> |
40827
abbc05c20e24
code preprocessor setup for numerals on word type;
haftmann
parents:
39910
diff
changeset
|
4050 |
word_rsplit v = sv \<Longrightarrow> length su = length sv" |
65336 | 4051 |
by (auto simp: word_rsplit_def bin_rsplit_len_indep) |
37660 | 4052 |
|
65268 | 4053 |
lemma length_word_rsplit_size: |
70185 | 4054 |
"n = LENGTH('a::len) \<Longrightarrow> |
65336 | 4055 |
length (word_rsplit w :: 'a word list) \<le> m \<longleftrightarrow> size w \<le> m * n" |
4056 |
by (auto simp: word_rsplit_def word_size bin_rsplit_len_le) |
|
37660 | 4057 |
|
65268 | 4058 |
lemmas length_word_rsplit_lt_size = |
37660 | 4059 |
length_word_rsplit_size [unfolded Not_eq_iff linorder_not_less [symmetric]] |
4060 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
4061 |
lemma length_word_rsplit_exp_size: |
70185 | 4062 |
"n = LENGTH('a::len) \<Longrightarrow> |
37660 | 4063 |
length (word_rsplit w :: 'a word list) = (size w + n - 1) div n" |
65336 | 4064 |
by (auto simp: word_rsplit_def word_size bin_rsplit_len) |
37660 | 4065 |
|
65268 | 4066 |
lemma length_word_rsplit_even_size: |
70185 | 4067 |
"n = LENGTH('a::len) \<Longrightarrow> size w = m * n \<Longrightarrow> |
37660 | 4068 |
length (word_rsplit w :: 'a word list) = m" |
71997 | 4069 |
by (cases \<open>LENGTH('a)\<close>) (simp_all add: length_word_rsplit_exp_size div_nat_eqI) |
37660 | 4070 |
|
4071 |
lemmas length_word_rsplit_exp_size' = refl [THEN length_word_rsplit_exp_size] |
|
4072 |
||
67408 | 4073 |
\<comment> \<open>alternative proof of \<open>word_rcat_rsplit\<close>\<close> |
66808
1907167b6038
elementary definition of division on natural numbers
haftmann
parents:
66453
diff
changeset
|
4074 |
lemmas tdle = times_div_less_eq_dividend |
71997 | 4075 |
lemmas dtle = xtrans(4) [OF tdle mult.commute] |
37660 | 4076 |
|
4077 |
lemma word_rcat_rsplit: "word_rcat (word_rsplit w) = w" |
|
4078 |
apply (rule word_eqI) |
|
65336 | 4079 |
apply (clarsimp simp: test_bit_rcat word_size) |
37660 | 4080 |
apply (subst refl [THEN test_bit_rsplit]) |
65268 | 4081 |
apply (simp_all add: word_size |
37660 | 4082 |
refl [THEN length_word_rsplit_size [simplified not_less [symmetric], simplified]]) |
4083 |
apply safe |
|
71997 | 4084 |
apply (erule xtrans(7), rule dtle)+ |
37660 | 4085 |
done |
4086 |
||
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
4087 |
lemma size_word_rsplit_rcat_size: |
70185 | 4088 |
"word_rcat ws = frcw \<Longrightarrow> size frcw = length ws * LENGTH('a) |
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
4089 |
\<Longrightarrow> length (word_rsplit frcw::'a word list) = length ws" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4090 |
for ws :: "'a::len word list" and frcw :: "'b::len word" |
71997 | 4091 |
by (cases \<open>LENGTH('a)\<close>) (simp_all add: word_size length_word_rsplit_exp_size' div_nat_eqI) |
37660 | 4092 |
|
4093 |
lemma msrevs: |
|
65336 | 4094 |
"0 < n \<Longrightarrow> (k * n + m) div n = m div n + k" |
4095 |
"(k * n + m) mod n = m mod n" |
|
4096 |
for n :: nat |
|
57512
cc97b347b301
reduced name variants for assoc and commute on plus and mult
haftmann
parents:
57492
diff
changeset
|
4097 |
by (auto simp: add.commute) |
37660 | 4098 |
|
45816
6a04efd99f25
replace more uses of 'lemmas' with explicit 'lemma';
huffman
parents:
45811
diff
changeset
|
4099 |
lemma word_rsplit_rcat_size [OF refl]: |
65336 | 4100 |
"word_rcat ws = frcw \<Longrightarrow> |
70185 | 4101 |
size frcw = length ws * LENGTH('a) \<Longrightarrow> word_rsplit frcw = ws" |
65336 | 4102 |
for ws :: "'a::len word list" |
37660 | 4103 |
apply (frule size_word_rsplit_rcat_size, assumption) |
4104 |
apply (clarsimp simp add : word_size) |
|
4105 |
apply (rule nth_equalityI, assumption) |
|
4106 |
apply clarsimp |
|
46023
fad87bb608fc
restate some lemmas to respect int/bin distinction
huffman
parents:
46022
diff
changeset
|
4107 |
apply (rule word_eqI [rule_format]) |
37660 | 4108 |
apply (rule trans) |
4109 |
apply (rule test_bit_rsplit_alt) |
|
4110 |
apply (clarsimp simp: word_size)+ |
|
4111 |
apply (rule trans) |
|
65336 | 4112 |
apply (rule test_bit_rcat [OF refl refl]) |
55818 | 4113 |
apply (simp add: word_size) |
71997 | 4114 |
apply (subst rev_nth) |
37660 | 4115 |
apply arith |
71997 | 4116 |
apply (simp add: le0 [THEN [2] xtrans(7), THEN diff_Suc_less]) |
37660 | 4117 |
apply safe |
41550 | 4118 |
apply (simp add: diff_mult_distrib) |
65336 | 4119 |
apply (cases "size ws") |
4120 |
apply simp_all |
|
37660 | 4121 |
done |
4122 |
||
4123 |
||
61799 | 4124 |
subsection \<open>Rotation\<close> |
37660 | 4125 |
|
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4126 |
lemma word_rotr_word_rotr_eq: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4127 |
\<open>word_rotr m (word_rotr n w) = word_rotr (m + n) w\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4128 |
by (rule bit_word_eqI) (simp add: bit_word_rotr_iff ac_simps mod_add_right_eq) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4129 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4130 |
lemma word_rot_rl [simp]: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4131 |
\<open>word_rotl k (word_rotr k v) = v\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4132 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4133 |
apply (simp add: word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4134 |
apply (auto dest: bit_imp_le_length) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4135 |
apply (metis (no_types, lifting) add.right_neutral add_diff_cancel_right' div_mult_mod_eq mod_add_right_eq mod_add_self2 mod_if mod_mult_self2_is_0) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4136 |
apply (metis (no_types, lifting) add.right_neutral add_diff_cancel_right' bit_imp_le_length div_mult_mod_eq mod_add_right_eq mod_add_self2 mod_less mod_mult_self2_is_0) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4137 |
done |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4138 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4139 |
lemma word_rot_lr [simp]: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4140 |
\<open>word_rotr k (word_rotl k v) = v\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4141 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4142 |
apply (simp add: word_rotl_eq_word_rotr word_rotr_word_rotr_eq bit_word_rotr_iff algebra_simps) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4143 |
apply (auto dest: bit_imp_le_length) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4144 |
apply (metis (no_types, lifting) add.right_neutral add_diff_cancel_right' div_mult_mod_eq mod_add_right_eq mod_add_self2 mod_if mod_mult_self2_is_0) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4145 |
apply (metis (no_types, lifting) add.right_neutral add_diff_cancel_right' bit_imp_le_length div_mult_mod_eq mod_add_right_eq mod_add_self2 mod_less mod_mult_self2_is_0) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4146 |
done |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4147 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4148 |
lemma word_rot_gal: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4149 |
\<open>word_rotr n v = w \<longleftrightarrow> word_rotl n w = v\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4150 |
by auto |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4151 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4152 |
lemma word_rot_gal': |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4153 |
\<open>w = word_rotr n v \<longleftrightarrow> v = word_rotl n w\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4154 |
by auto |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4155 |
|
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4156 |
lemma word_rotr_rev: |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4157 |
\<open>word_rotr n w = word_reverse (word_rotl n (word_reverse w))\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4158 |
proof (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4159 |
fix m |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4160 |
assume \<open>m < LENGTH('a)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4161 |
moreover have \<open>1 + |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4162 |
((int m + int n mod int LENGTH('a)) mod int LENGTH('a) + |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4163 |
((int LENGTH('a) * 2) mod int LENGTH('a) - (1 + (int m + int n mod int LENGTH('a)))) mod int LENGTH('a)) = |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4164 |
int LENGTH('a)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4165 |
apply (cases \<open>(1 + (int m + int n mod int LENGTH('a))) mod |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4166 |
int LENGTH('a) = 0\<close>) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4167 |
using zmod_zminus1_eq_if [of \<open>1 + (int m + int n mod int LENGTH('a))\<close> \<open>int LENGTH('a)\<close>] |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4168 |
apply simp_all |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4169 |
apply (auto simp add: algebra_simps) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4170 |
apply (simp add: minus_equation_iff [of \<open>int m\<close>]) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4171 |
apply (drule sym [of _ \<open>int m\<close>]) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4172 |
apply simp |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4173 |
apply (metis add.commute add_minus_cancel diff_minus_eq_add len_gt_0 less_imp_of_nat_less less_nat_zero_code mod_mult_self3 of_nat_gt_0 zmod_minus1) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4174 |
apply (metis (no_types, hide_lams) Abs_fnat_hom_add less_not_refl mod_Suc of_nat_Suc of_nat_gt_0 of_nat_mod) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4175 |
done |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4176 |
then have \<open>int ((m + n) mod LENGTH('a)) = |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4177 |
int (LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a)))\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4178 |
using \<open>m < LENGTH('a)\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4179 |
by (simp only: of_nat_mod mod_simps) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4180 |
(simp add: of_nat_diff of_nat_mod Suc_le_eq add_less_mono algebra_simps mod_simps) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4181 |
then have \<open>(m + n) mod LENGTH('a) = |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4182 |
LENGTH('a) - Suc ((LENGTH('a) - Suc m + LENGTH('a) - n mod LENGTH('a)) mod LENGTH('a))\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4183 |
by simp |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4184 |
ultimately show \<open>bit (word_rotr n w) m \<longleftrightarrow> bit (word_reverse (word_rotl n (word_reverse w))) m\<close> |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4185 |
by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff bit_word_reverse_iff) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4186 |
qed |
65268 | 4187 |
|
37660 | 4188 |
lemma word_roti_0 [simp]: "word_roti 0 w = w" |
72079 | 4189 |
by transfer simp |
37660 | 4190 |
|
65336 | 4191 |
lemma word_roti_add: "word_roti (m + n) w = word_roti m (word_roti n w)" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4192 |
by (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4193 |
(simp add: bit_word_roti_iff nat_less_iff mod_simps ac_simps) |
65268 | 4194 |
|
67118 | 4195 |
lemma word_roti_conv_mod': |
4196 |
"word_roti n w = word_roti (n mod int (size w)) w" |
|
72079 | 4197 |
by transfer simp |
37660 | 4198 |
|
4199 |
lemmas word_roti_conv_mod = word_roti_conv_mod' [unfolded word_size] |
|
4200 |
||
4201 |
||
61799 | 4202 |
subsubsection \<open>"Word rotation commutes with bit-wise operations\<close> |
37660 | 4203 |
|
67408 | 4204 |
\<comment> \<open>using locale to not pollute lemma namespace\<close> |
65268 | 4205 |
locale word_rotate |
37660 | 4206 |
begin |
4207 |
||
4208 |
lemma word_rot_logs: |
|
71149 | 4209 |
"word_rotl n (NOT v) = NOT (word_rotl n v)" |
4210 |
"word_rotr n (NOT v) = NOT (word_rotr n v)" |
|
37660 | 4211 |
"word_rotl n (x AND y) = word_rotl n x AND word_rotl n y" |
4212 |
"word_rotr n (x AND y) = word_rotr n x AND word_rotr n y" |
|
4213 |
"word_rotl n (x OR y) = word_rotl n x OR word_rotl n y" |
|
4214 |
"word_rotr n (x OR y) = word_rotr n x OR word_rotr n y" |
|
4215 |
"word_rotl n (x XOR y) = word_rotl n x XOR word_rotl n y" |
|
65268 | 4216 |
"word_rotr n (x XOR y) = word_rotr n x XOR word_rotr n y" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4217 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4218 |
apply (auto simp add: bit_word_rotl_iff bit_not_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4219 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4220 |
apply (auto simp add: bit_word_rotr_iff bit_not_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4221 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4222 |
apply (auto simp add: bit_word_rotl_iff bit_and_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4223 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4224 |
apply (auto simp add: bit_word_rotr_iff bit_and_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4225 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4226 |
apply (auto simp add: bit_word_rotl_iff bit_or_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4227 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4228 |
apply (auto simp add: bit_word_rotr_iff bit_or_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4229 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4230 |
apply (auto simp add: bit_word_rotl_iff bit_xor_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4231 |
apply (rule bit_word_eqI) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4232 |
apply (auto simp add: bit_word_rotr_iff bit_xor_iff algebra_simps exp_eq_zero_iff not_le) |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4233 |
done |
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4234 |
|
37660 | 4235 |
end |
4236 |
||
4237 |
lemmas word_rot_logs = word_rotate.word_rot_logs |
|
4238 |
||
65336 | 4239 |
lemma word_rotx_0 [simp] : "word_rotr i 0 = 0 \<and> word_rotl i 0 = 0" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4240 |
by transfer simp_all |
37660 | 4241 |
|
4242 |
lemma word_roti_0' [simp] : "word_roti n 0 = 0" |
|
72079 | 4243 |
by transfer simp |
37660 | 4244 |
|
72079 | 4245 |
declare word_roti_eq_word_rotr_word_rotl [simp] |
37660 | 4246 |
|
4247 |
||
61799 | 4248 |
subsection \<open>Maximum machine word\<close> |
37660 | 4249 |
|
4250 |
lemma word_int_cases: |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4251 |
fixes x :: "'a::len word" |
70185 | 4252 |
obtains n where "x = word_of_int n" and "0 \<le> n" and "n < 2^LENGTH('a)" |
37660 | 4253 |
by (cases x rule: word_uint.Abs_cases) (simp add: uints_num) |
4254 |
||
4255 |
lemma word_nat_cases [cases type: word]: |
|
65336 | 4256 |
fixes x :: "'a::len word" |
70185 | 4257 |
obtains n where "x = of_nat n" and "n < 2^LENGTH('a)" |
37660 | 4258 |
by (cases x rule: word_unat.Abs_cases) (simp add: unats_def) |
4259 |
||
71946 | 4260 |
lemma max_word_max [intro!]: "n \<le> max_word" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
4261 |
by (fact word_order.extremum) |
65268 | 4262 |
|
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4263 |
lemma word_of_int_2p_len: "word_of_int (2 ^ LENGTH('a)) = (0::'a::len word)" |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4264 |
by (subst word_uint.Abs_norm [symmetric]) simp |
37660 | 4265 |
|
70185 | 4266 |
lemma word_pow_0: "(2::'a::len word) ^ LENGTH('a) = 0" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
4267 |
by (fact word_exp_length_eq_0) |
37660 | 4268 |
|
4269 |
lemma max_word_wrap: "x + 1 = 0 \<Longrightarrow> x = max_word" |
|
71946 | 4270 |
by (simp add: eq_neg_iff_add_eq_0) |
4271 |
||
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4272 |
lemma max_test_bit: "(max_word::'a::len word) !! n \<longleftrightarrow> n < LENGTH('a)" |
71946 | 4273 |
by (fact nth_minus1) |
4274 |
||
4275 |
lemma word_and_max: "x AND max_word = x" |
|
4276 |
by (fact word_log_esimps) |
|
4277 |
||
4278 |
lemma word_or_max: "x OR max_word = max_word" |
|
4279 |
by (fact word_log_esimps) |
|
37660 | 4280 |
|
65336 | 4281 |
lemma word_ao_dist2: "x AND (y OR z) = x AND y OR x AND z" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4282 |
for x y z :: "'a::len word" |
37660 | 4283 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
4284 |
||
65336 | 4285 |
lemma word_oa_dist2: "x OR y AND z = (x OR y) AND (x OR z)" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4286 |
for x y z :: "'a::len word" |
37660 | 4287 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
4288 |
||
65336 | 4289 |
lemma word_and_not [simp]: "x AND NOT x = 0" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4290 |
for x :: "'a::len word" |
37660 | 4291 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
4292 |
||
65336 | 4293 |
lemma word_or_not [simp]: "x OR NOT x = max_word" |
37660 | 4294 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
4295 |
||
65336 | 4296 |
lemma word_xor_and_or: "x XOR y = x AND NOT y OR NOT x AND y" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4297 |
for x y :: "'a::len word" |
37660 | 4298 |
by (rule word_eqI) (auto simp add: word_ops_nth_size word_size) |
4299 |
||
65336 | 4300 |
lemma shiftr_x_0 [iff]: "x >> 0 = x" |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4301 |
for x :: "'a::len word" |
72088
a36db1c8238e
separation of reversed bit lists from other material
haftmann
parents:
72083
diff
changeset
|
4302 |
by transfer simp |
37660 | 4303 |
|
65336 | 4304 |
lemma shiftl_x_0 [simp]: "x << 0 = x" |
4305 |
for x :: "'a::len word" |
|
37660 | 4306 |
by (simp add: shiftl_t2n) |
4307 |
||
65336 | 4308 |
lemma shiftl_1 [simp]: "(1::'a::len word) << n = 2^n" |
37660 | 4309 |
by (simp add: shiftl_t2n) |
4310 |
||
65336 | 4311 |
lemma uint_lt_0 [simp]: "uint x < 0 = False" |
37660 | 4312 |
by (simp add: linorder_not_less) |
4313 |
||
65336 | 4314 |
lemma shiftr1_1 [simp]: "shiftr1 (1::'a::len word) = 0" |
72079 | 4315 |
by transfer simp |
37660 | 4316 |
|
65336 | 4317 |
lemma shiftr_1[simp]: "(1::'a::len word) >> n = (if n = 0 then 1 else 0)" |
37660 | 4318 |
by (induct n) (auto simp: shiftr_def) |
4319 |
||
65336 | 4320 |
lemma word_less_1 [simp]: "x < 1 \<longleftrightarrow> x = 0" |
4321 |
for x :: "'a::len word" |
|
37660 | 4322 |
by (simp add: word_less_nat_alt unat_0_iff) |
4323 |
||
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4324 |
lemma map_nth_0 [simp]: "map ((!!) (0::'a::len word)) xs = replicate (length xs) False" |
37660 | 4325 |
by (induct xs) auto |
4326 |
||
4327 |
lemma uint_plus_if_size: |
|
65268 | 4328 |
"uint (x + y) = |
65336 | 4329 |
(if uint x + uint y < 2^size x |
4330 |
then uint x + uint y |
|
4331 |
else uint x + uint y - 2^size x)" |
|
4332 |
by (simp add: word_arith_wis int_word_uint mod_add_if_z word_size) |
|
37660 | 4333 |
|
4334 |
lemma unat_plus_if_size: |
|
65363 | 4335 |
"unat (x + y) = |
65336 | 4336 |
(if unat x + unat y < 2^size x |
4337 |
then unat x + unat y |
|
4338 |
else unat x + unat y - 2^size x)" |
|
65363 | 4339 |
for x y :: "'a::len word" |
37660 | 4340 |
apply (subst word_arith_nat_defs) |
4341 |
apply (subst unat_of_nat) |
|
71997 | 4342 |
apply (auto simp add: not_less word_size) |
4343 |
apply (metis not_le unat_plus_if' unat_word_ariths(1)) |
|
37660 | 4344 |
done |
4345 |
||
65336 | 4346 |
lemma word_neq_0_conv: "w \<noteq> 0 \<longleftrightarrow> 0 < w" |
4347 |
for w :: "'a::len word" |
|
4348 |
by (simp add: word_gt_0) |
|
4349 |
||
4350 |
lemma max_lt: "unat (max a b div c) = unat (max a b) div unat c" |
|
4351 |
for c :: "'a::len word" |
|
55818 | 4352 |
by (fact unat_div) |
37660 | 4353 |
|
4354 |
lemma uint_sub_if_size: |
|
65268 | 4355 |
"uint (x - y) = |
65336 | 4356 |
(if uint y \<le> uint x |
4357 |
then uint x - uint y |
|
4358 |
else uint x - uint y + 2^size x)" |
|
4359 |
by (simp add: word_arith_wis int_word_uint mod_sub_if_z word_size) |
|
4360 |
||
4361 |
lemma unat_sub: "b \<le> a \<Longrightarrow> unat (a - b) = unat a - unat b" |
|
72079 | 4362 |
apply transfer |
4363 |
apply (simp flip: nat_diff_distrib) |
|
4364 |
apply (metis minus_word.abs_eq uint_sub_lem word_ubin.eq_norm) |
|
4365 |
done |
|
37660 | 4366 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4367 |
lemmas word_less_sub1_numberof [simp] = word_less_sub1 [of "numeral w"] for w |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4368 |
lemmas word_le_sub1_numberof [simp] = word_le_sub1 [of "numeral w"] for w |
65268 | 4369 |
|
70185 | 4370 |
lemma word_of_int_minus: "word_of_int (2^LENGTH('a) - i) = (word_of_int (-i)::'a::len word)" |
37660 | 4371 |
proof - |
70185 | 4372 |
have *: "2^LENGTH('a) - i = -i + 2^LENGTH('a)" |
65336 | 4373 |
by simp |
37660 | 4374 |
show ?thesis |
65336 | 4375 |
apply (subst *) |
37660 | 4376 |
apply (subst word_uint.Abs_norm [symmetric], subst mod_add_self2) |
4377 |
apply simp |
|
4378 |
done |
|
4379 |
qed |
|
65268 | 4380 |
|
4381 |
lemmas word_of_int_inj = |
|
37660 | 4382 |
word_uint.Abs_inject [unfolded uints_num, simplified] |
4383 |
||
65336 | 4384 |
lemma word_le_less_eq: "x \<le> y \<longleftrightarrow> x = y \<or> x < y" |
4385 |
for x y :: "'z::len word" |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4386 |
by (auto simp add: order_class.le_less) |
37660 | 4387 |
|
4388 |
lemma mod_plus_cong: |
|
65336 | 4389 |
fixes b b' :: int |
4390 |
assumes 1: "b = b'" |
|
4391 |
and 2: "x mod b' = x' mod b'" |
|
4392 |
and 3: "y mod b' = y' mod b'" |
|
4393 |
and 4: "x' + y' = z'" |
|
37660 | 4394 |
shows "(x + y) mod b = z' mod b'" |
4395 |
proof - |
|
4396 |
from 1 2[symmetric] 3[symmetric] have "(x + y) mod b = (x' mod b' + y' mod b') mod b'" |
|
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
4397 |
by (simp add: mod_add_eq) |
37660 | 4398 |
also have "\<dots> = (x' + y') mod b'" |
64593
50c715579715
reoriented congruence rules in non-explosive direction
haftmann
parents:
64243
diff
changeset
|
4399 |
by (simp add: mod_add_eq) |
65336 | 4400 |
finally show ?thesis |
4401 |
by (simp add: 4) |
|
37660 | 4402 |
qed |
4403 |
||
4404 |
lemma mod_minus_cong: |
|
65336 | 4405 |
fixes b b' :: int |
4406 |
assumes "b = b'" |
|
4407 |
and "x mod b' = x' mod b'" |
|
4408 |
and "y mod b' = y' mod b'" |
|
4409 |
and "x' - y' = z'" |
|
37660 | 4410 |
shows "(x - y) mod b = z' mod b'" |
65336 | 4411 |
using assms [symmetric] by (auto intro: mod_diff_cong) |
4412 |
||
65363 | 4413 |
lemma word_induct_less: "P 0 \<Longrightarrow> (\<And>n. n < m \<Longrightarrow> P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P m" |
65336 | 4414 |
for P :: "'a::len word \<Rightarrow> bool" |
37660 | 4415 |
apply (cases m) |
4416 |
apply atomize |
|
4417 |
apply (erule rev_mp)+ |
|
4418 |
apply (rule_tac x=m in spec) |
|
4419 |
apply (induct_tac n) |
|
4420 |
apply simp |
|
4421 |
apply clarsimp |
|
4422 |
apply (erule impE) |
|
4423 |
apply clarsimp |
|
4424 |
apply (erule_tac x=n in allE) |
|
4425 |
apply (erule impE) |
|
4426 |
apply (simp add: unat_arith_simps) |
|
4427 |
apply (clarsimp simp: unat_of_nat) |
|
4428 |
apply simp |
|
4429 |
apply (erule_tac x="of_nat na" in allE) |
|
4430 |
apply (erule impE) |
|
4431 |
apply (simp add: unat_arith_simps) |
|
4432 |
apply (clarsimp simp: unat_of_nat) |
|
4433 |
apply simp |
|
4434 |
done |
|
65268 | 4435 |
|
65363 | 4436 |
lemma word_induct: "P 0 \<Longrightarrow> (\<And>n. P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P m" |
65336 | 4437 |
for P :: "'a::len word \<Rightarrow> bool" |
4438 |
by (erule word_induct_less) simp |
|
4439 |
||
65363 | 4440 |
lemma word_induct2 [induct type]: "P 0 \<Longrightarrow> (\<And>n. 1 + n \<noteq> 0 \<Longrightarrow> P n \<Longrightarrow> P (1 + n)) \<Longrightarrow> P n" |
65336 | 4441 |
for P :: "'b::len word \<Rightarrow> bool" |
4442 |
apply (rule word_induct) |
|
4443 |
apply simp |
|
4444 |
apply (case_tac "1 + n = 0") |
|
4445 |
apply auto |
|
37660 | 4446 |
done |
4447 |
||
55816
e8dd03241e86
cursory polishing: tuned proofs, tuned symbols, tuned headings
haftmann
parents:
55415
diff
changeset
|
4448 |
|
61799 | 4449 |
subsection \<open>Recursion combinator for words\<close> |
46010 | 4450 |
|
54848 | 4451 |
definition word_rec :: "'a \<Rightarrow> ('b::len word \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'b word \<Rightarrow> 'a" |
65336 | 4452 |
where "word_rec forZero forSuc n = rec_nat forZero (forSuc \<circ> of_nat) (unat n)" |
37660 | 4453 |
|
4454 |
lemma word_rec_0: "word_rec z s 0 = z" |
|
4455 |
by (simp add: word_rec_def) |
|
4456 |
||
65363 | 4457 |
lemma word_rec_Suc: "1 + n \<noteq> 0 \<Longrightarrow> word_rec z s (1 + n) = s n (word_rec z s n)" |
4458 |
for n :: "'a::len word" |
|
71997 | 4459 |
apply (auto simp add: word_rec_def unat_word_ariths) |
4460 |
apply (metis (mono_tags, lifting) old.nat.simps(7) unatSuc word_unat.Rep_inverse word_unat.eq_norm word_unat.td_th) |
|
37660 | 4461 |
done |
4462 |
||
65363 | 4463 |
lemma word_rec_Pred: "n \<noteq> 0 \<Longrightarrow> word_rec z s n = s (n - 1) (word_rec z s (n - 1))" |
37660 | 4464 |
apply (rule subst[where t="n" and s="1 + (n - 1)"]) |
4465 |
apply simp |
|
4466 |
apply (subst word_rec_Suc) |
|
4467 |
apply simp |
|
4468 |
apply simp |
|
4469 |
done |
|
4470 |
||
65336 | 4471 |
lemma word_rec_in: "f (word_rec z (\<lambda>_. f) n) = word_rec (f z) (\<lambda>_. f) n" |
37660 | 4472 |
by (induct n) (simp_all add: word_rec_0 word_rec_Suc) |
4473 |
||
67399 | 4474 |
lemma word_rec_in2: "f n (word_rec z f n) = word_rec (f 0 z) (f \<circ> (+) 1) n" |
37660 | 4475 |
by (induct n) (simp_all add: word_rec_0 word_rec_Suc) |
4476 |
||
65268 | 4477 |
lemma word_rec_twice: |
67399 | 4478 |
"m \<le> n \<Longrightarrow> word_rec z f n = word_rec (word_rec z f (n - m)) (f \<circ> (+) (n - m)) m" |
65336 | 4479 |
apply (erule rev_mp) |
4480 |
apply (rule_tac x=z in spec) |
|
4481 |
apply (rule_tac x=f in spec) |
|
4482 |
apply (induct n) |
|
4483 |
apply (simp add: word_rec_0) |
|
4484 |
apply clarsimp |
|
4485 |
apply (rule_tac t="1 + n - m" and s="1 + (n - m)" in subst) |
|
4486 |
apply simp |
|
4487 |
apply (case_tac "1 + (n - m) = 0") |
|
4488 |
apply (simp add: word_rec_0) |
|
4489 |
apply (rule_tac f = "word_rec a b" for a b in arg_cong) |
|
4490 |
apply (rule_tac t="m" and s="m + (1 + (n - m))" in subst) |
|
4491 |
apply simp |
|
4492 |
apply (simp (no_asm_use)) |
|
4493 |
apply (simp add: word_rec_Suc word_rec_in2) |
|
4494 |
apply (erule impE) |
|
4495 |
apply uint_arith |
|
67399 | 4496 |
apply (drule_tac x="x \<circ> (+) 1" in spec) |
65336 | 4497 |
apply (drule_tac x="x 0 xa" in spec) |
37660 | 4498 |
apply simp |
65336 | 4499 |
apply (rule_tac t="\<lambda>a. x (1 + (n - m + a))" and s="\<lambda>a. x (1 + (n - m) + a)" in subst) |
4500 |
apply (clarsimp simp add: fun_eq_iff) |
|
4501 |
apply (rule_tac t="(1 + (n - m + xb))" and s="1 + (n - m) + xb" in subst) |
|
4502 |
apply simp |
|
4503 |
apply (rule refl) |
|
4504 |
apply (rule refl) |
|
4505 |
done |
|
37660 | 4506 |
|
4507 |
lemma word_rec_id: "word_rec z (\<lambda>_. id) n = z" |
|
4508 |
by (induct n) (auto simp add: word_rec_0 word_rec_Suc) |
|
4509 |
||
4510 |
lemma word_rec_id_eq: "\<forall>m < n. f m = id \<Longrightarrow> word_rec z f n = z" |
|
65336 | 4511 |
apply (erule rev_mp) |
4512 |
apply (induct n) |
|
4513 |
apply (auto simp add: word_rec_0 word_rec_Suc) |
|
4514 |
apply (drule spec, erule mp) |
|
4515 |
apply uint_arith |
|
4516 |
apply (drule_tac x=n in spec, erule impE) |
|
4517 |
apply uint_arith |
|
4518 |
apply simp |
|
4519 |
done |
|
37660 | 4520 |
|
65268 | 4521 |
lemma word_rec_max: |
58410
6d46ad54a2ab
explicit separation of signed and unsigned numerals using existing lexical categories num and xnum
haftmann
parents:
58061
diff
changeset
|
4522 |
"\<forall>m\<ge>n. m \<noteq> - 1 \<longrightarrow> f m = id \<Longrightarrow> word_rec z f (- 1) = word_rec z f n" |
65336 | 4523 |
apply (subst word_rec_twice[where n="-1" and m="-1 - n"]) |
4524 |
apply simp |
|
4525 |
apply simp |
|
4526 |
apply (rule word_rec_id_eq) |
|
4527 |
apply clarsimp |
|
4528 |
apply (drule spec, rule mp, erule mp) |
|
4529 |
apply (rule word_plus_mono_right2[OF _ order_less_imp_le]) |
|
4530 |
prefer 2 |
|
4531 |
apply assumption |
|
4532 |
apply simp |
|
4533 |
apply (erule contrapos_pn) |
|
4534 |
apply simp |
|
4535 |
apply (drule arg_cong[where f="\<lambda>x. x - n"]) |
|
4536 |
apply simp |
|
4537 |
done |
|
4538 |
||
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4539 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4540 |
subsection \<open>More\<close> |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4541 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4542 |
lemma test_bit_1' [simp]: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4543 |
"(1 :: 'a :: len word) !! n \<longleftrightarrow> 0 < LENGTH('a) \<and> n = 0" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
4544 |
by simp |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4545 |
|
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
4546 |
lemma shiftl0: |
71954
13bb3f5cdc5b
pragmatically ruled out word types of length zero: a bit string with no bits is not bit string at all
haftmann
parents:
71953
diff
changeset
|
4547 |
"x << 0 = (x :: 'a :: len word)" |
71957
3e162c63371a
build bit operations on word on library theory on bit operations
haftmann
parents:
71955
diff
changeset
|
4548 |
by (fact shiftl_x_0) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4549 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4550 |
lemma mask_1: "mask 1 = 1" |
72079 | 4551 |
by transfer (simp add: min_def mask_Suc_exp) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4552 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4553 |
lemma mask_Suc_0: "mask (Suc 0) = 1" |
72079 | 4554 |
using mask_1 by simp |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4555 |
|
72082 | 4556 |
lemma mask_numeral: "mask (numeral n) = 2 * mask (pred_numeral n) + (1 :: 'a::len word)" |
72079 | 4557 |
by (simp add: mask_Suc_rec numeral_eq_Suc) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4558 |
|
72128 | 4559 |
lemma bin_last_bintrunc: "bin_last (take_bit l n) = (l > 0 \<and> bin_last n)" |
72079 | 4560 |
by simp |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4561 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4562 |
lemma word_and_1: |
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4563 |
"n AND 1 = (if n !! 0 then 1 else 0)" for n :: "_ word" |
72079 | 4564 |
by (rule bit_word_eqI) (auto simp add: bit_and_iff test_bit_eq_bit bit_1_iff intro: gr0I) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4565 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4566 |
lemma bintrunc_shiftl: |
72128 | 4567 |
"take_bit n (m << i) = take_bit (n - i) m << i" |
4568 |
for m :: int |
|
72079 | 4569 |
by (rule bit_eqI) (auto simp add: bit_take_bit_iff) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4570 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4571 |
lemma uint_shiftl: |
72128 | 4572 |
"uint (n << i) = take_bit (size n) (uint n << i)" |
72079 | 4573 |
by transfer (simp add: push_bit_take_bit shiftl_eq_push_bit) |
70183
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4574 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4575 |
|
3ea80c950023
incorporated various material from the AFP into the distribution
haftmann
parents:
70175
diff
changeset
|
4576 |
subsection \<open>Misc\<close> |
37660 | 4577 |
|
69605 | 4578 |
ML_file \<open>Tools/word_lib.ML\<close> |
4579 |
ML_file \<open>Tools/smt_word.ML\<close> |
|
36899
bcd6fce5bf06
layered SMT setup, adapted SMT clients, added further tests, made Z3 proof abstraction configurable
boehmes
parents:
35049
diff
changeset
|
4580 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4581 |
hide_const (open) Word |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46962
diff
changeset
|
4582 |
|
41060
4199fdcfa3c0
moved smt_word.ML into the directory of the Word library
boehmes
parents:
40827
diff
changeset
|
4583 |
end |