| author | paulson <lp15@cam.ac.uk> | 
| Fri, 28 Feb 2025 13:50:18 +0000 | |
| changeset 82218 | cbf9f856d3e0 | 
| parent 81876 | ac0716ca151b | 
| child 82289 | 26fbbf43863b | 
| permissions | -rw-r--r-- | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1  | 
(* Author: Florian Haftmann, TUM  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
2  | 
*)  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
3  | 
|
| 71956 | 4  | 
section \<open>Bit operations in suitable algebraic structures\<close>  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
5  | 
|
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
6  | 
theory Bit_Operations  | 
| 74101 | 7  | 
imports Presburger Groups_List  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
8  | 
begin  | 
| 74101 | 9  | 
|
10  | 
subsection \<open>Abstract bit structures\<close>  | 
|
11  | 
||
| 
79541
 
4f40225936d1
common type class for trivial properties on div/mod
 
haftmann 
parents: 
79531 
diff
changeset
 | 
12  | 
class semiring_bits = semiring_parity + semiring_modulo_trivial +  | 
| 
79480
 
c7cb1bf6efa0
consolidated name of lemma analogously to nat/int/word_bit_induct
 
haftmann 
parents: 
79117 
diff
changeset
 | 
13  | 
assumes bit_induct [case_names stable rec]:  | 
| 74101 | 14  | 
\<open>(\<And>a. a div 2 = a \<Longrightarrow> P a)  | 
15  | 
\<Longrightarrow> (\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a))  | 
|
16  | 
\<Longrightarrow> P a\<close>  | 
|
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
17  | 
assumes bits_mod_div_trivial [simp]: \<open>a mod b div b = 0\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
18  | 
and half_div_exp_eq: \<open>a div 2 div 2 ^ n = a div 2 ^ Suc n\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
19  | 
and even_double_div_exp_iff: \<open>2 ^ Suc n \<noteq> 0 \<Longrightarrow> even (2 * a div 2 ^ Suc n) \<longleftrightarrow> even (a div 2 ^ n)\<close>  | 
| 74101 | 20  | 
fixes bit :: \<open>'a \<Rightarrow> nat \<Rightarrow> bool\<close>  | 
21  | 
assumes bit_iff_odd: \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close>  | 
|
22  | 
begin  | 
|
23  | 
||
24  | 
text \<open>  | 
|
25  | 
Having \<^const>\<open>bit\<close> as definitional class operation  | 
|
26  | 
takes into account that specific instances can be implemented  | 
|
27  | 
differently wrt. code generation.  | 
|
28  | 
\<close>  | 
|
29  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
30  | 
lemma half_1 [simp]:  | 
| 74101 | 31  | 
\<open>1 div 2 = 0\<close>  | 
| 79488 | 32  | 
using even_half_succ_eq [of 0] by simp  | 
| 74101 | 33  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
34  | 
lemma div_exp_eq_funpow_half:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
35  | 
\<open>a div 2 ^ n = ((\<lambda>a. a div 2) ^^ n) a\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
36  | 
proof -  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
37  | 
have \<open>((\<lambda>a. a div 2) ^^ n) = (\<lambda>a. a div 2 ^ n)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
38  | 
by (induction n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
39  | 
(simp_all del: funpow.simps power.simps add: power_0 funpow_Suc_right half_div_exp_eq)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
40  | 
then show ?thesis  | 
| 79481 | 41  | 
by simp  | 
42  | 
qed  | 
|
43  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
44  | 
lemma div_exp_eq:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
45  | 
\<open>a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
46  | 
by (simp add: div_exp_eq_funpow_half Groups.add.commute [of m] funpow_add)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
47  | 
|
| 75085 | 48  | 
lemma bit_0:  | 
| 74101 | 49  | 
\<open>bit a 0 \<longleftrightarrow> odd a\<close>  | 
50  | 
by (simp add: bit_iff_odd)  | 
|
51  | 
||
52  | 
lemma bit_Suc:  | 
|
53  | 
\<open>bit a (Suc n) \<longleftrightarrow> bit (a div 2) n\<close>  | 
|
54  | 
using div_exp_eq [of a 1 n] by (simp add: bit_iff_odd)  | 
|
55  | 
||
56  | 
lemma bit_rec:  | 
|
57  | 
\<open>bit a n \<longleftrightarrow> (if n = 0 then odd a else bit (a div 2) (n - 1))\<close>  | 
|
| 75085 | 58  | 
by (cases n) (simp_all add: bit_Suc bit_0)  | 
| 74101 | 59  | 
|
60  | 
context  | 
|
61  | 
fixes a  | 
|
62  | 
assumes stable: \<open>a div 2 = a\<close>  | 
|
63  | 
begin  | 
|
64  | 
||
65  | 
lemma bits_stable_imp_add_self:  | 
|
66  | 
\<open>a + a mod 2 = 0\<close>  | 
|
67  | 
proof -  | 
|
68  | 
have \<open>a div 2 * 2 + a mod 2 = a\<close>  | 
|
69  | 
by (fact div_mult_mod_eq)  | 
|
70  | 
then have \<open>a * 2 + a mod 2 = a\<close>  | 
|
71  | 
by (simp add: stable)  | 
|
72  | 
then show ?thesis  | 
|
73  | 
by (simp add: mult_2_right ac_simps)  | 
|
74  | 
qed  | 
|
75  | 
||
76  | 
lemma stable_imp_bit_iff_odd:  | 
|
77  | 
\<open>bit a n \<longleftrightarrow> odd a\<close>  | 
|
| 75085 | 78  | 
by (induction n) (simp_all add: stable bit_Suc bit_0)  | 
| 74101 | 79  | 
|
80  | 
end  | 
|
81  | 
||
| 79585 | 82  | 
lemma bit_iff_odd_imp_stable:  | 
| 74101 | 83  | 
\<open>a div 2 = a\<close> if \<open>\<And>n. bit a n \<longleftrightarrow> odd a\<close>  | 
| 
79480
 
c7cb1bf6efa0
consolidated name of lemma analogously to nat/int/word_bit_induct
 
haftmann 
parents: 
79117 
diff
changeset
 | 
84  | 
using that proof (induction a rule: bit_induct)  | 
| 74101 | 85  | 
case (stable a)  | 
86  | 
then show ?case  | 
|
87  | 
by simp  | 
|
88  | 
next  | 
|
89  | 
case (rec a b)  | 
|
90  | 
from rec.prems [of 1] have [simp]: \<open>b = odd a\<close>  | 
|
| 75085 | 91  | 
by (simp add: rec.hyps bit_Suc bit_0)  | 
| 74101 | 92  | 
from rec.hyps have hyp: \<open>(of_bool (odd a) + 2 * a) div 2 = a\<close>  | 
93  | 
by simp  | 
|
94  | 
have \<open>bit a n \<longleftrightarrow> odd a\<close> for n  | 
|
95  | 
using rec.prems [of \<open>Suc n\<close>] by (simp add: hyp bit_Suc)  | 
|
96  | 
then have \<open>a div 2 = a\<close>  | 
|
97  | 
by (rule rec.IH)  | 
|
98  | 
then have \<open>of_bool (odd a) + 2 * a = 2 * (a div 2) + of_bool (odd a)\<close>  | 
|
99  | 
by (simp add: ac_simps)  | 
|
100  | 
also have \<open>\<dots> = a\<close>  | 
|
101  | 
using mult_div_mod_eq [of 2 a]  | 
|
102  | 
by (simp add: of_bool_odd_eq_mod_2)  | 
|
103  | 
finally show ?case  | 
|
104  | 
using \<open>a div 2 = a\<close> by (simp add: hyp)  | 
|
105  | 
qed  | 
|
106  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
107  | 
lemma even_succ_div_exp [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
108  | 
\<open>(1 + a) div 2 ^ n = a div 2 ^ n\<close> if \<open>even a\<close> and \<open>n > 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
109  | 
proof (cases n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
110  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
111  | 
with that show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
112  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
113  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
114  | 
case (Suc n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
115  | 
with \<open>even a\<close> have \<open>(1 + a) div 2 ^ Suc n = a div 2 ^ Suc n\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
116  | 
proof (induction n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
117  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
118  | 
then show ?case  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
119  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
120  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
121  | 
case (Suc n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
122  | 
then show ?case  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
123  | 
using div_exp_eq [of _ 1 \<open>Suc n\<close>, symmetric]  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
124  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
125  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
126  | 
with Suc show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
127  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
128  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
129  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
130  | 
lemma even_succ_mod_exp [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
131  | 
\<open>(1 + a) mod 2 ^ n = 1 + (a mod 2 ^ n)\<close> if \<open>even a\<close> and \<open>n > 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
132  | 
using div_mult_mod_eq [of \<open>1 + a\<close> \<open>2 ^ n\<close>] div_mult_mod_eq [of a \<open>2 ^ n\<close>] that  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
133  | 
by simp (metis (full_types) add.left_commute add_left_imp_eq)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
134  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
135  | 
lemma half_numeral_Bit1_eq [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
136  | 
\<open>numeral (num.Bit1 m) div 2 = numeral (num.Bit0 m) div 2\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
137  | 
using even_half_succ_eq [of \<open>2 * numeral m\<close>]  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
138  | 
by simp  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
139  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
140  | 
lemma double_half_numeral_Bit_0_eq [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
141  | 
\<open>2 * (numeral (num.Bit0 m) div 2) = numeral (num.Bit0 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
142  | 
\<open>(numeral (num.Bit0 m) div 2) * 2 = numeral (num.Bit0 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
143  | 
using mod_mult_div_eq [of \<open>numeral (Num.Bit0 m)\<close> 2]  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
144  | 
by (simp_all add: mod2_eq_if ac_simps)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
145  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
146  | 
named_theorems bit_simps \<open>Simplification rules for \<^const>\<open>bit\<close>\<close>  | 
| 74101 | 147  | 
|
| 79017 | 148  | 
definition possible_bit :: \<open>'a itself \<Rightarrow> nat \<Rightarrow> bool\<close>  | 
149  | 
  where \<open>possible_bit TYPE('a) n \<longleftrightarrow> 2 ^ n \<noteq> 0\<close>
 | 
|
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
150  | 
\<comment> \<open>This auxiliary avoids non-termination with extensionality.\<close>  | 
| 79017 | 151  | 
|
152  | 
lemma possible_bit_0 [simp]:  | 
|
153  | 
  \<open>possible_bit TYPE('a) 0\<close>
 | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
154  | 
by (simp add: possible_bit_def)  | 
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
155  | 
|
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
156  | 
lemma fold_possible_bit:  | 
| 79017 | 157  | 
  \<open>2 ^ n = 0 \<longleftrightarrow> \<not> possible_bit TYPE('a) n\<close>
 | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
158  | 
by (simp add: possible_bit_def)  | 
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
159  | 
|
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
160  | 
lemma bit_imp_possible_bit:  | 
| 79017 | 161  | 
  \<open>possible_bit TYPE('a) n\<close> if \<open>bit a n\<close>
 | 
| 80758 | 162  | 
by (rule ccontr) (use that in \<open>auto simp: bit_iff_odd possible_bit_def\<close>)  | 
| 79017 | 163  | 
|
164  | 
lemma impossible_bit:  | 
|
165  | 
  \<open>\<not> bit a n\<close> if \<open>\<not> possible_bit TYPE('a) n\<close>
 | 
|
166  | 
using that by (blast dest: bit_imp_possible_bit)  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
167  | 
|
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
168  | 
lemma possible_bit_less_imp:  | 
| 79017 | 169  | 
  \<open>possible_bit TYPE('a) j\<close> if \<open>possible_bit TYPE('a) i\<close> \<open>j \<le> i\<close>
 | 
170  | 
using power_add [of 2 j \<open>i - j\<close>] that mult_not_zero [of \<open>2 ^ j\<close> \<open>2 ^ (i - j)\<close>]  | 
|
171  | 
by (simp add: possible_bit_def)  | 
|
172  | 
||
173  | 
lemma possible_bit_min [simp]:  | 
|
174  | 
  \<open>possible_bit TYPE('a) (min i j) \<longleftrightarrow> possible_bit TYPE('a) i \<or> possible_bit TYPE('a) j\<close>
 | 
|
| 80758 | 175  | 
by (auto simp: min_def elim: possible_bit_less_imp)  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
176  | 
|
| 74101 | 177  | 
lemma bit_eqI:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
178  | 
  \<open>a = b\<close> if \<open>\<And>n. possible_bit TYPE('a) n \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close>
 | 
| 74101 | 179  | 
proof -  | 
180  | 
have \<open>bit a n \<longleftrightarrow> bit b n\<close> for n  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
181  | 
  proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
182  | 
case False  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
183  | 
then show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
184  | 
by (simp add: impossible_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
185  | 
next  | 
| 74101 | 186  | 
case True  | 
187  | 
then show ?thesis  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
188  | 
by (rule that)  | 
| 74101 | 189  | 
qed  | 
| 
79480
 
c7cb1bf6efa0
consolidated name of lemma analogously to nat/int/word_bit_induct
 
haftmann 
parents: 
79117 
diff
changeset
 | 
190  | 
then show ?thesis proof (induction a arbitrary: b rule: bit_induct)  | 
| 74101 | 191  | 
case (stable a)  | 
192  | 
from stable(2) [of 0] have **: \<open>even b \<longleftrightarrow> even a\<close>  | 
|
| 75085 | 193  | 
by (simp add: bit_0)  | 
| 74101 | 194  | 
have \<open>b div 2 = b\<close>  | 
| 79585 | 195  | 
proof (rule bit_iff_odd_imp_stable)  | 
| 74101 | 196  | 
fix n  | 
197  | 
from stable have *: \<open>bit b n \<longleftrightarrow> bit a n\<close>  | 
|
198  | 
by simp  | 
|
199  | 
also have \<open>bit a n \<longleftrightarrow> odd a\<close>  | 
|
200  | 
using stable by (simp add: stable_imp_bit_iff_odd)  | 
|
201  | 
finally show \<open>bit b n \<longleftrightarrow> odd b\<close>  | 
|
202  | 
by (simp add: **)  | 
|
203  | 
qed  | 
|
204  | 
from ** have \<open>a mod 2 = b mod 2\<close>  | 
|
205  | 
by (simp add: mod2_eq_if)  | 
|
206  | 
then have \<open>a mod 2 + (a + b) = b mod 2 + (a + b)\<close>  | 
|
207  | 
by simp  | 
|
208  | 
then have \<open>a + a mod 2 + b = b + b mod 2 + a\<close>  | 
|
209  | 
by (simp add: ac_simps)  | 
|
210  | 
with \<open>a div 2 = a\<close> \<open>b div 2 = b\<close> show ?case  | 
|
211  | 
by (simp add: bits_stable_imp_add_self)  | 
|
212  | 
next  | 
|
213  | 
case (rec a p)  | 
|
214  | 
from rec.prems [of 0] have [simp]: \<open>p = odd b\<close>  | 
|
| 75085 | 215  | 
by (simp add: bit_0)  | 
| 74101 | 216  | 
from rec.hyps have \<open>bit a n \<longleftrightarrow> bit (b div 2) n\<close> for n  | 
217  | 
using rec.prems [of \<open>Suc n\<close>] by (simp add: bit_Suc)  | 
|
218  | 
then have \<open>a = b div 2\<close>  | 
|
219  | 
by (rule rec.IH)  | 
|
220  | 
then have \<open>2 * a = 2 * (b div 2)\<close>  | 
|
221  | 
by simp  | 
|
222  | 
then have \<open>b mod 2 + 2 * a = b mod 2 + 2 * (b div 2)\<close>  | 
|
223  | 
by simp  | 
|
224  | 
also have \<open>\<dots> = b\<close>  | 
|
225  | 
by (fact mod_mult_div_eq)  | 
|
226  | 
finally show ?case  | 
|
| 80758 | 227  | 
by (auto simp: mod2_eq_if)  | 
| 74101 | 228  | 
qed  | 
229  | 
qed  | 
|
230  | 
||
231  | 
lemma bit_eq_rec:  | 
|
232  | 
\<open>a = b \<longleftrightarrow> (even a \<longleftrightarrow> even b) \<and> a div 2 = b div 2\<close> (is \<open>?P = ?Q\<close>)  | 
|
233  | 
proof  | 
|
234  | 
assume ?P  | 
|
235  | 
then show ?Q  | 
|
236  | 
by simp  | 
|
237  | 
next  | 
|
238  | 
assume ?Q  | 
|
239  | 
then have \<open>even a \<longleftrightarrow> even b\<close> and \<open>a div 2 = b div 2\<close>  | 
|
240  | 
by simp_all  | 
|
241  | 
show ?P  | 
|
242  | 
proof (rule bit_eqI)  | 
|
243  | 
fix n  | 
|
244  | 
show \<open>bit a n \<longleftrightarrow> bit b n\<close>  | 
|
245  | 
proof (cases n)  | 
|
246  | 
case 0  | 
|
247  | 
with \<open>even a \<longleftrightarrow> even b\<close> show ?thesis  | 
|
| 75085 | 248  | 
by (simp add: bit_0)  | 
| 74101 | 249  | 
next  | 
250  | 
case (Suc n)  | 
|
251  | 
moreover from \<open>a div 2 = b div 2\<close> have \<open>bit (a div 2) n = bit (b div 2) n\<close>  | 
|
252  | 
by simp  | 
|
253  | 
ultimately show ?thesis  | 
|
254  | 
by (simp add: bit_Suc)  | 
|
255  | 
qed  | 
|
256  | 
qed  | 
|
257  | 
qed  | 
|
258  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
259  | 
lemma bit_eq_iff:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
260  | 
  \<open>a = b \<longleftrightarrow> (\<forall>n. possible_bit TYPE('a) n \<longrightarrow> bit a n \<longleftrightarrow> bit b n)\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
261  | 
by (auto intro: bit_eqI simp add: possible_bit_def)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
262  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
263  | 
lemma bit_0_eq [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
264  | 
\<open>bit 0 = \<bottom>\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
265  | 
proof -  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
266  | 
have \<open>0 div 2 ^ n = 0\<close> for n  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
267  | 
unfolding div_exp_eq_funpow_half by (induction n) simp_all  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
268  | 
then show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
269  | 
by (simp add: fun_eq_iff bit_iff_odd)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
270  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
271  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
272  | 
lemma bit_double_Suc_iff:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
273  | 
  \<open>bit (2 * a) (Suc n) \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit a n\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
274  | 
using even_double_div_exp_iff [of n a]  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
275  | 
  by (cases \<open>possible_bit TYPE('a) (Suc n)\<close>)
 | 
| 80758 | 276  | 
(auto simp: bit_iff_odd possible_bit_def)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
277  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
278  | 
lemma bit_double_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
279  | 
  \<open>bit (2 * a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> 0 \<and> bit a (n - 1)\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
280  | 
by (cases n) (simp_all add: bit_0 bit_double_Suc_iff)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
281  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
282  | 
lemma even_bit_succ_iff:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
283  | 
\<open>bit (1 + a) n \<longleftrightarrow> bit a n \<or> n = 0\<close> if \<open>even a\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
284  | 
using that by (cases \<open>n = 0\<close>) (simp_all add: bit_iff_odd)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
285  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
286  | 
lemma odd_bit_iff_bit_pred:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
287  | 
\<open>bit a n \<longleftrightarrow> bit (a - 1) n \<or> n = 0\<close> if \<open>odd a\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
288  | 
proof -  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
289  | 
from \<open>odd a\<close> obtain b where \<open>a = 2 * b + 1\<close> ..  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
290  | 
moreover have \<open>bit (2 * b) n \<or> n = 0 \<longleftrightarrow> bit (1 + 2 * b) n\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
291  | 
using even_bit_succ_iff by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
292  | 
ultimately show ?thesis by (simp add: ac_simps)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
293  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
294  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
295  | 
lemma bit_exp_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
296  | 
  \<open>bit (2 ^ m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n = m\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
297  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
298  | 
case False  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
299  | 
then show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
300  | 
by (simp add: impossible_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
301  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
302  | 
case True  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
303  | 
then show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
304  | 
proof (induction n arbitrary: m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
305  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
306  | 
show ?case  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
307  | 
by (simp add: bit_0)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
308  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
309  | 
case (Suc n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
310  | 
    then have \<open>possible_bit TYPE('a) n\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
311  | 
by (simp add: possible_bit_less_imp)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
312  | 
show ?case  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
313  | 
proof (cases m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
314  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
315  | 
then show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
316  | 
by (simp add: bit_Suc)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
317  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
318  | 
case (Suc m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
319  | 
      with Suc.IH [of m] \<open>possible_bit TYPE('a) n\<close> show ?thesis
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
320  | 
by (simp add: bit_double_Suc_iff)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
321  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
322  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
323  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
324  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
325  | 
lemma bit_1_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
326  | 
\<open>bit 1 n \<longleftrightarrow> n = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
327  | 
using bit_exp_iff [of 0 n] by auto  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
328  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
329  | 
lemma bit_2_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
330  | 
  \<open>bit 2 n \<longleftrightarrow> possible_bit TYPE('a) 1 \<and> n = 1\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
331  | 
using bit_exp_iff [of 1 n] by auto  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
332  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
333  | 
lemma bit_of_bool_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
334  | 
\<open>bit (of_bool b) n \<longleftrightarrow> n = 0 \<and> b\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
335  | 
by (simp add: bit_1_iff)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
336  | 
|
| 74101 | 337  | 
lemma bit_mod_2_iff [simp]:  | 
338  | 
\<open>bit (a mod 2) n \<longleftrightarrow> n = 0 \<and> odd a\<close>  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
339  | 
by (simp add: mod_2_eq_odd bit_simps)  | 
| 74101 | 340  | 
|
341  | 
end  | 
|
342  | 
||
343  | 
lemma nat_bit_induct [case_names zero even odd]:  | 
|
| 79017 | 344  | 
\<open>P n\<close> if zero: \<open>P 0\<close>  | 
345  | 
and even: \<open>\<And>n. P n \<Longrightarrow> n > 0 \<Longrightarrow> P (2 * n)\<close>  | 
|
346  | 
and odd: \<open>\<And>n. P n \<Longrightarrow> P (Suc (2 * n))\<close>  | 
|
| 74101 | 347  | 
proof (induction n rule: less_induct)  | 
348  | 
case (less n)  | 
|
| 79017 | 349  | 
show \<open>P n\<close>  | 
350  | 
proof (cases \<open>n = 0\<close>)  | 
|
| 74101 | 351  | 
case True with zero show ?thesis by simp  | 
352  | 
next  | 
|
353  | 
case False  | 
|
| 79017 | 354  | 
with less have hyp: \<open>P (n div 2)\<close> by simp  | 
| 74101 | 355  | 
show ?thesis  | 
| 79017 | 356  | 
proof (cases \<open>even n\<close>)  | 
| 74101 | 357  | 
case True  | 
| 79017 | 358  | 
then have \<open>n \<noteq> 1\<close>  | 
| 74101 | 359  | 
by auto  | 
| 79017 | 360  | 
with \<open>n \<noteq> 0\<close> have \<open>n div 2 > 0\<close>  | 
| 74101 | 361  | 
by simp  | 
| 79017 | 362  | 
with \<open>even n\<close> hyp even [of \<open>n div 2\<close>] show ?thesis  | 
| 74101 | 363  | 
by simp  | 
364  | 
next  | 
|
365  | 
case False  | 
|
| 79017 | 366  | 
with hyp odd [of \<open>n div 2\<close>] show ?thesis  | 
| 74101 | 367  | 
by simp  | 
368  | 
qed  | 
|
369  | 
qed  | 
|
370  | 
qed  | 
|
371  | 
||
372  | 
instantiation nat :: semiring_bits  | 
|
373  | 
begin  | 
|
374  | 
||
375  | 
definition bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> bool\<close>  | 
|
376  | 
where \<open>bit_nat m n \<longleftrightarrow> odd (m div 2 ^ n)\<close>  | 
|
377  | 
||
378  | 
instance  | 
|
379  | 
proof  | 
|
380  | 
show \<open>P n\<close> if stable: \<open>\<And>n. n div 2 = n \<Longrightarrow> P n\<close>  | 
|
381  | 
and rec: \<open>\<And>n b. P n \<Longrightarrow> (of_bool b + 2 * n) div 2 = n \<Longrightarrow> P (of_bool b + 2 * n)\<close>  | 
|
382  | 
for P and n :: nat  | 
|
383  | 
proof (induction n rule: nat_bit_induct)  | 
|
384  | 
case zero  | 
|
385  | 
from stable [of 0] show ?case  | 
|
386  | 
by simp  | 
|
387  | 
next  | 
|
388  | 
case (even n)  | 
|
389  | 
with rec [of n False] show ?case  | 
|
390  | 
by simp  | 
|
391  | 
next  | 
|
392  | 
case (odd n)  | 
|
393  | 
with rec [of n True] show ?case  | 
|
394  | 
by simp  | 
|
395  | 
qed  | 
|
| 80758 | 396  | 
qed (auto simp: div_mult2_eq bit_nat_def)  | 
| 74101 | 397  | 
|
398  | 
end  | 
|
399  | 
||
| 79017 | 400  | 
lemma possible_bit_nat [simp]:  | 
401  | 
\<open>possible_bit TYPE(nat) n\<close>  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
402  | 
by (simp add: possible_bit_def)  | 
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
403  | 
|
| 79069 | 404  | 
lemma bit_Suc_0_iff [bit_simps]:  | 
405  | 
\<open>bit (Suc 0) n \<longleftrightarrow> n = 0\<close>  | 
|
406  | 
using bit_1_iff [of n, where ?'a = nat] by simp  | 
|
407  | 
||
| 74497 | 408  | 
lemma not_bit_Suc_0_Suc [simp]:  | 
409  | 
\<open>\<not> bit (Suc 0) (Suc n)\<close>  | 
|
410  | 
by (simp add: bit_Suc)  | 
|
411  | 
||
412  | 
lemma not_bit_Suc_0_numeral [simp]:  | 
|
413  | 
\<open>\<not> bit (Suc 0) (numeral n)\<close>  | 
|
414  | 
by (simp add: numeral_eq_Suc)  | 
|
415  | 
||
| 74101 | 416  | 
context semiring_bits  | 
417  | 
begin  | 
|
418  | 
||
419  | 
lemma bit_of_nat_iff [bit_simps]:  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
420  | 
  \<open>bit (of_nat m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit m n\<close>
 | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
421  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
422  | 
case False  | 
| 74101 | 423  | 
then show ?thesis  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
424  | 
by (simp add: impossible_bit)  | 
| 74101 | 425  | 
next  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
426  | 
case True  | 
| 74101 | 427  | 
then have \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>  | 
428  | 
proof (induction m arbitrary: n rule: nat_bit_induct)  | 
|
429  | 
case zero  | 
|
430  | 
then show ?case  | 
|
431  | 
by simp  | 
|
432  | 
next  | 
|
433  | 
case (even m)  | 
|
434  | 
then show ?case  | 
|
435  | 
by (cases n)  | 
|
| 80758 | 436  | 
(auto simp: bit_double_iff Bit_Operations.bit_double_iff possible_bit_def bit_0 dest: mult_not_zero)  | 
| 74101 | 437  | 
next  | 
438  | 
case (odd m)  | 
|
439  | 
then show ?case  | 
|
440  | 
by (cases n)  | 
|
| 80758 | 441  | 
(auto simp: bit_double_iff even_bit_succ_iff possible_bit_def  | 
| 75085 | 442  | 
Bit_Operations.bit_Suc Bit_Operations.bit_0 dest: mult_not_zero)  | 
| 74101 | 443  | 
qed  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
444  | 
with True show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
445  | 
by simp  | 
| 74101 | 446  | 
qed  | 
447  | 
||
448  | 
end  | 
|
449  | 
||
| 79017 | 450  | 
lemma int_bit_induct [case_names zero minus even odd]:  | 
451  | 
\<open>P k\<close> if zero_int: \<open>P 0\<close>  | 
|
452  | 
and minus_int: \<open>P (- 1)\<close>  | 
|
453  | 
and even_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> P (k * 2)\<close>  | 
|
454  | 
and odd_int: \<open>\<And>k. P k \<Longrightarrow> k \<noteq> - 1 \<Longrightarrow> P (1 + (k * 2))\<close> for k :: int  | 
|
455  | 
proof (cases \<open>k \<ge> 0\<close>)  | 
|
456  | 
case True  | 
|
457  | 
define n where \<open>n = nat k\<close>  | 
|
458  | 
with True have \<open>k = int n\<close>  | 
|
459  | 
by simp  | 
|
460  | 
then show \<open>P k\<close>  | 
|
461  | 
proof (induction n arbitrary: k rule: nat_bit_induct)  | 
|
462  | 
case zero  | 
|
463  | 
then show ?case  | 
|
464  | 
by (simp add: zero_int)  | 
|
465  | 
next  | 
|
466  | 
case (even n)  | 
|
467  | 
have \<open>P (int n * 2)\<close>  | 
|
468  | 
by (rule even_int) (use even in simp_all)  | 
|
469  | 
with even show ?case  | 
|
470  | 
by (simp add: ac_simps)  | 
|
471  | 
next  | 
|
472  | 
case (odd n)  | 
|
473  | 
have \<open>P (1 + (int n * 2))\<close>  | 
|
474  | 
by (rule odd_int) (use odd in simp_all)  | 
|
475  | 
with odd show ?case  | 
|
476  | 
by (simp add: ac_simps)  | 
|
477  | 
qed  | 
|
478  | 
next  | 
|
479  | 
case False  | 
|
480  | 
define n where \<open>n = nat (- k - 1)\<close>  | 
|
481  | 
with False have \<open>k = - int n - 1\<close>  | 
|
482  | 
by simp  | 
|
483  | 
then show \<open>P k\<close>  | 
|
484  | 
proof (induction n arbitrary: k rule: nat_bit_induct)  | 
|
485  | 
case zero  | 
|
486  | 
then show ?case  | 
|
487  | 
by (simp add: minus_int)  | 
|
488  | 
next  | 
|
489  | 
case (even n)  | 
|
490  | 
have \<open>P (1 + (- int (Suc n) * 2))\<close>  | 
|
491  | 
by (rule odd_int) (use even in \<open>simp_all add: algebra_simps\<close>)  | 
|
492  | 
also have \<open>\<dots> = - int (2 * n) - 1\<close>  | 
|
493  | 
by (simp add: algebra_simps)  | 
|
494  | 
finally show ?case  | 
|
495  | 
using even.prems by simp  | 
|
496  | 
next  | 
|
497  | 
case (odd n)  | 
|
498  | 
have \<open>P (- int (Suc n) * 2)\<close>  | 
|
499  | 
by (rule even_int) (use odd in \<open>simp_all add: algebra_simps\<close>)  | 
|
500  | 
also have \<open>\<dots> = - int (Suc (2 * n)) - 1\<close>  | 
|
501  | 
by (simp add: algebra_simps)  | 
|
502  | 
finally show ?case  | 
|
503  | 
using odd.prems by simp  | 
|
504  | 
qed  | 
|
505  | 
qed  | 
|
506  | 
||
| 74101 | 507  | 
instantiation int :: semiring_bits  | 
508  | 
begin  | 
|
509  | 
||
510  | 
definition bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool\<close>  | 
|
511  | 
where \<open>bit_int k n \<longleftrightarrow> odd (k div 2 ^ n)\<close>  | 
|
512  | 
||
513  | 
instance  | 
|
514  | 
proof  | 
|
515  | 
show \<open>P k\<close> if stable: \<open>\<And>k. k div 2 = k \<Longrightarrow> P k\<close>  | 
|
516  | 
and rec: \<open>\<And>k b. P k \<Longrightarrow> (of_bool b + 2 * k) div 2 = k \<Longrightarrow> P (of_bool b + 2 * k)\<close>  | 
|
517  | 
for P and k :: int  | 
|
518  | 
proof (induction k rule: int_bit_induct)  | 
|
519  | 
case zero  | 
|
520  | 
from stable [of 0] show ?case  | 
|
521  | 
by simp  | 
|
522  | 
next  | 
|
523  | 
case minus  | 
|
524  | 
from stable [of \<open>- 1\<close>] show ?case  | 
|
525  | 
by simp  | 
|
526  | 
next  | 
|
527  | 
case (even k)  | 
|
528  | 
with rec [of k False] show ?case  | 
|
529  | 
by (simp add: ac_simps)  | 
|
530  | 
next  | 
|
531  | 
case (odd k)  | 
|
532  | 
with rec [of k True] show ?case  | 
|
533  | 
by (simp add: ac_simps)  | 
|
534  | 
qed  | 
|
| 80758 | 535  | 
qed (auto simp: zdiv_zmult2_eq bit_int_def)  | 
| 74101 | 536  | 
|
537  | 
end  | 
|
538  | 
||
| 79017 | 539  | 
lemma possible_bit_int [simp]:  | 
540  | 
\<open>possible_bit TYPE(int) n\<close>  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
541  | 
by (simp add: possible_bit_def)  | 
| 
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
542  | 
|
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
543  | 
lemma bit_nat_iff [bit_simps]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
544  | 
\<open>bit (nat k) n \<longleftrightarrow> k \<ge> 0 \<and> bit k n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
545  | 
proof (cases \<open>k \<ge> 0\<close>)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
546  | 
case True  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
547  | 
moreover define m where \<open>m = nat k\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
548  | 
ultimately have \<open>k = int m\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
549  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
550  | 
then show ?thesis  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
551  | 
by (simp add: bit_simps)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
552  | 
next  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
553  | 
case False  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
554  | 
then show ?thesis  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
555  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
556  | 
qed  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
557  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
558  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
559  | 
subsection \<open>Bit operations\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
560  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
561  | 
class semiring_bit_operations = semiring_bits +  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
562  | 
fixes "and" :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infixr \<open>AND\<close> 64)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
563  | 
and or :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infixr \<open>OR\<close> 59)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
564  | 
and xor :: \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infixr \<open>XOR\<close> 59)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
565  | 
and mask :: \<open>nat \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
566  | 
and set_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
567  | 
and unset_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
568  | 
and flip_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
569  | 
and push_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
570  | 
and drop_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
571  | 
and take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
| 
79008
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
572  | 
assumes and_rec: \<open>a AND b = of_bool (odd a \<and> odd b) + 2 * ((a div 2) AND (b div 2))\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
573  | 
and or_rec: \<open>a OR b = of_bool (odd a \<or> odd b) + 2 * ((a div 2) OR (b div 2))\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
574  | 
and xor_rec: \<open>a XOR b = of_bool (odd a \<noteq> odd b) + 2 * ((a div 2) XOR (b div 2))\<close>  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
575  | 
and mask_eq_exp_minus_1: \<open>mask n = 2 ^ n - 1\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
576  | 
and set_bit_eq_or: \<open>set_bit n a = a OR push_bit n 1\<close>  | 
| 79489 | 577  | 
and unset_bit_eq_or_xor: \<open>unset_bit n a = (a OR push_bit n 1) XOR push_bit n 1\<close>  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
578  | 
and flip_bit_eq_xor: \<open>flip_bit n a = a XOR push_bit n 1\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
579  | 
and push_bit_eq_mult: \<open>push_bit n a = a * 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
580  | 
and drop_bit_eq_div: \<open>drop_bit n a = a div 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
581  | 
and take_bit_eq_mod: \<open>take_bit n a = a mod 2 ^ n\<close>  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
582  | 
begin  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
583  | 
|
| 74101 | 584  | 
text \<open>  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
585  | 
We want the bitwise operations to bind slightly weaker  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
586  | 
than \<open>+\<close> and \<open>-\<close>.  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
587  | 
|
| 74101 | 588  | 
Logically, \<^const>\<open>push_bit\<close>,  | 
589  | 
\<^const>\<open>drop_bit\<close> and \<^const>\<open>take_bit\<close> are just aliases; having them  | 
|
590  | 
as separate operations makes proofs easier, otherwise proof automation  | 
|
591  | 
would fiddle with concrete expressions \<^term>\<open>2 ^ n\<close> in a way obfuscating the basic  | 
|
592  | 
algebraic relationships between those operations.  | 
|
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
593  | 
|
| 79068 | 594  | 
For the sake of code generation operations  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
595  | 
are specified as definitional class operations,  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
596  | 
taking into account that specific instances of these can be implemented  | 
| 74101 | 597  | 
differently wrt. code generation.  | 
598  | 
\<close>  | 
|
599  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
600  | 
lemma bit_iff_odd_drop_bit:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
601  | 
\<open>bit a n \<longleftrightarrow> odd (drop_bit n a)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
602  | 
by (simp add: bit_iff_odd drop_bit_eq_div)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
603  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
604  | 
lemma even_drop_bit_iff_not_bit:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
605  | 
\<open>even (drop_bit n a) \<longleftrightarrow> \<not> bit a n\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
606  | 
by (simp add: bit_iff_odd_drop_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
607  | 
|
| 
79008
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
608  | 
lemma bit_and_iff [bit_simps]:  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
609  | 
\<open>bit (a AND b) n \<longleftrightarrow> bit a n \<and> bit b n\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
610  | 
proof (induction n arbitrary: a b)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
611  | 
case 0  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
612  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
613  | 
by (simp add: bit_0 and_rec [of a b] even_bit_succ_iff)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
614  | 
next  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
615  | 
case (Suc n)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
616  | 
from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
617  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
618  | 
by (simp add: and_rec [of a b] bit_Suc)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
619  | 
(auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
620  | 
qed  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
621  | 
|
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
622  | 
lemma bit_or_iff [bit_simps]:  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
623  | 
\<open>bit (a OR b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
624  | 
proof (induction n arbitrary: a b)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
625  | 
case 0  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
626  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
627  | 
by (simp add: bit_0 or_rec [of a b] even_bit_succ_iff)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
628  | 
next  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
629  | 
case (Suc n)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
630  | 
from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
631  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
632  | 
by (simp add: or_rec [of a b] bit_Suc)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
633  | 
(auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
634  | 
qed  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
635  | 
|
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
636  | 
lemma bit_xor_iff [bit_simps]:  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
637  | 
\<open>bit (a XOR b) n \<longleftrightarrow> bit a n \<noteq> bit b n\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
638  | 
proof (induction n arbitrary: a b)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
639  | 
case 0  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
640  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
641  | 
by (simp add: bit_0 xor_rec [of a b] even_bit_succ_iff)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
642  | 
next  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
643  | 
case (Suc n)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
644  | 
from Suc [of \<open>a div 2\<close> \<open>b div 2\<close>]  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
645  | 
show ?case  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
646  | 
by (simp add: xor_rec [of a b] bit_Suc)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
647  | 
(auto simp flip: bit_Suc simp add: bit_double_iff dest: bit_imp_possible_bit)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
648  | 
qed  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
649  | 
|
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
650  | 
sublocale "and": semilattice \<open>(AND)\<close>  | 
| 80758 | 651  | 
by standard (auto simp: bit_eq_iff bit_and_iff)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
652  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
653  | 
sublocale or: semilattice_neutr \<open>(OR)\<close> 0  | 
| 80758 | 654  | 
by standard (auto simp: bit_eq_iff bit_or_iff)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
655  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
656  | 
sublocale xor: comm_monoid \<open>(XOR)\<close> 0  | 
| 80758 | 657  | 
by standard (auto simp: bit_eq_iff bit_xor_iff)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
658  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
659  | 
lemma even_and_iff:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
660  | 
\<open>even (a AND b) \<longleftrightarrow> even a \<or> even b\<close>  | 
| 80758 | 661  | 
using bit_and_iff [of a b 0] by (auto simp: bit_0)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
662  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
663  | 
lemma even_or_iff:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
664  | 
\<open>even (a OR b) \<longleftrightarrow> even a \<and> even b\<close>  | 
| 80758 | 665  | 
using bit_or_iff [of a b 0] by (auto simp: bit_0)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
666  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
667  | 
lemma even_xor_iff:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
668  | 
\<open>even (a XOR b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)\<close>  | 
| 80758 | 669  | 
using bit_xor_iff [of a b 0] by (auto simp: bit_0)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
670  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
671  | 
lemma zero_and_eq [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
672  | 
\<open>0 AND a = 0\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
673  | 
by (simp add: bit_eq_iff bit_and_iff)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
674  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
675  | 
lemma and_zero_eq [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
676  | 
\<open>a AND 0 = 0\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
677  | 
by (simp add: bit_eq_iff bit_and_iff)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
678  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
679  | 
lemma one_and_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
680  | 
\<open>1 AND a = a mod 2\<close>  | 
| 80758 | 681  | 
by (simp add: bit_eq_iff bit_and_iff) (auto simp: bit_1_iff bit_0)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
682  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
683  | 
lemma and_one_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
684  | 
\<open>a AND 1 = a mod 2\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
685  | 
using one_and_eq [of a] by (simp add: ac_simps)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
686  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
687  | 
lemma one_or_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
688  | 
\<open>1 OR a = a + of_bool (even a)\<close>  | 
| 75085 | 689  | 
by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff)  | 
| 80758 | 690  | 
(auto simp: bit_1_iff bit_0)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
691  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
692  | 
lemma or_one_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
693  | 
\<open>a OR 1 = a + of_bool (even a)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
694  | 
using one_or_eq [of a] by (simp add: ac_simps)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
695  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
696  | 
lemma one_xor_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
697  | 
\<open>1 XOR a = a + of_bool (even a) - of_bool (odd a)\<close>  | 
| 75085 | 698  | 
by (simp add: bit_eq_iff bit_xor_iff add.commute [of _ 1] even_bit_succ_iff)  | 
| 80758 | 699  | 
(auto simp: bit_1_iff odd_bit_iff_bit_pred bit_0 elim: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
700  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
701  | 
lemma xor_one_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
702  | 
\<open>a XOR 1 = a + of_bool (even a) - of_bool (odd a)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
703  | 
using one_xor_eq [of a] by (simp add: ac_simps)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
704  | 
|
| 74163 | 705  | 
lemma xor_self_eq [simp]:  | 
706  | 
\<open>a XOR a = 0\<close>  | 
|
707  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
|
708  | 
||
| 79588 | 709  | 
lemma mask_0 [simp]:  | 
710  | 
\<open>mask 0 = 0\<close>  | 
|
711  | 
by (simp add: mask_eq_exp_minus_1)  | 
|
712  | 
||
713  | 
lemma inc_mask_eq_exp:  | 
|
714  | 
\<open>mask n + 1 = 2 ^ n\<close>  | 
|
715  | 
proof (induction n)  | 
|
716  | 
case 0  | 
|
717  | 
then show ?case  | 
|
718  | 
by simp  | 
|
719  | 
next  | 
|
720  | 
case (Suc n)  | 
|
721  | 
from Suc.IH [symmetric] have \<open>2 ^ Suc n = 2 * mask n + 2\<close>  | 
|
722  | 
by (simp add: algebra_simps)  | 
|
723  | 
also have \<open>\<dots> = 2 * mask n + 1 + 1\<close>  | 
|
724  | 
by (simp add: add.assoc)  | 
|
725  | 
finally have *: \<open>2 ^ Suc n = 2 * mask n + 1 + 1\<close> .  | 
|
726  | 
then show ?case  | 
|
727  | 
by (simp add: mask_eq_exp_minus_1)  | 
|
728  | 
qed  | 
|
729  | 
||
730  | 
lemma mask_Suc_double:  | 
|
731  | 
\<open>mask (Suc n) = 1 OR 2 * mask n\<close>  | 
|
732  | 
proof -  | 
|
733  | 
have \<open>mask (Suc n) + 1 = (mask n + 1) + (mask n + 1)\<close>  | 
|
734  | 
by (simp add: inc_mask_eq_exp mult_2)  | 
|
735  | 
also have \<open>\<dots> = (1 OR 2 * mask n) + 1\<close>  | 
|
736  | 
by (simp add: one_or_eq mult_2_right algebra_simps)  | 
|
737  | 
finally show ?thesis  | 
|
738  | 
by simp  | 
|
739  | 
qed  | 
|
740  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
741  | 
lemma bit_mask_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
742  | 
  \<open>bit (mask m) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n < m\<close>
 | 
| 79588 | 743  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
744  | 
case False  | 
|
745  | 
then show ?thesis  | 
|
746  | 
by (simp add: impossible_bit)  | 
|
747  | 
next  | 
|
748  | 
case True  | 
|
749  | 
then have \<open>bit (mask m) n \<longleftrightarrow> n < m\<close>  | 
|
750  | 
proof (induction m arbitrary: n)  | 
|
751  | 
case 0  | 
|
752  | 
then show ?case  | 
|
753  | 
by (simp add: bit_iff_odd)  | 
|
754  | 
next  | 
|
755  | 
case (Suc m)  | 
|
756  | 
show ?case  | 
|
757  | 
proof (cases n)  | 
|
758  | 
case 0  | 
|
759  | 
then show ?thesis  | 
|
760  | 
by (simp add: bit_0 mask_Suc_double even_or_iff)  | 
|
761  | 
next  | 
|
762  | 
case (Suc n)  | 
|
763  | 
      with Suc.prems have \<open>possible_bit TYPE('a) n\<close>
 | 
|
764  | 
using possible_bit_less_imp by auto  | 
|
765  | 
with Suc.IH [of n] have \<open>bit (mask m) n \<longleftrightarrow> n < m\<close> .  | 
|
766  | 
with Suc.prems show ?thesis  | 
|
767  | 
by (simp add: Suc mask_Suc_double bit_simps)  | 
|
768  | 
qed  | 
|
769  | 
qed  | 
|
770  | 
with True show ?thesis  | 
|
771  | 
by simp  | 
|
772  | 
qed  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
773  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
774  | 
lemma even_mask_iff:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
775  | 
\<open>even (mask n) \<longleftrightarrow> n = 0\<close>  | 
| 80758 | 776  | 
using bit_mask_iff [of n 0] by (auto simp: bit_0)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
777  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
778  | 
lemma mask_Suc_0 [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
779  | 
\<open>mask (Suc 0) = 1\<close>  | 
| 79588 | 780  | 
by (simp add: mask_Suc_double)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
781  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
782  | 
lemma mask_Suc_exp:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
783  | 
\<open>mask (Suc n) = 2 ^ n OR mask n\<close>  | 
| 80758 | 784  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
785  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
786  | 
lemma mask_numeral:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
787  | 
\<open>mask (numeral n) = 1 + 2 * mask (pred_numeral n)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
788  | 
by (simp add: numeral_eq_Suc mask_Suc_double one_or_eq ac_simps)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
789  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
790  | 
lemma push_bit_0_id [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
791  | 
\<open>push_bit 0 = id\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
792  | 
by (simp add: fun_eq_iff push_bit_eq_mult)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
793  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
794  | 
lemma push_bit_Suc [simp]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
795  | 
\<open>push_bit (Suc n) a = push_bit n (a * 2)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
796  | 
by (simp add: push_bit_eq_mult ac_simps)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
797  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
798  | 
lemma push_bit_double:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
799  | 
\<open>push_bit n (a * 2) = push_bit n a * 2\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
800  | 
by (simp add: push_bit_eq_mult ac_simps)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
801  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
802  | 
lemma bit_push_bit_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
803  | 
  \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> possible_bit TYPE('a) n \<and> bit a (n - m)\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
804  | 
proof (induction n arbitrary: m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
805  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
806  | 
then show ?case  | 
| 80758 | 807  | 
by (auto simp: bit_0 push_bit_eq_mult)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
808  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
809  | 
case (Suc n)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
810  | 
show ?case  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
811  | 
proof (cases m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
812  | 
case 0  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
813  | 
then show ?thesis  | 
| 80758 | 814  | 
by (auto simp: bit_imp_possible_bit)  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
815  | 
next  | 
| 80758 | 816  | 
case (Suc m')  | 
817  | 
with Suc.prems Suc.IH [of m'] show ?thesis  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
818  | 
apply (simp add: push_bit_double)  | 
| 80758 | 819  | 
apply (auto simp: possible_bit_less_imp bit_simps mult.commute [of _ 2])  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
820  | 
done  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
821  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
822  | 
qed  | 
| 74101 | 823  | 
|
| 79590 | 824  | 
lemma funpow_double_eq_push_bit:  | 
825  | 
\<open>times 2 ^^ n = push_bit n\<close>  | 
|
826  | 
by (induction n) (simp_all add: fun_eq_iff push_bit_double ac_simps)  | 
|
827  | 
||
| 74101 | 828  | 
lemma div_push_bit_of_1_eq_drop_bit:  | 
829  | 
\<open>a div push_bit n 1 = drop_bit n a\<close>  | 
|
830  | 
by (simp add: push_bit_eq_mult drop_bit_eq_div)  | 
|
831  | 
||
832  | 
lemma bits_ident:  | 
|
| 79017 | 833  | 
\<open>push_bit n (drop_bit n a) + take_bit n a = a\<close>  | 
| 74101 | 834  | 
using div_mult_mod_eq by (simp add: push_bit_eq_mult take_bit_eq_mod drop_bit_eq_div)  | 
835  | 
||
836  | 
lemma push_bit_push_bit [simp]:  | 
|
| 79017 | 837  | 
\<open>push_bit m (push_bit n a) = push_bit (m + n) a\<close>  | 
| 74101 | 838  | 
by (simp add: push_bit_eq_mult power_add ac_simps)  | 
839  | 
||
840  | 
lemma push_bit_of_0 [simp]:  | 
|
| 79017 | 841  | 
\<open>push_bit n 0 = 0\<close>  | 
| 74101 | 842  | 
by (simp add: push_bit_eq_mult)  | 
843  | 
||
| 74592 | 844  | 
lemma push_bit_of_1 [simp]:  | 
| 79017 | 845  | 
\<open>push_bit n 1 = 2 ^ n\<close>  | 
| 74101 | 846  | 
by (simp add: push_bit_eq_mult)  | 
847  | 
||
848  | 
lemma push_bit_add:  | 
|
| 79017 | 849  | 
\<open>push_bit n (a + b) = push_bit n a + push_bit n b\<close>  | 
| 74101 | 850  | 
by (simp add: push_bit_eq_mult algebra_simps)  | 
851  | 
||
852  | 
lemma push_bit_numeral [simp]:  | 
|
853  | 
\<open>push_bit (numeral l) (numeral k) = push_bit (pred_numeral l) (numeral (Num.Bit0 k))\<close>  | 
|
854  | 
by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)  | 
|
855  | 
||
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
856  | 
lemma bit_drop_bit_eq [bit_simps]:  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
857  | 
\<open>bit (drop_bit n a) = bit a \<circ> (+) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
858  | 
by rule (simp add: drop_bit_eq_div bit_iff_odd div_exp_eq)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
859  | 
|
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
860  | 
lemma disjunctive_xor_eq_or:  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
861  | 
\<open>a XOR b = a OR b\<close> if \<open>a AND b = 0\<close>  | 
| 80758 | 862  | 
using that by (auto simp: bit_eq_iff bit_simps)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
863  | 
|
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
864  | 
lemma disjunctive_add_eq_or:  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
865  | 
\<open>a + b = a OR b\<close> if \<open>a AND b = 0\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
866  | 
proof (rule bit_eqI)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
867  | 
fix n  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
868  | 
  assume \<open>possible_bit TYPE('a) n\<close>
 | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
869  | 
moreover from that have \<open>\<And>n. \<not> bit (a AND b) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
870  | 
by simp  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
871  | 
then have \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
872  | 
by (simp add: bit_simps)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
873  | 
ultimately show \<open>bit (a + b) n \<longleftrightarrow> bit (a OR b) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
874  | 
proof (induction n arbitrary: a b)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
875  | 
case 0  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
876  | 
from "0"(2)[of 0] show ?case  | 
| 80758 | 877  | 
by (auto simp: even_or_iff bit_0)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
878  | 
next  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
879  | 
case (Suc n)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
880  | 
from Suc.prems(2) [of 0] have even: \<open>even a \<or> even b\<close>  | 
| 80758 | 881  | 
by (auto simp: bit_0)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
882  | 
have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
883  | 
using Suc.prems(2) [of \<open>Suc n\<close>] by (simp add: bit_Suc)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
884  | 
    from Suc.prems have \<open>possible_bit TYPE('a) n\<close>
 | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
885  | 
using possible_bit_less_imp by force  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
886  | 
with \<open>\<And>n. \<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> Suc.IH [of \<open>a div 2\<close> \<open>b div 2\<close>]  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
887  | 
have IH: \<open>bit (a div 2 + b div 2) n \<longleftrightarrow> bit (a div 2 OR b div 2) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
888  | 
by (simp add: bit_Suc)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
889  | 
have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
890  | 
using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
891  | 
also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close>  | 
| 80758 | 892  | 
using even by (auto simp: algebra_simps mod2_eq_if)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
893  | 
finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
894  | 
      using \<open>possible_bit TYPE('a) (Suc n)\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff possible_bit_def)
 | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
895  | 
also have \<open>\<dots> \<longleftrightarrow> bit (a div 2 OR b div 2) n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
896  | 
by (rule IH)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
897  | 
finally show ?case  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
898  | 
by (simp add: bit_simps flip: bit_Suc)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
899  | 
qed  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
900  | 
qed  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
901  | 
|
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
902  | 
lemma disjunctive_add_eq_xor:  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
903  | 
\<open>a + b = a XOR b\<close> if \<open>a AND b = 0\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
904  | 
using that by (simp add: disjunctive_add_eq_or disjunctive_xor_eq_or)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
905  | 
|
| 74101 | 906  | 
lemma take_bit_0 [simp]:  | 
907  | 
"take_bit 0 a = 0"  | 
|
908  | 
by (simp add: take_bit_eq_mod)  | 
|
909  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
910  | 
lemma bit_take_bit_iff [bit_simps]:  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
911  | 
\<open>bit (take_bit m a) n \<longleftrightarrow> n < m \<and> bit a n\<close>  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
912  | 
proof -  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
913  | 
have \<open>push_bit m (drop_bit m a) AND take_bit m a = 0\<close> (is \<open>?lhs = _\<close>)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
914  | 
proof (rule bit_eqI)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
915  | 
fix n  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
916  | 
show \<open>bit ?lhs n \<longleftrightarrow> bit 0 n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
917  | 
proof (cases \<open>m \<le> n\<close>)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
918  | 
case False  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
919  | 
then show ?thesis  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
920  | 
by (simp add: bit_simps)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
921  | 
next  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
922  | 
case True  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
923  | 
moreover define q where \<open>q = n - m\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
924  | 
ultimately have \<open>n = m + q\<close> by simp  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
925  | 
moreover have \<open>\<not> bit (take_bit m a) (m + q)\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
926  | 
by (simp add: take_bit_eq_mod bit_iff_odd flip: div_exp_eq)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
927  | 
ultimately show ?thesis  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
928  | 
by (simp add: bit_simps)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
929  | 
qed  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
930  | 
qed  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
931  | 
then have \<open>push_bit m (drop_bit m a) XOR take_bit m a = push_bit m (drop_bit m a) + take_bit m a\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
932  | 
by (simp add: disjunctive_add_eq_xor)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
933  | 
also have \<open>\<dots> = a\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
934  | 
by (simp add: bits_ident)  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
935  | 
finally have \<open>bit (push_bit m (drop_bit m a) XOR take_bit m a) n \<longleftrightarrow> bit a n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
936  | 
by simp  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
937  | 
also have \<open>\<dots> \<longleftrightarrow> (m \<le> n \<or> n < m) \<and> bit a n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
938  | 
by auto  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
939  | 
also have \<open>\<dots> \<longleftrightarrow> m \<le> n \<and> bit a n \<or> n < m \<and> bit a n\<close>  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
940  | 
by auto  | 
| 
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
941  | 
also have \<open>m \<le> n \<and> bit a n \<longleftrightarrow> bit (push_bit m (drop_bit m a)) n\<close>  | 
| 80758 | 942  | 
by (auto simp: bit_simps bit_imp_possible_bit)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
943  | 
finally show ?thesis  | 
| 80758 | 944  | 
by (auto simp: bit_simps)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
945  | 
qed  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
946  | 
|
| 74101 | 947  | 
lemma take_bit_Suc:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
948  | 
\<open>take_bit (Suc n) a = take_bit n (a div 2) * 2 + a mod 2\<close> (is \<open>?lhs = ?rhs\<close>)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
949  | 
proof (rule bit_eqI)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
950  | 
fix m  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
951  | 
  assume \<open>possible_bit TYPE('a) m\<close>
 | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
952  | 
then show \<open>bit ?lhs m \<longleftrightarrow> bit ?rhs m\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
953  | 
apply (cases a rule: parity_cases; cases m)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
954  | 
apply (simp_all add: bit_simps even_bit_succ_iff mult.commute [of _ 2] add.commute [of _ 1] flip: bit_Suc)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
955  | 
apply (simp_all add: bit_0)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
956  | 
done  | 
| 74101 | 957  | 
qed  | 
958  | 
||
959  | 
lemma take_bit_rec:  | 
|
960  | 
\<open>take_bit n a = (if n = 0 then 0 else take_bit (n - 1) (a div 2) * 2 + a mod 2)\<close>  | 
|
961  | 
by (cases n) (simp_all add: take_bit_Suc)  | 
|
962  | 
||
963  | 
lemma take_bit_Suc_0 [simp]:  | 
|
964  | 
\<open>take_bit (Suc 0) a = a mod 2\<close>  | 
|
965  | 
by (simp add: take_bit_eq_mod)  | 
|
966  | 
||
967  | 
lemma take_bit_of_0 [simp]:  | 
|
| 79017 | 968  | 
\<open>take_bit n 0 = 0\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
969  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
| 74101 | 970  | 
|
971  | 
lemma take_bit_of_1 [simp]:  | 
|
| 79017 | 972  | 
\<open>take_bit n 1 = of_bool (n > 0)\<close>  | 
| 74101 | 973  | 
by (cases n) (simp_all add: take_bit_Suc)  | 
974  | 
||
975  | 
lemma drop_bit_of_0 [simp]:  | 
|
| 79017 | 976  | 
\<open>drop_bit n 0 = 0\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
977  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
| 74101 | 978  | 
|
979  | 
lemma drop_bit_of_1 [simp]:  | 
|
| 79017 | 980  | 
\<open>drop_bit n 1 = of_bool (n = 0)\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
981  | 
by (rule bit_eqI) (simp add: bit_simps ac_simps)  | 
| 74101 | 982  | 
|
983  | 
lemma drop_bit_0 [simp]:  | 
|
| 79017 | 984  | 
\<open>drop_bit 0 = id\<close>  | 
| 74101 | 985  | 
by (simp add: fun_eq_iff drop_bit_eq_div)  | 
986  | 
||
987  | 
lemma drop_bit_Suc:  | 
|
| 79017 | 988  | 
\<open>drop_bit (Suc n) a = drop_bit n (a div 2)\<close>  | 
| 74101 | 989  | 
using div_exp_eq [of a 1] by (simp add: drop_bit_eq_div)  | 
990  | 
||
991  | 
lemma drop_bit_rec:  | 
|
| 79017 | 992  | 
\<open>drop_bit n a = (if n = 0 then a else drop_bit (n - 1) (a div 2))\<close>  | 
| 74101 | 993  | 
by (cases n) (simp_all add: drop_bit_Suc)  | 
994  | 
||
995  | 
lemma drop_bit_half:  | 
|
| 79017 | 996  | 
\<open>drop_bit n (a div 2) = drop_bit n a div 2\<close>  | 
| 74101 | 997  | 
by (induction n arbitrary: a) (simp_all add: drop_bit_Suc)  | 
998  | 
||
999  | 
lemma drop_bit_of_bool [simp]:  | 
|
| 79017 | 1000  | 
\<open>drop_bit n (of_bool b) = of_bool (n = 0 \<and> b)\<close>  | 
| 74101 | 1001  | 
by (cases n) simp_all  | 
1002  | 
||
1003  | 
lemma even_take_bit_eq [simp]:  | 
|
1004  | 
\<open>even (take_bit n a) \<longleftrightarrow> n = 0 \<or> even a\<close>  | 
|
1005  | 
by (simp add: take_bit_rec [of n a])  | 
|
1006  | 
||
1007  | 
lemma take_bit_take_bit [simp]:  | 
|
| 79017 | 1008  | 
\<open>take_bit m (take_bit n a) = take_bit (min m n) a\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
1009  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
| 74101 | 1010  | 
|
1011  | 
lemma drop_bit_drop_bit [simp]:  | 
|
| 79017 | 1012  | 
\<open>drop_bit m (drop_bit n a) = drop_bit (m + n) a\<close>  | 
| 74101 | 1013  | 
by (simp add: drop_bit_eq_div power_add div_exp_eq ac_simps)  | 
1014  | 
||
1015  | 
lemma push_bit_take_bit:  | 
|
| 79017 | 1016  | 
\<open>push_bit m (take_bit n a) = take_bit (m + n) (push_bit m a)\<close>  | 
| 80758 | 1017  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 74101 | 1018  | 
|
1019  | 
lemma take_bit_push_bit:  | 
|
| 79017 | 1020  | 
\<open>take_bit m (push_bit n a) = push_bit n (take_bit (m - n) a)\<close>  | 
| 80758 | 1021  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 74101 | 1022  | 
|
1023  | 
lemma take_bit_drop_bit:  | 
|
| 79017 | 1024  | 
\<open>take_bit m (drop_bit n a) = drop_bit n (take_bit (m + n) a)\<close>  | 
| 80758 | 1025  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 74101 | 1026  | 
|
1027  | 
lemma drop_bit_take_bit:  | 
|
| 79017 | 1028  | 
\<open>drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)\<close>  | 
| 80758 | 1029  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 74101 | 1030  | 
|
1031  | 
lemma even_push_bit_iff [simp]:  | 
|
1032  | 
\<open>even (push_bit n a) \<longleftrightarrow> n \<noteq> 0 \<or> even a\<close>  | 
|
1033  | 
by (simp add: push_bit_eq_mult) auto  | 
|
1034  | 
||
1035  | 
lemma stable_imp_drop_bit_eq:  | 
|
1036  | 
\<open>drop_bit n a = a\<close>  | 
|
1037  | 
if \<open>a div 2 = a\<close>  | 
|
1038  | 
by (induction n) (simp_all add: that drop_bit_Suc)  | 
|
1039  | 
||
1040  | 
lemma stable_imp_take_bit_eq:  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
1041  | 
\<open>take_bit n a = (if even a then 0 else mask n)\<close>  | 
| 74101 | 1042  | 
if \<open>a div 2 = a\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
1043  | 
by (rule bit_eqI) (use that in \<open>simp add: bit_simps stable_imp_bit_iff_odd\<close>)  | 
| 74101 | 1044  | 
|
1045  | 
lemma exp_dvdE:  | 
|
1046  | 
assumes \<open>2 ^ n dvd a\<close>  | 
|
1047  | 
obtains b where \<open>a = push_bit n b\<close>  | 
|
1048  | 
proof -  | 
|
1049  | 
from assms obtain b where \<open>a = 2 ^ n * b\<close> ..  | 
|
1050  | 
then have \<open>a = push_bit n b\<close>  | 
|
1051  | 
by (simp add: push_bit_eq_mult ac_simps)  | 
|
1052  | 
with that show thesis .  | 
|
1053  | 
qed  | 
|
1054  | 
||
1055  | 
lemma take_bit_eq_0_iff:  | 
|
1056  | 
\<open>take_bit n a = 0 \<longleftrightarrow> 2 ^ n dvd a\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
|
1057  | 
proof  | 
|
1058  | 
assume ?P  | 
|
1059  | 
then show ?Q  | 
|
1060  | 
by (simp add: take_bit_eq_mod mod_0_imp_dvd)  | 
|
1061  | 
next  | 
|
1062  | 
assume ?Q  | 
|
1063  | 
then obtain b where \<open>a = push_bit n b\<close>  | 
|
1064  | 
by (rule exp_dvdE)  | 
|
1065  | 
then show ?P  | 
|
1066  | 
by (simp add: take_bit_push_bit)  | 
|
1067  | 
qed  | 
|
1068  | 
||
1069  | 
lemma take_bit_tightened:  | 
|
| 79068 | 1070  | 
\<open>take_bit m a = take_bit m b\<close> if \<open>take_bit n a = take_bit n b\<close> and \<open>m \<le> n\<close>  | 
| 74101 | 1071  | 
proof -  | 
1072  | 
from that have \<open>take_bit m (take_bit n a) = take_bit m (take_bit n b)\<close>  | 
|
1073  | 
by simp  | 
|
1074  | 
then have \<open>take_bit (min m n) a = take_bit (min m n) b\<close>  | 
|
1075  | 
by simp  | 
|
1076  | 
with that show ?thesis  | 
|
1077  | 
by (simp add: min_def)  | 
|
1078  | 
qed  | 
|
1079  | 
||
1080  | 
lemma take_bit_eq_self_iff_drop_bit_eq_0:  | 
|
1081  | 
\<open>take_bit n a = a \<longleftrightarrow> drop_bit n a = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
|
1082  | 
proof  | 
|
1083  | 
assume ?P  | 
|
1084  | 
show ?Q  | 
|
1085  | 
proof (rule bit_eqI)  | 
|
1086  | 
fix m  | 
|
1087  | 
from \<open>?P\<close> have \<open>a = take_bit n a\<close> ..  | 
|
1088  | 
also have \<open>\<not> bit (take_bit n a) (n + m)\<close>  | 
|
1089  | 
unfolding bit_simps  | 
|
| 79068 | 1090  | 
by (simp add: bit_simps)  | 
| 74101 | 1091  | 
finally show \<open>bit (drop_bit n a) m \<longleftrightarrow> bit 0 m\<close>  | 
1092  | 
by (simp add: bit_simps)  | 
|
1093  | 
qed  | 
|
1094  | 
next  | 
|
1095  | 
assume ?Q  | 
|
1096  | 
show ?P  | 
|
1097  | 
proof (rule bit_eqI)  | 
|
1098  | 
fix m  | 
|
1099  | 
from \<open>?Q\<close> have \<open>\<not> bit (drop_bit n a) (m - n)\<close>  | 
|
1100  | 
by simp  | 
|
1101  | 
then have \<open> \<not> bit a (n + (m - n))\<close>  | 
|
1102  | 
by (simp add: bit_simps)  | 
|
1103  | 
then show \<open>bit (take_bit n a) m \<longleftrightarrow> bit a m\<close>  | 
|
| 80758 | 1104  | 
by (cases \<open>m < n\<close>) (auto simp: bit_simps)  | 
| 74101 | 1105  | 
qed  | 
1106  | 
qed  | 
|
1107  | 
||
1108  | 
lemma drop_bit_exp_eq:  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1109  | 
  \<open>drop_bit m (2 ^ n) = of_bool (m \<le> n \<and> possible_bit TYPE('a) n) * 2 ^ (n - m)\<close>
 | 
| 80758 | 1110  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 74101 | 1111  | 
|
| 71409 | 1112  | 
lemma take_bit_and [simp]:  | 
1113  | 
\<open>take_bit n (a AND b) = take_bit n a AND take_bit n b\<close>  | 
|
| 80758 | 1114  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 71409 | 1115  | 
|
1116  | 
lemma take_bit_or [simp]:  | 
|
1117  | 
\<open>take_bit n (a OR b) = take_bit n a OR take_bit n b\<close>  | 
|
| 80758 | 1118  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 71409 | 1119  | 
|
1120  | 
lemma take_bit_xor [simp]:  | 
|
1121  | 
\<open>take_bit n (a XOR b) = take_bit n a XOR take_bit n b\<close>  | 
|
| 80758 | 1122  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 71409 | 1123  | 
|
| 72239 | 1124  | 
lemma push_bit_and [simp]:  | 
1125  | 
\<open>push_bit n (a AND b) = push_bit n a AND push_bit n b\<close>  | 
|
| 80758 | 1126  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1127  | 
|
1128  | 
lemma push_bit_or [simp]:  | 
|
1129  | 
\<open>push_bit n (a OR b) = push_bit n a OR push_bit n b\<close>  | 
|
| 80758 | 1130  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1131  | 
|
1132  | 
lemma push_bit_xor [simp]:  | 
|
1133  | 
\<open>push_bit n (a XOR b) = push_bit n a XOR push_bit n b\<close>  | 
|
| 80758 | 1134  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1135  | 
|
1136  | 
lemma drop_bit_and [simp]:  | 
|
1137  | 
\<open>drop_bit n (a AND b) = drop_bit n a AND drop_bit n b\<close>  | 
|
| 80758 | 1138  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1139  | 
|
1140  | 
lemma drop_bit_or [simp]:  | 
|
1141  | 
\<open>drop_bit n (a OR b) = drop_bit n a OR drop_bit n b\<close>  | 
|
| 80758 | 1142  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1143  | 
|
1144  | 
lemma drop_bit_xor [simp]:  | 
|
1145  | 
\<open>drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\<close>  | 
|
| 80758 | 1146  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 72239 | 1147  | 
|
| 74592 | 1148  | 
lemma take_bit_of_mask [simp]:  | 
| 72830 | 1149  | 
\<open>take_bit m (mask n) = mask (min m n)\<close>  | 
1150  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
|
1151  | 
||
| 
71965
 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 
haftmann 
parents: 
71956 
diff
changeset
 | 
1152  | 
lemma take_bit_eq_mask:  | 
| 71823 | 1153  | 
\<open>take_bit n a = a AND mask n\<close>  | 
| 80758 | 1154  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 71823 | 1155  | 
|
| 
72281
 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 
haftmann 
parents: 
72262 
diff
changeset
 | 
1156  | 
lemma or_eq_0_iff:  | 
| 
 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 
haftmann 
parents: 
72262 
diff
changeset
 | 
1157  | 
\<open>a OR b = 0 \<longleftrightarrow> a = 0 \<and> b = 0\<close>  | 
| 80758 | 1158  | 
by (auto simp: bit_eq_iff bit_or_iff)  | 
| 
72281
 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 
haftmann 
parents: 
72262 
diff
changeset
 | 
1159  | 
|
| 72508 | 1160  | 
lemma bit_iff_and_drop_bit_eq_1:  | 
1161  | 
\<open>bit a n \<longleftrightarrow> drop_bit n a AND 1 = 1\<close>  | 
|
1162  | 
by (simp add: bit_iff_odd_drop_bit and_one_eq odd_iff_mod_2_eq_one)  | 
|
1163  | 
||
1164  | 
lemma bit_iff_and_push_bit_not_eq_0:  | 
|
1165  | 
\<open>bit a n \<longleftrightarrow> a AND push_bit n 1 \<noteq> 0\<close>  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
1166  | 
  by (cases \<open>possible_bit TYPE('a) n\<close>) (simp_all add: bit_eq_iff bit_simps impossible_bit)
 | 
| 72508 | 1167  | 
|
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1168  | 
lemma bit_set_bit_iff [bit_simps]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1169  | 
  \<open>bit (set_bit m a) n \<longleftrightarrow> bit a n \<or> (m = n \<and> possible_bit TYPE('a) n)\<close>
 | 
| 80758 | 1170  | 
by (auto simp: set_bit_eq_or bit_or_iff bit_exp_iff)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1171  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1172  | 
lemma even_set_bit_iff:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1173  | 
\<open>even (set_bit m a) \<longleftrightarrow> even a \<and> m \<noteq> 0\<close>  | 
| 80758 | 1174  | 
using bit_set_bit_iff [of m a 0] by (auto simp: bit_0)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1175  | 
|
| 
79031
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
1176  | 
lemma bit_unset_bit_iff [bit_simps]:  | 
| 
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
1177  | 
\<open>bit (unset_bit m a) n \<longleftrightarrow> bit a n \<and> m \<noteq> n\<close>  | 
| 80758 | 1178  | 
by (auto simp: unset_bit_eq_or_xor bit_simps dest: bit_imp_possible_bit)  | 
| 
79031
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
1179  | 
|
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1180  | 
lemma even_unset_bit_iff:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1181  | 
\<open>even (unset_bit m a) \<longleftrightarrow> even a \<or> m = 0\<close>  | 
| 80758 | 1182  | 
using bit_unset_bit_iff [of m a 0] by (auto simp: bit_0)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1183  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1184  | 
lemma bit_flip_bit_iff [bit_simps]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1185  | 
  \<open>bit (flip_bit m a) n \<longleftrightarrow> (m = n \<longleftrightarrow> \<not> bit a n) \<and> possible_bit TYPE('a) n\<close>
 | 
| 80758 | 1186  | 
by (auto simp: bit_eq_iff bit_simps flip_bit_eq_xor bit_imp_possible_bit)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1187  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1188  | 
lemma even_flip_bit_iff:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1189  | 
\<open>even (flip_bit m a) \<longleftrightarrow> \<not> (even a \<longleftrightarrow> m = 0)\<close>  | 
| 75085 | 1190  | 
using bit_flip_bit_iff [of m a 0] by (auto simp: possible_bit_def bit_0)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1191  | 
|
| 79489 | 1192  | 
lemma and_exp_eq_0_iff_not_bit:  | 
1193  | 
\<open>a AND 2 ^ n = 0 \<longleftrightarrow> \<not> bit a n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
|
1194  | 
using bit_imp_possible_bit[of a n]  | 
|
| 80758 | 1195  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 79489 | 1196  | 
|
1197  | 
lemma bit_sum_mult_2_cases:  | 
|
1198  | 
assumes a: \<open>\<forall>j. \<not> bit a (Suc j)\<close>  | 
|
1199  | 
shows \<open>bit (a + 2 * b) n = (if n = 0 then odd a else bit (2 * b) n)\<close>  | 
|
1200  | 
proof -  | 
|
1201  | 
from a have \<open>n = 0\<close> if \<open>bit a n\<close> for n using that  | 
|
1202  | 
by (cases n) simp_all  | 
|
1203  | 
then have \<open>a = 0 \<or> a = 1\<close>  | 
|
| 80758 | 1204  | 
by (auto simp: bit_eq_iff bit_1_iff)  | 
| 79489 | 1205  | 
then show ?thesis  | 
| 80758 | 1206  | 
by (cases n) (auto simp: bit_0 bit_double_iff even_bit_succ_iff)  | 
| 79489 | 1207  | 
qed  | 
1208  | 
||
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1209  | 
lemma set_bit_0:  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1210  | 
\<open>set_bit 0 a = 1 + 2 * (a div 2)\<close>  | 
| 80758 | 1211  | 
by (auto simp: bit_eq_iff bit_simps even_bit_succ_iff simp flip: bit_Suc)  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1212  | 
|
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1213  | 
lemma set_bit_Suc:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1214  | 
\<open>set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\<close>  | 
| 80758 | 1215  | 
by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1216  | 
elim: possible_bit_less_imp)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1217  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1218  | 
lemma unset_bit_0:  | 
| 79489 | 1219  | 
\<open>unset_bit 0 a = 2 * (a div 2)\<close>  | 
| 80758 | 1220  | 
by (auto simp: bit_eq_iff bit_simps simp flip: bit_Suc)  | 
| 79489 | 1221  | 
|
1222  | 
lemma unset_bit_Suc:  | 
|
1223  | 
\<open>unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\<close>  | 
|
| 80758 | 1224  | 
by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc)  | 
| 79489 | 1225  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1226  | 
lemma flip_bit_0:  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1227  | 
\<open>flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\<close>  | 
| 80758 | 1228  | 
by (auto simp: bit_eq_iff bit_simps even_bit_succ_iff bit_0 simp flip: bit_Suc)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1229  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1230  | 
lemma flip_bit_Suc:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1231  | 
\<open>flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\<close>  | 
| 80758 | 1232  | 
by (auto simp: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 simp flip: bit_Suc  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1233  | 
elim: possible_bit_less_imp)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1234  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1235  | 
lemma flip_bit_eq_if:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1236  | 
\<open>flip_bit n a = (if bit a n then unset_bit else set_bit) n a\<close>  | 
| 80758 | 1237  | 
by (rule bit_eqI) (auto simp: bit_set_bit_iff bit_unset_bit_iff bit_flip_bit_iff)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1238  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1239  | 
lemma take_bit_set_bit_eq:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1240  | 
\<open>take_bit n (set_bit m a) = (if n \<le> m then take_bit n a else set_bit m (take_bit n a))\<close>  | 
| 80758 | 1241  | 
by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_set_bit_iff)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1242  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1243  | 
lemma take_bit_unset_bit_eq:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1244  | 
\<open>take_bit n (unset_bit m a) = (if n \<le> m then take_bit n a else unset_bit m (take_bit n a))\<close>  | 
| 80758 | 1245  | 
by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_unset_bit_iff)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1246  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1247  | 
lemma take_bit_flip_bit_eq:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1248  | 
\<open>take_bit n (flip_bit m a) = (if n \<le> m then take_bit n a else flip_bit m (take_bit n a))\<close>  | 
| 80758 | 1249  | 
by (rule bit_eqI) (auto simp: bit_take_bit_iff bit_flip_bit_iff)  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1250  | 
|
| 74497 | 1251  | 
lemma push_bit_Suc_numeral [simp]:  | 
1252  | 
\<open>push_bit (Suc n) (numeral k) = push_bit n (numeral (Num.Bit0 k))\<close>  | 
|
1253  | 
by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0)  | 
|
1254  | 
||
| 74592 | 1255  | 
lemma mask_eq_0_iff [simp]:  | 
1256  | 
\<open>mask n = 0 \<longleftrightarrow> n = 0\<close>  | 
|
1257  | 
by (cases n) (simp_all add: mask_Suc_double or_eq_0_iff)  | 
|
1258  | 
||
| 79017 | 1259  | 
lemma bit_horner_sum_bit_iff [bit_simps]:  | 
1260  | 
  \<open>bit (horner_sum of_bool 2 bs) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n < length bs \<and> bs ! n\<close>
 | 
|
1261  | 
proof (induction bs arbitrary: n)  | 
|
1262  | 
case Nil  | 
|
1263  | 
then show ?case  | 
|
1264  | 
by simp  | 
|
1265  | 
next  | 
|
1266  | 
case (Cons b bs)  | 
|
1267  | 
show ?case  | 
|
1268  | 
proof (cases n)  | 
|
1269  | 
case 0  | 
|
1270  | 
then show ?thesis  | 
|
1271  | 
by (simp add: bit_0)  | 
|
1272  | 
next  | 
|
1273  | 
case (Suc m)  | 
|
1274  | 
with bit_rec [of _ n] Cons.prems Cons.IH [of m]  | 
|
1275  | 
show ?thesis  | 
|
1276  | 
by (simp add: bit_simps)  | 
|
| 80758 | 1277  | 
(auto simp: possible_bit_less_imp bit_simps simp flip: bit_Suc)  | 
| 79017 | 1278  | 
qed  | 
1279  | 
qed  | 
|
1280  | 
||
1281  | 
lemma horner_sum_bit_eq_take_bit:  | 
|
1282  | 
\<open>horner_sum of_bool 2 (map (bit a) [0..<n]) = take_bit n a\<close>  | 
|
| 80758 | 1283  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 79017 | 1284  | 
|
1285  | 
lemma take_bit_horner_sum_bit_eq:  | 
|
1286  | 
\<open>take_bit n (horner_sum of_bool 2 bs) = horner_sum of_bool 2 (take n bs)\<close>  | 
|
| 80758 | 1287  | 
by (auto simp: bit_eq_iff bit_take_bit_iff bit_horner_sum_bit_iff)  | 
| 79017 | 1288  | 
|
1289  | 
lemma take_bit_sum:  | 
|
1290  | 
\<open>take_bit n a = (\<Sum>k = 0..<n. push_bit k (of_bool (bit a k)))\<close>  | 
|
1291  | 
by (simp flip: horner_sum_bit_eq_take_bit add: horner_sum_eq_sum push_bit_eq_mult)  | 
|
1292  | 
||
| 79071 | 1293  | 
lemma set_bit_eq:  | 
1294  | 
\<open>set_bit n a = a + of_bool (\<not> bit a n) * 2 ^ n\<close>  | 
|
1295  | 
proof -  | 
|
| 79610 | 1296  | 
have \<open>a AND of_bool (\<not> bit a n) * 2 ^ n = 0\<close>  | 
| 80758 | 1297  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 79071 | 1298  | 
then show ?thesis  | 
| 80758 | 1299  | 
by (auto simp: bit_eq_iff bit_simps disjunctive_add_eq_or)  | 
| 79071 | 1300  | 
qed  | 
1301  | 
||
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1302  | 
end  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1303  | 
|
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1304  | 
class ring_bit_operations = semiring_bit_operations + ring_parity +  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1305  | 
fixes not :: \<open>'a \<Rightarrow> 'a\<close> (\<open>NOT\<close>)  | 
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1306  | 
assumes not_eq_complement: \<open>NOT a = - a - 1\<close>  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1307  | 
begin  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1308  | 
|
| 71409 | 1309  | 
text \<open>  | 
1310  | 
For the sake of code generation \<^const>\<open>not\<close> is specified as  | 
|
1311  | 
definitional class operation. Note that \<^const>\<open>not\<close> has no  | 
|
1312  | 
sensible definition for unlimited but only positive bit strings  | 
|
1313  | 
(type \<^typ>\<open>nat\<close>).  | 
|
1314  | 
\<close>  | 
|
1315  | 
||
| 71186 | 1316  | 
lemma bits_minus_1_mod_2_eq [simp]:  | 
1317  | 
\<open>(- 1) mod 2 = 1\<close>  | 
|
1318  | 
by (simp add: mod_2_eq_odd)  | 
|
1319  | 
||
| 71409 | 1320  | 
lemma minus_eq_not_plus_1:  | 
1321  | 
\<open>- a = NOT a + 1\<close>  | 
|
1322  | 
using not_eq_complement [of a] by simp  | 
|
1323  | 
||
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1324  | 
lemma minus_eq_not_minus_1:  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1325  | 
\<open>- a = NOT (a - 1)\<close>  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1326  | 
using not_eq_complement [of \<open>a - 1\<close>] by simp (simp add: algebra_simps)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1327  | 
|
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1328  | 
lemma not_rec:  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1329  | 
\<open>NOT a = of_bool (even a) + 2 * NOT (a div 2)\<close>  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1330  | 
by (simp add: not_eq_complement algebra_simps mod_2_eq_odd flip: minus_mod_eq_mult_div)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1331  | 
|
| 79590 | 1332  | 
lemma decr_eq_not_minus:  | 
1333  | 
\<open>a - 1 = NOT (- a)\<close>  | 
|
1334  | 
using not_eq_complement [of \<open>- a\<close>] by simp  | 
|
1335  | 
||
| 71418 | 1336  | 
lemma even_not_iff [simp]:  | 
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1337  | 
\<open>even (NOT a) \<longleftrightarrow> odd a\<close>  | 
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1338  | 
by (simp add: not_eq_complement)  | 
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1339  | 
|
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1340  | 
lemma bit_not_iff [bit_simps]:  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1341  | 
  \<open>bit (NOT a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit a n\<close>
 | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1342  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1343  | 
case False  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1344  | 
then show ?thesis  | 
| 79068 | 1345  | 
by (auto dest: bit_imp_possible_bit)  | 
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1346  | 
next  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1347  | 
case True  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1348  | 
moreover have \<open>bit (NOT a) n \<longleftrightarrow> \<not> bit a n\<close>  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1349  | 
  using \<open>possible_bit TYPE('a) n\<close> proof (induction n arbitrary: a)
 | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1350  | 
case 0  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1351  | 
then show ?case  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1352  | 
by (simp add: bit_0)  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1353  | 
next  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1354  | 
case (Suc n)  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1355  | 
from Suc.prems Suc.IH [of \<open>a div 2\<close>]  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1356  | 
show ?case  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1357  | 
by (simp add: impossible_bit possible_bit_less_imp not_rec [of a] even_bit_succ_iff bit_double_iff flip: bit_Suc)  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1358  | 
qed  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1359  | 
ultimately show ?thesis  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1360  | 
by simp  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1361  | 
qed  | 
| 71418 | 1362  | 
|
| 
72611
 
c7bc3e70a8c7
official collection for bit projection simplifications
 
haftmann 
parents: 
72512 
diff
changeset
 | 
1363  | 
lemma bit_not_exp_iff [bit_simps]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1364  | 
  \<open>bit (NOT (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<noteq> m\<close>
 | 
| 80758 | 1365  | 
by (auto simp: bit_not_iff bit_exp_iff)  | 
| 71409 | 1366  | 
|
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1367  | 
lemma bit_minus_iff [bit_simps]:  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1368  | 
  \<open>bit (- a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit (a - 1) n\<close>
 | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1369  | 
by (simp add: minus_eq_not_minus_1 bit_not_iff)  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1370  | 
|
| 71186 | 1371  | 
lemma bit_minus_1_iff [simp]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1372  | 
  \<open>bit (- 1) n \<longleftrightarrow> possible_bit TYPE('a) n\<close>
 | 
| 71409 | 1373  | 
by (simp add: bit_minus_iff)  | 
1374  | 
||
| 
72611
 
c7bc3e70a8c7
official collection for bit projection simplifications
 
haftmann 
parents: 
72512 
diff
changeset
 | 
1375  | 
lemma bit_minus_exp_iff [bit_simps]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1376  | 
  \<open>bit (- (2 ^ m)) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n \<ge> m\<close>
 | 
| 80758 | 1377  | 
by (auto simp: bit_simps simp flip: mask_eq_exp_minus_1)  | 
| 71409 | 1378  | 
|
1379  | 
lemma bit_minus_2_iff [simp]:  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1380  | 
  \<open>bit (- 2) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> n > 0\<close>
 | 
| 71409 | 1381  | 
by (simp add: bit_minus_iff bit_1_iff)  | 
| 71186 | 1382  | 
|
| 79590 | 1383  | 
lemma bit_decr_iff:  | 
1384  | 
  \<open>bit (a - 1) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> \<not> bit (- a) n\<close>
 | 
|
1385  | 
by (simp add: decr_eq_not_minus bit_not_iff)  | 
|
1386  | 
||
| 
79018
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1387  | 
lemma bit_not_iff_eq:  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1388  | 
\<open>bit (NOT a) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> \<not> bit a n\<close>  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1389  | 
by (simp add: bit_simps possible_bit_def)  | 
| 
 
7449ff77029e
base abstract specification of NOT on recursive equation rather than bit projection
 
haftmann 
parents: 
79017 
diff
changeset
 | 
1390  | 
|
| 74495 | 1391  | 
lemma not_one_eq [simp]:  | 
| 
73969
 
ca2a35c0fe6e
operations for symbolic computation of bit operations
 
haftmann 
parents: 
73871 
diff
changeset
 | 
1392  | 
\<open>NOT 1 = - 2\<close>  | 
| 
81641
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
1393  | 
by (rule bit_eqI, simp add: bit_simps)  | 
| 71418 | 1394  | 
|
1395  | 
sublocale "and": semilattice_neutr \<open>(AND)\<close> \<open>- 1\<close>  | 
|
| 72239 | 1396  | 
by standard (rule bit_eqI, simp add: bit_and_iff)  | 
| 71418 | 1397  | 
|
| 
74123
 
7c5842b06114
clarified abstract and concrete boolean algebras
 
haftmann 
parents: 
74108 
diff
changeset
 | 
1398  | 
sublocale bit: abstract_boolean_algebra \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close>  | 
| 80758 | 1399  | 
by standard (auto simp: bit_and_iff bit_or_iff bit_not_iff intro: bit_eqI)  | 
| 
74123
 
7c5842b06114
clarified abstract and concrete boolean algebras
 
haftmann 
parents: 
74108 
diff
changeset
 | 
1400  | 
|
| 
 
7c5842b06114
clarified abstract and concrete boolean algebras
 
haftmann 
parents: 
74108 
diff
changeset
 | 
1401  | 
sublocale bit: abstract_boolean_algebra_sym_diff \<open>(AND)\<close> \<open>(OR)\<close> NOT 0 \<open>- 1\<close> \<open>(XOR)\<close>  | 
| 80758 | 1402  | 
proof  | 
1403  | 
show \<open>\<And>x y. x XOR y = x AND NOT y OR NOT x AND y\<close>  | 
|
1404  | 
by (intro bit_eqI) (auto simp: bit_simps)  | 
|
1405  | 
qed  | 
|
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1406  | 
|
| 71802 | 1407  | 
lemma and_eq_not_not_or:  | 
1408  | 
\<open>a AND b = NOT (NOT a OR NOT b)\<close>  | 
|
1409  | 
by simp  | 
|
1410  | 
||
1411  | 
lemma or_eq_not_not_and:  | 
|
1412  | 
\<open>a OR b = NOT (NOT a AND NOT b)\<close>  | 
|
1413  | 
by simp  | 
|
1414  | 
||
| 72009 | 1415  | 
lemma not_add_distrib:  | 
1416  | 
\<open>NOT (a + b) = NOT a - b\<close>  | 
|
1417  | 
by (simp add: not_eq_complement algebra_simps)  | 
|
1418  | 
||
1419  | 
lemma not_diff_distrib:  | 
|
1420  | 
\<open>NOT (a - b) = NOT a + b\<close>  | 
|
1421  | 
using not_add_distrib [of a \<open>- b\<close>] by simp  | 
|
1422  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1423  | 
lemma and_eq_minus_1_iff:  | 
| 
72281
 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 
haftmann 
parents: 
72262 
diff
changeset
 | 
1424  | 
\<open>a AND b = - 1 \<longleftrightarrow> a = - 1 \<and> b = - 1\<close>  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
1425  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 
72281
 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 
haftmann 
parents: 
72262 
diff
changeset
 | 
1426  | 
|
| 79610 | 1427  | 
lemma disjunctive_and_not_eq_xor:  | 
1428  | 
\<open>a AND NOT b = a XOR b\<close> if \<open>NOT a AND b = 0\<close>  | 
|
| 80758 | 1429  | 
using that by (auto simp: bit_eq_iff bit_simps)  | 
| 79610 | 1430  | 
|
1431  | 
lemma disjunctive_diff_eq_and_not:  | 
|
1432  | 
\<open>a - b = a AND NOT b\<close> if \<open>NOT a AND b = 0\<close>  | 
|
| 72239 | 1433  | 
proof -  | 
| 79610 | 1434  | 
from that have \<open>NOT a + b = NOT a OR b\<close>  | 
1435  | 
by (rule disjunctive_add_eq_or)  | 
|
| 72239 | 1436  | 
then have \<open>NOT (NOT a + b) = NOT (NOT a OR b)\<close>  | 
1437  | 
by simp  | 
|
1438  | 
then show ?thesis  | 
|
1439  | 
by (simp add: not_add_distrib)  | 
|
1440  | 
qed  | 
|
1441  | 
||
| 79610 | 1442  | 
lemma disjunctive_diff_eq_xor:  | 
1443  | 
\<open>a AND NOT b = a XOR b\<close> if \<open>NOT a AND b = 0\<close>  | 
|
1444  | 
using that by (simp add: disjunctive_and_not_eq_xor disjunctive_diff_eq_and_not)  | 
|
1445  | 
||
| 71412 | 1446  | 
lemma push_bit_minus:  | 
1447  | 
\<open>push_bit n (- a) = - push_bit n a\<close>  | 
|
1448  | 
by (simp add: push_bit_eq_mult)  | 
|
1449  | 
||
| 71409 | 1450  | 
lemma take_bit_not_take_bit:  | 
1451  | 
\<open>take_bit n (NOT (take_bit n a)) = take_bit n (NOT a)\<close>  | 
|
| 80758 | 1452  | 
by (auto simp: bit_eq_iff bit_take_bit_iff bit_not_iff)  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1453  | 
|
| 71418 | 1454  | 
lemma take_bit_not_iff:  | 
| 
73969
 
ca2a35c0fe6e
operations for symbolic computation of bit operations
 
haftmann 
parents: 
73871 
diff
changeset
 | 
1455  | 
\<open>take_bit n (NOT a) = take_bit n (NOT b) \<longleftrightarrow> take_bit n a = take_bit n b\<close>  | 
| 80758 | 1456  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 71418 | 1457  | 
|
| 72262 | 1458  | 
lemma take_bit_not_eq_mask_diff:  | 
1459  | 
\<open>take_bit n (NOT a) = mask n - take_bit n a\<close>  | 
|
1460  | 
proof -  | 
|
| 79610 | 1461  | 
have \<open>NOT (mask n) AND take_bit n a = 0\<close>  | 
1462  | 
by (simp add: bit_eq_iff bit_simps)  | 
|
1463  | 
moreover have \<open>take_bit n (NOT a) = mask n AND NOT (take_bit n a)\<close>  | 
|
| 80758 | 1464  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 79610 | 1465  | 
ultimately show ?thesis  | 
1466  | 
by (simp add: disjunctive_diff_eq_and_not)  | 
|
| 72262 | 1467  | 
qed  | 
1468  | 
||
| 72079 | 1469  | 
lemma mask_eq_take_bit_minus_one:  | 
1470  | 
\<open>mask n = take_bit n (- 1)\<close>  | 
|
1471  | 
by (simp add: bit_eq_iff bit_mask_iff bit_take_bit_iff conj_commute)  | 
|
1472  | 
||
| 74592 | 1473  | 
lemma take_bit_minus_one_eq_mask [simp]:  | 
| 71922 | 1474  | 
\<open>take_bit n (- 1) = mask n\<close>  | 
| 72079 | 1475  | 
by (simp add: mask_eq_take_bit_minus_one)  | 
| 71922 | 1476  | 
|
| 72010 | 1477  | 
lemma minus_exp_eq_not_mask:  | 
1478  | 
\<open>- (2 ^ n) = NOT (mask n)\<close>  | 
|
1479  | 
by (rule bit_eqI) (simp add: bit_minus_iff bit_not_iff flip: mask_eq_exp_minus_1)  | 
|
1480  | 
||
| 74592 | 1481  | 
lemma push_bit_minus_one_eq_not_mask [simp]:  | 
| 71922 | 1482  | 
\<open>push_bit n (- 1) = NOT (mask n)\<close>  | 
| 72010 | 1483  | 
by (simp add: push_bit_eq_mult minus_exp_eq_not_mask)  | 
1484  | 
||
1485  | 
lemma take_bit_not_mask_eq_0:  | 
|
1486  | 
\<open>take_bit m (NOT (mask n)) = 0\<close> if \<open>n \<ge> m\<close>  | 
|
1487  | 
by (rule bit_eqI) (use that in \<open>simp add: bit_take_bit_iff bit_not_iff bit_mask_iff\<close>)  | 
|
| 71922 | 1488  | 
|
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1489  | 
lemma unset_bit_eq_and_not:  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1490  | 
\<open>unset_bit n a = a AND NOT (push_bit n 1)\<close>  | 
| 80758 | 1491  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 71426 | 1492  | 
|
| 74497 | 1493  | 
lemma push_bit_Suc_minus_numeral [simp]:  | 
1494  | 
\<open>push_bit (Suc n) (- numeral k) = push_bit n (- numeral (Num.Bit0 k))\<close>  | 
|
| 80758 | 1495  | 
using local.push_bit_Suc_numeral push_bit_minus by presburger  | 
| 74497 | 1496  | 
|
1497  | 
lemma push_bit_minus_numeral [simp]:  | 
|
1498  | 
\<open>push_bit (numeral l) (- numeral k) = push_bit (pred_numeral l) (- numeral (Num.Bit0 k))\<close>  | 
|
1499  | 
by (simp only: numeral_eq_Suc push_bit_Suc_minus_numeral)  | 
|
1500  | 
||
| 74592 | 1501  | 
lemma take_bit_Suc_minus_1_eq:  | 
| 74498 | 1502  | 
\<open>take_bit (Suc n) (- 1) = 2 ^ Suc n - 1\<close>  | 
| 74592 | 1503  | 
by (simp add: mask_eq_exp_minus_1)  | 
1504  | 
||
1505  | 
lemma take_bit_numeral_minus_1_eq:  | 
|
| 74498 | 1506  | 
\<open>take_bit (numeral k) (- 1) = 2 ^ numeral k - 1\<close>  | 
| 74592 | 1507  | 
by (simp add: mask_eq_exp_minus_1)  | 
1508  | 
||
1509  | 
lemma push_bit_mask_eq:  | 
|
1510  | 
\<open>push_bit m (mask n) = mask (n + m) AND NOT (mask m)\<close>  | 
|
| 80758 | 1511  | 
by (rule bit_eqI) (auto simp: bit_simps not_less possible_bit_less_imp)  | 
| 74592 | 1512  | 
|
1513  | 
lemma slice_eq_mask:  | 
|
1514  | 
\<open>push_bit n (take_bit m (drop_bit n a)) = a AND mask (m + n) AND NOT (mask n)\<close>  | 
|
| 80758 | 1515  | 
by (rule bit_eqI) (auto simp: bit_simps)  | 
| 74592 | 1516  | 
|
1517  | 
lemma push_bit_numeral_minus_1 [simp]:  | 
|
1518  | 
\<open>push_bit (numeral n) (- 1) = - (2 ^ numeral n)\<close>  | 
|
1519  | 
by (simp add: push_bit_eq_mult)  | 
|
| 74498 | 1520  | 
|
| 79071 | 1521  | 
lemma unset_bit_eq:  | 
1522  | 
\<open>unset_bit n a = a - of_bool (bit a n) * 2 ^ n\<close>  | 
|
1523  | 
proof -  | 
|
| 79610 | 1524  | 
have \<open>NOT a AND of_bool (bit a n) * 2 ^ n = 0\<close>  | 
| 80758 | 1525  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 79610 | 1526  | 
moreover have \<open>unset_bit n a = a AND NOT (of_bool (bit a n) * 2 ^ n)\<close>  | 
| 80758 | 1527  | 
by (auto simp: bit_eq_iff bit_simps)  | 
| 79610 | 1528  | 
ultimately show ?thesis  | 
1529  | 
by (simp add: disjunctive_diff_eq_and_not)  | 
|
| 79071 | 1530  | 
qed  | 
1531  | 
||
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1532  | 
end  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1533  | 
|
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1534  | 
|
| 79070 | 1535  | 
subsection \<open>Common algebraic structure\<close>  | 
1536  | 
||
1537  | 
class linordered_euclidean_semiring_bit_operations =  | 
|
1538  | 
linordered_euclidean_semiring + semiring_bit_operations  | 
|
1539  | 
begin  | 
|
1540  | 
||
1541  | 
lemma possible_bit [simp]:  | 
|
1542  | 
  \<open>possible_bit TYPE('a) n\<close>
 | 
|
1543  | 
by (simp add: possible_bit_def)  | 
|
1544  | 
||
1545  | 
lemma take_bit_of_exp [simp]:  | 
|
1546  | 
\<open>take_bit m (2 ^ n) = of_bool (n < m) * 2 ^ n\<close>  | 
|
1547  | 
by (simp add: take_bit_eq_mod exp_mod_exp)  | 
|
1548  | 
||
1549  | 
lemma take_bit_of_2 [simp]:  | 
|
1550  | 
\<open>take_bit n 2 = of_bool (2 \<le> n) * 2\<close>  | 
|
1551  | 
using take_bit_of_exp [of n 1] by simp  | 
|
1552  | 
||
1553  | 
lemma push_bit_eq_0_iff [simp]:  | 
|
1554  | 
\<open>push_bit n a = 0 \<longleftrightarrow> a = 0\<close>  | 
|
1555  | 
by (simp add: push_bit_eq_mult)  | 
|
1556  | 
||
1557  | 
lemma take_bit_add:  | 
|
1558  | 
\<open>take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)\<close>  | 
|
1559  | 
by (simp add: take_bit_eq_mod mod_simps)  | 
|
1560  | 
||
1561  | 
lemma take_bit_of_1_eq_0_iff [simp]:  | 
|
1562  | 
\<open>take_bit n 1 = 0 \<longleftrightarrow> n = 0\<close>  | 
|
1563  | 
by (simp add: take_bit_eq_mod)  | 
|
1564  | 
||
1565  | 
lemma drop_bit_Suc_bit0 [simp]:  | 
|
1566  | 
\<open>drop_bit (Suc n) (numeral (Num.Bit0 k)) = drop_bit n (numeral k)\<close>  | 
|
1567  | 
by (simp add: drop_bit_Suc numeral_Bit0_div_2)  | 
|
1568  | 
||
1569  | 
lemma drop_bit_Suc_bit1 [simp]:  | 
|
1570  | 
\<open>drop_bit (Suc n) (numeral (Num.Bit1 k)) = drop_bit n (numeral k)\<close>  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1571  | 
by (simp add: drop_bit_Suc numeral_Bit0_div_2)  | 
| 79070 | 1572  | 
|
1573  | 
lemma drop_bit_numeral_bit0 [simp]:  | 
|
1574  | 
\<open>drop_bit (numeral l) (numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (numeral k)\<close>  | 
|
1575  | 
by (simp add: drop_bit_rec numeral_Bit0_div_2)  | 
|
1576  | 
||
1577  | 
lemma drop_bit_numeral_bit1 [simp]:  | 
|
1578  | 
\<open>drop_bit (numeral l) (numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (numeral k)\<close>  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1579  | 
by (simp add: drop_bit_rec numeral_Bit0_div_2)  | 
| 79070 | 1580  | 
|
1581  | 
lemma take_bit_Suc_1 [simp]:  | 
|
1582  | 
\<open>take_bit (Suc n) 1 = 1\<close>  | 
|
1583  | 
by (simp add: take_bit_Suc)  | 
|
1584  | 
||
1585  | 
lemma take_bit_Suc_bit0:  | 
|
1586  | 
\<open>take_bit (Suc n) (numeral (Num.Bit0 k)) = take_bit n (numeral k) * 2\<close>  | 
|
1587  | 
by (simp add: take_bit_Suc numeral_Bit0_div_2)  | 
|
1588  | 
||
1589  | 
lemma take_bit_Suc_bit1:  | 
|
1590  | 
\<open>take_bit (Suc n) (numeral (Num.Bit1 k)) = take_bit n (numeral k) * 2 + 1\<close>  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1591  | 
by (simp add: take_bit_Suc numeral_Bit0_div_2 mod_2_eq_odd)  | 
| 79070 | 1592  | 
|
1593  | 
lemma take_bit_numeral_1 [simp]:  | 
|
1594  | 
\<open>take_bit (numeral l) 1 = 1\<close>  | 
|
1595  | 
by (simp add: take_bit_rec [of \<open>numeral l\<close> 1])  | 
|
1596  | 
||
1597  | 
lemma take_bit_numeral_bit0:  | 
|
1598  | 
\<open>take_bit (numeral l) (numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (numeral k) * 2\<close>  | 
|
1599  | 
by (simp add: take_bit_rec numeral_Bit0_div_2)  | 
|
1600  | 
||
1601  | 
lemma take_bit_numeral_bit1:  | 
|
1602  | 
\<open>take_bit (numeral l) (numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (numeral k) * 2 + 1\<close>  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
1603  | 
by (simp add: take_bit_rec numeral_Bit0_div_2 mod_2_eq_odd)  | 
| 79070 | 1604  | 
|
1605  | 
lemma bit_of_nat_iff_bit [bit_simps]:  | 
|
1606  | 
\<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close>  | 
|
1607  | 
proof -  | 
|
1608  | 
have \<open>even (m div 2 ^ n) \<longleftrightarrow> even (of_nat (m div 2 ^ n))\<close>  | 
|
1609  | 
by simp  | 
|
1610  | 
also have \<open>of_nat (m div 2 ^ n) = of_nat m div of_nat (2 ^ n)\<close>  | 
|
1611  | 
by (simp add: of_nat_div)  | 
|
1612  | 
finally show ?thesis  | 
|
1613  | 
by (simp add: bit_iff_odd semiring_bits_class.bit_iff_odd)  | 
|
1614  | 
qed  | 
|
1615  | 
||
1616  | 
lemma drop_bit_mask_eq:  | 
|
1617  | 
\<open>drop_bit m (mask n) = mask (n - m)\<close>  | 
|
| 80758 | 1618  | 
by (rule bit_eqI) (auto simp: bit_simps possible_bit_def)  | 
| 79070 | 1619  | 
|
| 79071 | 1620  | 
lemma bit_push_bit_iff':  | 
1621  | 
\<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> bit a (n - m)\<close>  | 
|
1622  | 
by (simp add: bit_simps)  | 
|
1623  | 
||
1624  | 
lemma mask_half:  | 
|
1625  | 
\<open>mask n div 2 = mask (n - 1)\<close>  | 
|
1626  | 
by (cases n) (simp_all add: mask_Suc_double one_or_eq)  | 
|
1627  | 
||
1628  | 
lemma take_bit_Suc_from_most:  | 
|
1629  | 
\<open>take_bit (Suc n) a = 2 ^ n * of_bool (bit a n) + take_bit n a\<close>  | 
|
1630  | 
using mod_mult2_eq' [of a \<open>2 ^ n\<close> 2]  | 
|
1631  | 
by (simp only: take_bit_eq_mod power_Suc2)  | 
|
1632  | 
(simp_all add: bit_iff_odd odd_iff_mod_2_eq_one)  | 
|
1633  | 
||
1634  | 
lemma take_bit_nonnegative [simp]:  | 
|
1635  | 
\<open>0 \<le> take_bit n a\<close>  | 
|
1636  | 
using horner_sum_nonnegative by (simp flip: horner_sum_bit_eq_take_bit)  | 
|
1637  | 
||
1638  | 
lemma not_take_bit_negative [simp]:  | 
|
1639  | 
\<open>\<not> take_bit n a < 0\<close>  | 
|
1640  | 
by (simp add: not_less)  | 
|
1641  | 
||
1642  | 
lemma bit_imp_take_bit_positive:  | 
|
1643  | 
\<open>0 < take_bit m a\<close> if \<open>n < m\<close> and \<open>bit a n\<close>  | 
|
1644  | 
proof (rule ccontr)  | 
|
1645  | 
assume \<open>\<not> 0 < take_bit m a\<close>  | 
|
1646  | 
then have \<open>take_bit m a = 0\<close>  | 
|
| 80758 | 1647  | 
by (auto simp: not_less intro: order_antisym)  | 
| 79071 | 1648  | 
then have \<open>bit (take_bit m a) n = bit 0 n\<close>  | 
1649  | 
by simp  | 
|
1650  | 
with that show False  | 
|
1651  | 
by (simp add: bit_take_bit_iff)  | 
|
1652  | 
qed  | 
|
1653  | 
||
1654  | 
lemma take_bit_mult:  | 
|
1655  | 
\<open>take_bit n (take_bit n a * take_bit n b) = take_bit n (a * b)\<close>  | 
|
1656  | 
by (simp add: take_bit_eq_mod mod_mult_eq)  | 
|
1657  | 
||
1658  | 
lemma drop_bit_push_bit:  | 
|
1659  | 
\<open>drop_bit m (push_bit n a) = drop_bit (m - n) (push_bit (n - m) a)\<close>  | 
|
1660  | 
by (cases \<open>m \<le> n\<close>)  | 
|
| 80758 | 1661  | 
(auto simp: mult.left_commute [of _ \<open>2 ^ n\<close>] mult.commute [of _ \<open>2 ^ n\<close>] mult.assoc  | 
| 79071 | 1662  | 
mult.commute [of a] drop_bit_eq_div push_bit_eq_mult not_le power_add Orderings.not_le dest!: le_Suc_ex less_imp_Suc_add)  | 
1663  | 
||
| 79070 | 1664  | 
end  | 
1665  | 
||
1666  | 
||
| 71956 | 1667  | 
subsection \<open>Instance \<^typ>\<open>int\<close>\<close>  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1668  | 
|
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1669  | 
locale fold2_bit_int =  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1670  | 
fixes f :: \<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1671  | 
begin  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1672  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1673  | 
context  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1674  | 
begin  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1675  | 
|
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1676  | 
function F :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1677  | 
  where \<open>F k l = (if k \<in> {0, - 1} \<and> l \<in> {0, - 1}
 | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1678  | 
then - of_bool (f (odd k) (odd l))  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1679  | 
else of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (l div 2)))\<close>  | 
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1680  | 
by auto  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1681  | 
|
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1682  | 
private termination proof (relation \<open>measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>)  | 
| 79017 | 1683  | 
have less_eq: \<open>\<bar>k div 2\<bar> \<le> \<bar>k\<bar>\<close> for k :: int  | 
1684  | 
by (cases k) (simp_all add: divide_int_def nat_add_distrib)  | 
|
1685  | 
  then have less: \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close> if \<open>k \<notin> {0, - 1}\<close> for k :: int
 | 
|
| 80758 | 1686  | 
using that by (auto simp: less_le [of k])  | 
| 74101 | 1687  | 
show \<open>wf (measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>)))\<close>  | 
1688  | 
by simp  | 
|
1689  | 
show \<open>((k div 2, l div 2), k, l) \<in> measure (\<lambda>(k, l). nat (\<bar>k\<bar> + \<bar>l\<bar>))\<close>  | 
|
1690  | 
    if \<open>\<not> (k \<in> {0, - 1} \<and> l \<in> {0, - 1})\<close> for k l
 | 
|
1691  | 
proof -  | 
|
1692  | 
    from that have *: \<open>k \<notin> {0, - 1} \<or> l \<notin> {0, - 1}\<close>
 | 
|
1693  | 
by simp  | 
|
1694  | 
then have \<open>0 < \<bar>k\<bar> + \<bar>l\<bar>\<close>  | 
|
1695  | 
by auto  | 
|
1696  | 
moreover from * have \<open>\<bar>k div 2\<bar> + \<bar>l div 2\<bar> < \<bar>k\<bar> + \<bar>l\<bar>\<close>  | 
|
1697  | 
proof  | 
|
1698  | 
      assume \<open>k \<notin> {0, - 1}\<close>
 | 
|
1699  | 
then have \<open>\<bar>k div 2\<bar> < \<bar>k\<bar>\<close>  | 
|
1700  | 
by (rule less)  | 
|
1701  | 
with less_eq [of l] show ?thesis  | 
|
1702  | 
by auto  | 
|
1703  | 
next  | 
|
1704  | 
      assume \<open>l \<notin> {0, - 1}\<close>
 | 
|
1705  | 
then have \<open>\<bar>l div 2\<bar> < \<bar>l\<bar>\<close>  | 
|
1706  | 
by (rule less)  | 
|
1707  | 
with less_eq [of k] show ?thesis  | 
|
1708  | 
by auto  | 
|
1709  | 
qed  | 
|
1710  | 
ultimately show ?thesis  | 
|
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1711  | 
by (simp only: in_measure split_def fst_conv snd_conv nat_mono_iff)  | 
| 74101 | 1712  | 
qed  | 
1713  | 
qed  | 
|
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1714  | 
|
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1715  | 
declare F.simps [simp del]  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1716  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1717  | 
lemma rec:  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1718  | 
\<open>F k l = of_bool (f (odd k) (odd l)) + 2 * (F (k div 2) (l div 2))\<close>  | 
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1719  | 
for k l :: int  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1720  | 
proof (cases \<open>k \<in> {0, - 1} \<and> l \<in> {0, - 1}\<close>)
 | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1721  | 
case True  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1722  | 
then show ?thesis  | 
| 80758 | 1723  | 
by (auto simp: F.simps [of 0] F.simps [of \<open>- 1\<close>])  | 
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1724  | 
next  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1725  | 
case False  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1726  | 
then show ?thesis  | 
| 80758 | 1727  | 
by (auto simp: ac_simps F.simps [of k l])  | 
| 71802 | 1728  | 
qed  | 
1729  | 
||
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1730  | 
lemma bit_iff:  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1731  | 
\<open>bit (F k l) n \<longleftrightarrow> f (bit k n) (bit l n)\<close> for k l :: int  | 
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1732  | 
proof (induction n arbitrary: k l)  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1733  | 
case 0  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1734  | 
then show ?case  | 
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1735  | 
by (simp add: rec [of k l] bit_0)  | 
| 
71804
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1736  | 
next  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1737  | 
case (Suc n)  | 
| 
 
6fd70ed18199
simplified construction of binary bit operations
 
haftmann 
parents: 
71802 
diff
changeset
 | 
1738  | 
then show ?case  | 
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1739  | 
by (simp add: rec [of k l] bit_Suc)  | 
| 71802 | 1740  | 
qed  | 
1741  | 
||
| 
79030
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1742  | 
end  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1743  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1744  | 
end  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1745  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1746  | 
instantiation int :: ring_bit_operations  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1747  | 
begin  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1748  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1749  | 
definition not_int :: \<open>int \<Rightarrow> int\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1750  | 
where \<open>not_int k = - k - 1\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1751  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1752  | 
global_interpretation and_int: fold2_bit_int \<open>(\<and>)\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1753  | 
defines and_int = and_int.F .  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1754  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1755  | 
global_interpretation or_int: fold2_bit_int \<open>(\<or>)\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1756  | 
defines or_int = or_int.F .  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1757  | 
|
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1758  | 
global_interpretation xor_int: fold2_bit_int \<open>(\<noteq>)\<close>  | 
| 
 
bdea2b95817b
more direct characterization of binary bit operations
 
haftmann 
parents: 
79018 
diff
changeset
 | 
1759  | 
defines xor_int = xor_int.F .  | 
| 71802 | 1760  | 
|
| 72082 | 1761  | 
definition mask_int :: \<open>nat \<Rightarrow> int\<close>  | 
1762  | 
where \<open>mask n = (2 :: int) ^ n - 1\<close>  | 
|
1763  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1764  | 
definition push_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1765  | 
where \<open>push_bit_int n k = k * 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1766  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1767  | 
definition drop_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1768  | 
where \<open>drop_bit_int n k = k div 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1769  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1770  | 
definition take_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1771  | 
where \<open>take_bit_int n k = k mod 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1772  | 
|
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1773  | 
definition set_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1774  | 
where \<open>set_bit n k = k OR push_bit n 1\<close> for k :: int  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1775  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1776  | 
definition unset_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1777  | 
where \<open>unset_bit n k = k AND NOT (push_bit n 1)\<close> for k :: int  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1778  | 
|
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1779  | 
definition flip_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close>  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1780  | 
where \<open>flip_bit n k = k XOR push_bit n 1\<close> for k :: int  | 
| 
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1781  | 
|
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1782  | 
lemma not_int_div_2:  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1783  | 
\<open>NOT k div 2 = NOT (k div 2)\<close> for k :: int  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1784  | 
by (simp add: not_int_def)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1785  | 
|
| 79068 | 1786  | 
lemma bit_not_int_iff:  | 
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1787  | 
\<open>bit (NOT k) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1788  | 
proof (rule sym, induction n arbitrary: k)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1789  | 
case 0  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1790  | 
then show ?case  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1791  | 
by (simp add: bit_0 not_int_def)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1792  | 
next  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1793  | 
case (Suc n)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1794  | 
then show ?case  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1795  | 
by (simp add: bit_Suc not_int_div_2)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1796  | 
qed  | 
| 79068 | 1797  | 
|
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1798  | 
instance proof  | 
| 
73682
 
78044b2f001c
explicit type class operations for type-specific implementations
 
haftmann 
parents: 
73535 
diff
changeset
 | 
1799  | 
fix k l :: int and m n :: nat  | 
| 79489 | 1800  | 
show \<open>unset_bit n k = (k OR push_bit n 1) XOR push_bit n 1\<close>  | 
| 
79031
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
1801  | 
by (rule bit_eqI)  | 
| 80758 | 1802  | 
(auto simp: unset_bit_int_def  | 
| 79489 | 1803  | 
and_int.bit_iff or_int.bit_iff xor_int.bit_iff bit_not_int_iff push_bit_int_def bit_simps)  | 
| 
79031
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
1804  | 
qed (fact and_int.rec or_int.rec xor_int.rec mask_int_def set_bit_int_def flip_bit_int_def  | 
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
1805  | 
push_bit_int_def drop_bit_int_def take_bit_int_def not_int_def)+  | 
| 
71042
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1806  | 
|
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1807  | 
end  | 
| 
 
400e9512f1d3
proof-of-concept theory for bit operations without a constructivistic representation and a minimal common logical foundation
 
haftmann 
parents:  
diff
changeset
 | 
1808  | 
|
| 79070 | 1809  | 
instance int :: linordered_euclidean_semiring_bit_operations ..  | 
1810  | 
||
1811  | 
context ring_bit_operations  | 
|
1812  | 
begin  | 
|
1813  | 
||
1814  | 
lemma even_of_int_iff:  | 
|
1815  | 
\<open>even (of_int k) \<longleftrightarrow> even k\<close>  | 
|
1816  | 
by (induction k rule: int_bit_induct) simp_all  | 
|
1817  | 
||
1818  | 
lemma bit_of_int_iff [bit_simps]:  | 
|
1819  | 
  \<open>bit (of_int k) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit k n\<close>
 | 
|
1820  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
|
1821  | 
case False  | 
|
1822  | 
then show ?thesis  | 
|
1823  | 
by (simp add: impossible_bit)  | 
|
1824  | 
next  | 
|
1825  | 
case True  | 
|
1826  | 
then have \<open>bit (of_int k) n \<longleftrightarrow> bit k n\<close>  | 
|
1827  | 
proof (induction k arbitrary: n rule: int_bit_induct)  | 
|
1828  | 
case zero  | 
|
1829  | 
then show ?case  | 
|
1830  | 
by simp  | 
|
1831  | 
next  | 
|
1832  | 
case minus  | 
|
1833  | 
then show ?case  | 
|
1834  | 
by simp  | 
|
1835  | 
next  | 
|
1836  | 
case (even k)  | 
|
1837  | 
then show ?case  | 
|
1838  | 
using bit_double_iff [of \<open>of_int k\<close> n] Bit_Operations.bit_double_iff [of k n]  | 
|
| 80758 | 1839  | 
by (cases n) (auto simp: ac_simps possible_bit_def dest: mult_not_zero)  | 
| 79070 | 1840  | 
next  | 
1841  | 
case (odd k)  | 
|
1842  | 
then show ?case  | 
|
1843  | 
using bit_double_iff [of \<open>of_int k\<close> n]  | 
|
1844  | 
by (cases n)  | 
|
| 80758 | 1845  | 
(auto simp: ac_simps bit_double_iff even_bit_succ_iff Bit_Operations.bit_0 Bit_Operations.bit_Suc  | 
| 79070 | 1846  | 
possible_bit_def dest: mult_not_zero)  | 
1847  | 
qed  | 
|
1848  | 
with True show ?thesis  | 
|
1849  | 
by simp  | 
|
1850  | 
qed  | 
|
1851  | 
||
1852  | 
lemma push_bit_of_int:  | 
|
1853  | 
\<open>push_bit n (of_int k) = of_int (push_bit n k)\<close>  | 
|
1854  | 
by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)  | 
|
1855  | 
||
1856  | 
lemma of_int_push_bit:  | 
|
1857  | 
\<open>of_int (push_bit n k) = push_bit n (of_int k)\<close>  | 
|
1858  | 
by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)  | 
|
1859  | 
||
1860  | 
lemma take_bit_of_int:  | 
|
1861  | 
\<open>take_bit n (of_int k) = of_int (take_bit n k)\<close>  | 
|
1862  | 
by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_int_iff)  | 
|
1863  | 
||
1864  | 
lemma of_int_take_bit:  | 
|
1865  | 
\<open>of_int (take_bit n k) = take_bit n (of_int k)\<close>  | 
|
1866  | 
by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_int_iff)  | 
|
1867  | 
||
1868  | 
lemma of_int_not_eq:  | 
|
1869  | 
\<open>of_int (NOT k) = NOT (of_int k)\<close>  | 
|
1870  | 
by (rule bit_eqI) (simp add: bit_not_iff Bit_Operations.bit_not_iff bit_of_int_iff)  | 
|
1871  | 
||
1872  | 
lemma of_int_not_numeral:  | 
|
1873  | 
\<open>of_int (NOT (numeral k)) = NOT (numeral k)\<close>  | 
|
1874  | 
by (simp add: local.of_int_not_eq)  | 
|
1875  | 
||
1876  | 
lemma of_int_and_eq:  | 
|
1877  | 
\<open>of_int (k AND l) = of_int k AND of_int l\<close>  | 
|
1878  | 
by (rule bit_eqI) (simp add: bit_of_int_iff bit_and_iff Bit_Operations.bit_and_iff)  | 
|
1879  | 
||
1880  | 
lemma of_int_or_eq:  | 
|
1881  | 
\<open>of_int (k OR l) = of_int k OR of_int l\<close>  | 
|
1882  | 
by (rule bit_eqI) (simp add: bit_of_int_iff bit_or_iff Bit_Operations.bit_or_iff)  | 
|
1883  | 
||
1884  | 
lemma of_int_xor_eq:  | 
|
1885  | 
\<open>of_int (k XOR l) = of_int k XOR of_int l\<close>  | 
|
1886  | 
by (rule bit_eqI) (simp add: bit_of_int_iff bit_xor_iff Bit_Operations.bit_xor_iff)  | 
|
1887  | 
||
1888  | 
lemma of_int_mask_eq:  | 
|
1889  | 
\<open>of_int (mask n) = mask n\<close>  | 
|
1890  | 
by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_int_or_eq)  | 
|
1891  | 
||
1892  | 
end  | 
|
1893  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1894  | 
lemma take_bit_int_less_exp [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1895  | 
\<open>take_bit n k < 2 ^ n\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1896  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1897  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1898  | 
lemma take_bit_int_eq_self_iff:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1899  | 
\<open>take_bit n k = k \<longleftrightarrow> 0 \<le> k \<and> k < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1900  | 
for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1901  | 
proof  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1902  | 
assume ?P  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1903  | 
moreover note take_bit_int_less_exp [of n k] take_bit_nonnegative [of n k]  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1904  | 
ultimately show ?Q  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1905  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1906  | 
next  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1907  | 
assume ?Q  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1908  | 
then show ?P  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1909  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1910  | 
qed  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1911  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1912  | 
lemma take_bit_int_eq_self:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1913  | 
\<open>take_bit n k = k\<close> if \<open>0 \<le> k\<close> \<open>k < 2 ^ n\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1914  | 
using that by (simp add: take_bit_int_eq_self_iff)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
1915  | 
|
| 72028 | 1916  | 
lemma mask_nonnegative_int [simp]:  | 
1917  | 
\<open>mask n \<ge> (0::int)\<close>  | 
|
| 79071 | 1918  | 
by (simp add: mask_eq_exp_minus_1 add_le_imp_le_diff)  | 
| 72028 | 1919  | 
|
1920  | 
lemma not_mask_negative_int [simp]:  | 
|
1921  | 
\<open>\<not> mask n < (0::int)\<close>  | 
|
1922  | 
by (simp add: not_less)  | 
|
1923  | 
||
| 71802 | 1924  | 
lemma not_nonnegative_int_iff [simp]:  | 
1925  | 
\<open>NOT k \<ge> 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
|
1926  | 
by (simp add: not_int_def)  | 
|
1927  | 
||
1928  | 
lemma not_negative_int_iff [simp]:  | 
|
1929  | 
\<open>NOT k < 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
|
1930  | 
by (subst Not_eq_iff [symmetric]) (simp add: not_less not_le)  | 
|
1931  | 
||
1932  | 
lemma and_nonnegative_int_iff [simp]:  | 
|
1933  | 
\<open>k AND l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<or> l \<ge> 0\<close> for k l :: int  | 
|
1934  | 
proof (induction k arbitrary: l rule: int_bit_induct)  | 
|
1935  | 
case zero  | 
|
1936  | 
then show ?case  | 
|
1937  | 
by simp  | 
|
1938  | 
next  | 
|
1939  | 
case minus  | 
|
1940  | 
then show ?case  | 
|
1941  | 
by simp  | 
|
1942  | 
next  | 
|
1943  | 
case (even k)  | 
|
1944  | 
then show ?case  | 
|
| 79068 | 1945  | 
using and_int.rec [of \<open>k * 2\<close> l]  | 
| 74101 | 1946  | 
by (simp add: pos_imp_zdiv_nonneg_iff zero_le_mult_iff)  | 
| 71802 | 1947  | 
next  | 
1948  | 
case (odd k)  | 
|
1949  | 
from odd have \<open>0 \<le> k AND l div 2 \<longleftrightarrow> 0 \<le> k \<or> 0 \<le> l div 2\<close>  | 
|
1950  | 
by simp  | 
|
| 74101 | 1951  | 
then have \<open>0 \<le> (1 + k * 2) div 2 AND l div 2 \<longleftrightarrow> 0 \<le> (1 + k * 2) div 2 \<or> 0 \<le> l div 2\<close>  | 
| 71802 | 1952  | 
by simp  | 
| 79068 | 1953  | 
with and_int.rec [of \<open>1 + k * 2\<close> l]  | 
| 71802 | 1954  | 
show ?case  | 
| 80758 | 1955  | 
by (auto simp: zero_le_mult_iff not_le)  | 
| 71802 | 1956  | 
qed  | 
1957  | 
||
1958  | 
lemma and_negative_int_iff [simp]:  | 
|
1959  | 
\<open>k AND l < 0 \<longleftrightarrow> k < 0 \<and> l < 0\<close> for k l :: int  | 
|
1960  | 
by (subst Not_eq_iff [symmetric]) (simp add: not_less)  | 
|
1961  | 
||
| 72009 | 1962  | 
lemma and_less_eq:  | 
1963  | 
\<open>k AND l \<le> k\<close> if \<open>l < 0\<close> for k l :: int  | 
|
1964  | 
using that proof (induction k arbitrary: l rule: int_bit_induct)  | 
|
1965  | 
case zero  | 
|
1966  | 
then show ?case  | 
|
1967  | 
by simp  | 
|
1968  | 
next  | 
|
1969  | 
case minus  | 
|
1970  | 
then show ?case  | 
|
1971  | 
by simp  | 
|
1972  | 
next  | 
|
1973  | 
case (even k)  | 
|
1974  | 
from even.IH [of \<open>l div 2\<close>] even.hyps even.prems  | 
|
1975  | 
show ?case  | 
|
| 79068 | 1976  | 
by (simp add: and_int.rec [of _ l])  | 
| 72009 | 1977  | 
next  | 
1978  | 
case (odd k)  | 
|
1979  | 
from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems  | 
|
1980  | 
show ?case  | 
|
| 79068 | 1981  | 
by (simp add: and_int.rec [of _ l])  | 
| 72009 | 1982  | 
qed  | 
1983  | 
||
| 71802 | 1984  | 
lemma or_nonnegative_int_iff [simp]:  | 
1985  | 
\<open>k OR l \<ge> 0 \<longleftrightarrow> k \<ge> 0 \<and> l \<ge> 0\<close> for k l :: int  | 
|
1986  | 
by (simp only: or_eq_not_not_and not_nonnegative_int_iff) simp  | 
|
1987  | 
||
1988  | 
lemma or_negative_int_iff [simp]:  | 
|
1989  | 
\<open>k OR l < 0 \<longleftrightarrow> k < 0 \<or> l < 0\<close> for k l :: int  | 
|
1990  | 
by (subst Not_eq_iff [symmetric]) (simp add: not_less)  | 
|
1991  | 
||
| 72009 | 1992  | 
lemma or_greater_eq:  | 
1993  | 
\<open>k OR l \<ge> k\<close> if \<open>l \<ge> 0\<close> for k l :: int  | 
|
1994  | 
using that proof (induction k arbitrary: l rule: int_bit_induct)  | 
|
1995  | 
case zero  | 
|
1996  | 
then show ?case  | 
|
1997  | 
by simp  | 
|
1998  | 
next  | 
|
1999  | 
case minus  | 
|
2000  | 
then show ?case  | 
|
2001  | 
by simp  | 
|
2002  | 
next  | 
|
2003  | 
case (even k)  | 
|
2004  | 
from even.IH [of \<open>l div 2\<close>] even.hyps even.prems  | 
|
2005  | 
show ?case  | 
|
| 79068 | 2006  | 
by (simp add: or_int.rec [of _ l])  | 
| 72009 | 2007  | 
next  | 
2008  | 
case (odd k)  | 
|
2009  | 
from odd.IH [of \<open>l div 2\<close>] odd.hyps odd.prems  | 
|
2010  | 
show ?case  | 
|
| 79068 | 2011  | 
by (simp add: or_int.rec [of _ l])  | 
| 72009 | 2012  | 
qed  | 
2013  | 
||
| 71802 | 2014  | 
lemma xor_nonnegative_int_iff [simp]:  | 
2015  | 
\<open>k XOR l \<ge> 0 \<longleftrightarrow> (k \<ge> 0 \<longleftrightarrow> l \<ge> 0)\<close> for k l :: int  | 
|
2016  | 
by (simp only: bit.xor_def or_nonnegative_int_iff) auto  | 
|
2017  | 
||
2018  | 
lemma xor_negative_int_iff [simp]:  | 
|
2019  | 
\<open>k XOR l < 0 \<longleftrightarrow> (k < 0) \<noteq> (l < 0)\<close> for k l :: int  | 
|
| 80758 | 2020  | 
by (subst Not_eq_iff [symmetric]) (auto simp: not_less)  | 
| 71802 | 2021  | 
|
| 72488 | 2022  | 
lemma OR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
| 79017 | 2023  | 
\<open>x OR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int  | 
2024  | 
using that proof (induction x arbitrary: y n rule: int_bit_induct)  | 
|
| 72488 | 2025  | 
case zero  | 
2026  | 
then show ?case  | 
|
2027  | 
by simp  | 
|
2028  | 
next  | 
|
2029  | 
case minus  | 
|
2030  | 
then show ?case  | 
|
2031  | 
by simp  | 
|
2032  | 
next  | 
|
2033  | 
case (even x)  | 
|
2034  | 
from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps  | 
|
| 79068 | 2035  | 
show ?case  | 
| 80758 | 2036  | 
by (cases n) (auto simp: or_int.rec [of \<open>_ * 2\<close>] elim: oddE)  | 
| 72488 | 2037  | 
next  | 
2038  | 
case (odd x)  | 
|
2039  | 
from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps  | 
|
2040  | 
show ?case  | 
|
| 80758 | 2041  | 
by (cases n) (auto simp: or_int.rec [of \<open>1 + _ * 2\<close>], linarith)  | 
| 72488 | 2042  | 
qed  | 
2043  | 
||
2044  | 
lemma XOR_upper: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2045  | 
\<open>x XOR y < 2 ^ n\<close> if \<open>0 \<le> x\<close> \<open>x < 2 ^ n\<close> \<open>y < 2 ^ n\<close> for x y :: int  | 
2046  | 
using that proof (induction x arbitrary: y n rule: int_bit_induct)  | 
|
| 72488 | 2047  | 
case zero  | 
2048  | 
then show ?case  | 
|
2049  | 
by simp  | 
|
2050  | 
next  | 
|
2051  | 
case minus  | 
|
2052  | 
then show ?case  | 
|
2053  | 
by simp  | 
|
2054  | 
next  | 
|
2055  | 
case (even x)  | 
|
2056  | 
from even.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] even.prems even.hyps  | 
|
| 79068 | 2057  | 
show ?case  | 
| 80758 | 2058  | 
by (cases n) (auto simp: xor_int.rec [of \<open>_ * 2\<close>] elim: oddE)  | 
| 72488 | 2059  | 
next  | 
2060  | 
case (odd x)  | 
|
2061  | 
from odd.IH [of \<open>n - 1\<close> \<open>y div 2\<close>] odd.prems odd.hyps  | 
|
2062  | 
show ?case  | 
|
| 80758 | 2063  | 
by (cases n) (auto simp: xor_int.rec [of \<open>1 + _ * 2\<close>])  | 
| 72488 | 2064  | 
qed  | 
2065  | 
||
2066  | 
lemma AND_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2067  | 
\<open>0 \<le> x AND y\<close> if \<open>0 \<le> x\<close> for x y :: int  | 
2068  | 
using that by simp  | 
|
| 72488 | 2069  | 
|
2070  | 
lemma OR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2071  | 
\<open>0 \<le> x OR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int  | 
2072  | 
using that by simp  | 
|
| 72488 | 2073  | 
|
2074  | 
lemma XOR_lower [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2075  | 
\<open>0 \<le> x XOR y\<close> if \<open>0 \<le> x\<close> \<open>0 \<le> y\<close> for x y :: int  | 
2076  | 
using that by simp  | 
|
| 72488 | 2077  | 
|
2078  | 
lemma AND_upper1 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2079  | 
\<open>x AND y \<le> x\<close> if \<open>0 \<le> x\<close> for x y :: int  | 
2080  | 
using that proof (induction x arbitrary: y rule: int_bit_induct)  | 
|
| 73535 | 2081  | 
case (odd k)  | 
2082  | 
then have \<open>k AND y div 2 \<le> k\<close>  | 
|
2083  | 
by simp  | 
|
| 79068 | 2084  | 
then show ?case  | 
2085  | 
by (simp add: and_int.rec [of \<open>1 + _ * 2\<close>])  | 
|
2086  | 
qed (simp_all add: and_int.rec [of \<open>_ * 2\<close>])  | 
|
| 72488 | 2087  | 
|
| 79017 | 2088  | 
lemma AND_upper1' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
2089  | 
\<open>y AND x \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y z :: int  | 
|
2090  | 
using _ \<open>y \<le> z\<close> by (rule order_trans) (use \<open>0 \<le> y\<close> in simp)  | 
|
2091  | 
||
2092  | 
lemma AND_upper1'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
2093  | 
\<open>y AND x < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y z :: int  | 
|
2094  | 
using _ \<open>y < z\<close> by (rule order_le_less_trans) (use \<open>0 \<le> y\<close> in simp)  | 
|
| 72488 | 2095  | 
|
2096  | 
lemma AND_upper2 [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
| 79017 | 2097  | 
\<open>x AND y \<le> y\<close> if \<open>0 \<le> y\<close> for x y :: int  | 
2098  | 
using that AND_upper1 [of y x] by (simp add: ac_simps)  | 
|
2099  | 
||
2100  | 
lemma AND_upper2' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
2101  | 
\<open>x AND y \<le> z\<close> if \<open>0 \<le> y\<close> \<open>y \<le> z\<close> for x y :: int  | 
|
2102  | 
using that AND_upper1' [of y z x] by (simp add: ac_simps)  | 
|
2103  | 
||
2104  | 
lemma AND_upper2'' [simp]: \<^marker>\<open>contributor \<open>Stefan Berghofer\<close>\<close>  | 
|
2105  | 
\<open>x AND y < z\<close> if \<open>0 \<le> y\<close> \<open>y < z\<close> for x y :: int  | 
|
2106  | 
using that AND_upper1'' [of y z x] by (simp add: ac_simps)  | 
|
2107  | 
||
2108  | 
lemma plus_and_or:  | 
|
2109  | 
\<open>(x AND y) + (x OR y) = x + y\<close> for x y :: int  | 
|
| 72488 | 2110  | 
proof (induction x arbitrary: y rule: int_bit_induct)  | 
2111  | 
case zero  | 
|
2112  | 
then show ?case  | 
|
2113  | 
by simp  | 
|
2114  | 
next  | 
|
2115  | 
case minus  | 
|
2116  | 
then show ?case  | 
|
2117  | 
by simp  | 
|
2118  | 
next  | 
|
2119  | 
case (even x)  | 
|
2120  | 
from even.IH [of \<open>y div 2\<close>]  | 
|
2121  | 
show ?case  | 
|
| 80758 | 2122  | 
by (auto simp: and_int.rec [of _ y] or_int.rec [of _ y] elim: oddE)  | 
| 72488 | 2123  | 
next  | 
2124  | 
case (odd x)  | 
|
2125  | 
from odd.IH [of \<open>y div 2\<close>]  | 
|
2126  | 
show ?case  | 
|
| 80758 | 2127  | 
by (auto simp: and_int.rec [of _ y] or_int.rec [of _ y] elim: oddE)  | 
| 72488 | 2128  | 
qed  | 
2129  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2130  | 
lemma push_bit_minus_one:  | 
| 79017 | 2131  | 
\<open>push_bit n (- 1 :: int) = - (2 ^ n)\<close>  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2132  | 
by (simp add: push_bit_eq_mult)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2133  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2134  | 
lemma minus_1_div_exp_eq_int:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2135  | 
\<open>- 1 div (2 :: int) ^ n = - 1\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2136  | 
by (induction n) (use div_exp_eq [symmetric, of \<open>- 1 :: int\<close> 1] in \<open>simp_all add: ac_simps\<close>)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2137  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2138  | 
lemma drop_bit_minus_one [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2139  | 
\<open>drop_bit n (- 1 :: int) = - 1\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2140  | 
by (simp add: drop_bit_eq_div minus_1_div_exp_eq_int)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2141  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2142  | 
lemma take_bit_minus:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2143  | 
\<open>take_bit n (- take_bit n k) = take_bit n (- k)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2144  | 
for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2145  | 
by (simp add: take_bit_eq_mod mod_minus_eq)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2146  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2147  | 
lemma take_bit_diff:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2148  | 
\<open>take_bit n (take_bit n k - take_bit n l) = take_bit n (k - l)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2149  | 
for k l :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2150  | 
by (simp add: take_bit_eq_mod mod_diff_eq)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2151  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2152  | 
lemma (in ring_1) of_nat_nat_take_bit_eq [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2153  | 
\<open>of_nat (nat (take_bit n k)) = of_int (take_bit n k)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2154  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2155  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2156  | 
lemma take_bit_minus_small_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2157  | 
\<open>take_bit n (- k) = 2 ^ n - k\<close> if \<open>0 < k\<close> \<open>k \<le> 2 ^ n\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2158  | 
proof -  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2159  | 
define m where \<open>m = nat k\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2160  | 
with that have \<open>k = int m\<close> and \<open>0 < m\<close> and \<open>m \<le> 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2161  | 
by simp_all  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2162  | 
have \<open>(2 ^ n - m) mod 2 ^ n = 2 ^ n - m\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2163  | 
using \<open>0 < m\<close> by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2164  | 
then have \<open>int ((2 ^ n - m) mod 2 ^ n) = int (2 ^ n - m)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2165  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2166  | 
then have \<open>(2 ^ n - int m) mod 2 ^ n = 2 ^ n - int m\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2167  | 
using \<open>m \<le> 2 ^ n\<close> by (simp only: of_nat_mod of_nat_diff) simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2168  | 
with \<open>k = int m\<close> have \<open>(2 ^ n - k) mod 2 ^ n = 2 ^ n - k\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2169  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2170  | 
then show ?thesis  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2171  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2172  | 
qed  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2173  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2174  | 
lemma push_bit_nonnegative_int_iff [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2175  | 
\<open>push_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2176  | 
by (simp add: push_bit_eq_mult zero_le_mult_iff power_le_zero_eq)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2177  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2178  | 
lemma push_bit_negative_int_iff [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2179  | 
\<open>push_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2180  | 
by (subst Not_eq_iff [symmetric]) (simp add: not_less)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2181  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2182  | 
lemma drop_bit_nonnegative_int_iff [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2183  | 
\<open>drop_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
| 80758 | 2184  | 
by (induction n) (auto simp: drop_bit_Suc drop_bit_half)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2185  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2186  | 
lemma drop_bit_negative_int_iff [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2187  | 
\<open>drop_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2188  | 
by (subst Not_eq_iff [symmetric]) (simp add: not_less)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2189  | 
|
| 71802 | 2190  | 
lemma set_bit_nonnegative_int_iff [simp]:  | 
2191  | 
\<open>set_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
|
| 79068 | 2192  | 
by (simp add: set_bit_eq_or)  | 
| 71802 | 2193  | 
|
2194  | 
lemma set_bit_negative_int_iff [simp]:  | 
|
2195  | 
\<open>set_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
|
| 79068 | 2196  | 
by (simp add: set_bit_eq_or)  | 
| 71802 | 2197  | 
|
2198  | 
lemma unset_bit_nonnegative_int_iff [simp]:  | 
|
2199  | 
\<open>unset_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
|
| 79068 | 2200  | 
by (simp add: unset_bit_eq_and_not)  | 
| 71802 | 2201  | 
|
2202  | 
lemma unset_bit_negative_int_iff [simp]:  | 
|
2203  | 
\<open>unset_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
|
| 79068 | 2204  | 
by (simp add: unset_bit_eq_and_not)  | 
| 71802 | 2205  | 
|
2206  | 
lemma flip_bit_nonnegative_int_iff [simp]:  | 
|
2207  | 
\<open>flip_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int  | 
|
| 79068 | 2208  | 
by (simp add: flip_bit_eq_xor)  | 
| 71802 | 2209  | 
|
2210  | 
lemma flip_bit_negative_int_iff [simp]:  | 
|
2211  | 
\<open>flip_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int  | 
|
| 79068 | 2212  | 
by (simp add: flip_bit_eq_xor)  | 
| 71802 | 2213  | 
|
| 71986 | 2214  | 
lemma set_bit_greater_eq:  | 
2215  | 
\<open>set_bit n k \<ge> k\<close> for k :: int  | 
|
| 79068 | 2216  | 
by (simp add: set_bit_eq_or or_greater_eq)  | 
| 71986 | 2217  | 
|
2218  | 
lemma unset_bit_less_eq:  | 
|
2219  | 
\<open>unset_bit n k \<le> k\<close> for k :: int  | 
|
| 79068 | 2220  | 
by (simp add: unset_bit_eq_and_not and_less_eq)  | 
| 71986 | 2221  | 
|
| 
75651
 
f4116b7a6679
Move code lemmas for symbolic computation of bit operations on int to distribution.
 
haftmann 
parents: 
75138 
diff
changeset
 | 
2222  | 
lemma and_int_unfold:  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2223  | 
\<open>k AND l = (if k = 0 \<or> l = 0 then 0 else if k = - 1 then l else if l = - 1 then k  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2224  | 
else (k mod 2) * (l mod 2) + 2 * ((k div 2) AND (l div 2)))\<close> for k l :: int  | 
| 80758 | 2225  | 
by (auto simp: and_int.rec [of k l] zmult_eq_1_iff elim: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2226  | 
|
| 
75651
 
f4116b7a6679
Move code lemmas for symbolic computation of bit operations on int to distribution.
 
haftmann 
parents: 
75138 
diff
changeset
 | 
2227  | 
lemma or_int_unfold:  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2228  | 
\<open>k OR l = (if k = - 1 \<or> l = - 1 then - 1 else if k = 0 then l else if l = 0 then k  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2229  | 
else max (k mod 2) (l mod 2) + 2 * ((k div 2) OR (l div 2)))\<close> for k l :: int  | 
| 80758 | 2230  | 
by (auto simp: or_int.rec [of k l] elim: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2231  | 
|
| 
75651
 
f4116b7a6679
Move code lemmas for symbolic computation of bit operations on int to distribution.
 
haftmann 
parents: 
75138 
diff
changeset
 | 
2232  | 
lemma xor_int_unfold:  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2233  | 
\<open>k XOR l = (if k = - 1 then NOT l else if l = - 1 then NOT k else if k = 0 then l else if l = 0 then k  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2234  | 
else \<bar>k mod 2 - l mod 2\<bar> + 2 * ((k div 2) XOR (l div 2)))\<close> for k l :: int  | 
| 80758 | 2235  | 
by (auto simp: xor_int.rec [of k l] not_int_def elim!: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2236  | 
|
| 74163 | 2237  | 
lemma bit_minus_int_iff:  | 
| 79017 | 2238  | 
\<open>bit (- k) n \<longleftrightarrow> bit (NOT (k - 1)) n\<close> for k :: int  | 
| 74163 | 2239  | 
by (simp add: bit_simps)  | 
2240  | 
||
| 74592 | 2241  | 
lemma take_bit_incr_eq:  | 
| 79017 | 2242  | 
\<open>take_bit n (k + 1) = 1 + take_bit n k\<close> if \<open>take_bit n k \<noteq> 2 ^ n - 1\<close> for k :: int  | 
| 74592 | 2243  | 
proof -  | 
2244  | 
from that have \<open>2 ^ n \<noteq> k mod 2 ^ n + 1\<close>  | 
|
2245  | 
by (simp add: take_bit_eq_mod)  | 
|
2246  | 
moreover have \<open>k mod 2 ^ n < 2 ^ n\<close>  | 
|
2247  | 
by simp  | 
|
2248  | 
ultimately have *: \<open>k mod 2 ^ n + 1 < 2 ^ n\<close>  | 
|
2249  | 
by linarith  | 
|
2250  | 
have \<open>(k + 1) mod 2 ^ n = (k mod 2 ^ n + 1) mod 2 ^ n\<close>  | 
|
2251  | 
by (simp add: mod_simps)  | 
|
2252  | 
also have \<open>\<dots> = k mod 2 ^ n + 1\<close>  | 
|
2253  | 
using * by (simp add: zmod_trivial_iff)  | 
|
2254  | 
finally have \<open>(k + 1) mod 2 ^ n = k mod 2 ^ n + 1\<close> .  | 
|
2255  | 
then show ?thesis  | 
|
2256  | 
by (simp add: take_bit_eq_mod)  | 
|
2257  | 
qed  | 
|
2258  | 
||
2259  | 
lemma take_bit_decr_eq:  | 
|
| 79017 | 2260  | 
\<open>take_bit n (k - 1) = take_bit n k - 1\<close> if \<open>take_bit n k \<noteq> 0\<close> for k :: int  | 
| 74592 | 2261  | 
proof -  | 
2262  | 
from that have \<open>k mod 2 ^ n \<noteq> 0\<close>  | 
|
2263  | 
by (simp add: take_bit_eq_mod)  | 
|
2264  | 
moreover have \<open>k mod 2 ^ n \<ge> 0\<close> \<open>k mod 2 ^ n < 2 ^ n\<close>  | 
|
2265  | 
by simp_all  | 
|
2266  | 
ultimately have *: \<open>k mod 2 ^ n > 0\<close>  | 
|
2267  | 
by linarith  | 
|
2268  | 
have \<open>(k - 1) mod 2 ^ n = (k mod 2 ^ n - 1) mod 2 ^ n\<close>  | 
|
2269  | 
by (simp add: mod_simps)  | 
|
2270  | 
also have \<open>\<dots> = k mod 2 ^ n - 1\<close>  | 
|
2271  | 
by (simp add: zmod_trivial_iff)  | 
|
2272  | 
(use \<open>k mod 2 ^ n < 2 ^ n\<close> * in linarith)  | 
|
2273  | 
finally have \<open>(k - 1) mod 2 ^ n = k mod 2 ^ n - 1\<close> .  | 
|
2274  | 
then show ?thesis  | 
|
2275  | 
by (simp add: take_bit_eq_mod)  | 
|
2276  | 
qed  | 
|
2277  | 
||
2278  | 
lemma take_bit_int_greater_eq:  | 
|
2279  | 
\<open>k + 2 ^ n \<le> take_bit n k\<close> if \<open>k < 0\<close> for k :: int  | 
|
2280  | 
proof -  | 
|
2281  | 
have \<open>k + 2 ^ n \<le> take_bit n (k + 2 ^ n)\<close>  | 
|
2282  | 
proof (cases \<open>k > - (2 ^ n)\<close>)  | 
|
2283  | 
case False  | 
|
2284  | 
then have \<open>k + 2 ^ n \<le> 0\<close>  | 
|
2285  | 
by simp  | 
|
2286  | 
also note take_bit_nonnegative  | 
|
2287  | 
finally show ?thesis .  | 
|
2288  | 
next  | 
|
2289  | 
case True  | 
|
2290  | 
with that have \<open>0 \<le> k + 2 ^ n\<close> and \<open>k + 2 ^ n < 2 ^ n\<close>  | 
|
2291  | 
by simp_all  | 
|
2292  | 
then show ?thesis  | 
|
2293  | 
by (simp only: take_bit_eq_mod mod_pos_pos_trivial)  | 
|
2294  | 
qed  | 
|
2295  | 
then show ?thesis  | 
|
2296  | 
by (simp add: take_bit_eq_mod)  | 
|
2297  | 
qed  | 
|
2298  | 
||
2299  | 
lemma take_bit_int_less_eq:  | 
|
2300  | 
\<open>take_bit n k \<le> k - 2 ^ n\<close> if \<open>2 ^ n \<le> k\<close> and \<open>n > 0\<close> for k :: int  | 
|
2301  | 
using that zmod_le_nonneg_dividend [of \<open>k - 2 ^ n\<close> \<open>2 ^ n\<close>]  | 
|
2302  | 
by (simp add: take_bit_eq_mod)  | 
|
2303  | 
||
2304  | 
lemma take_bit_int_less_eq_self_iff:  | 
|
| 79017 | 2305  | 
\<open>take_bit n k \<le> k \<longleftrightarrow> 0 \<le> k\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for k :: int  | 
| 74592 | 2306  | 
proof  | 
2307  | 
assume ?P  | 
|
2308  | 
show ?Q  | 
|
2309  | 
proof (rule ccontr)  | 
|
2310  | 
assume \<open>\<not> 0 \<le> k\<close>  | 
|
2311  | 
then have \<open>k < 0\<close>  | 
|
2312  | 
by simp  | 
|
2313  | 
with \<open>?P\<close>  | 
|
2314  | 
have \<open>take_bit n k < 0\<close>  | 
|
2315  | 
by (rule le_less_trans)  | 
|
2316  | 
then show False  | 
|
2317  | 
by simp  | 
|
2318  | 
qed  | 
|
2319  | 
next  | 
|
2320  | 
assume ?Q  | 
|
2321  | 
then show ?P  | 
|
2322  | 
by (simp add: take_bit_eq_mod zmod_le_nonneg_dividend)  | 
|
2323  | 
qed  | 
|
2324  | 
||
2325  | 
lemma take_bit_int_less_self_iff:  | 
|
| 79017 | 2326  | 
\<open>take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close> for k :: int  | 
| 80758 | 2327  | 
by (auto simp: less_le take_bit_int_less_eq_self_iff take_bit_int_eq_self_iff  | 
| 74592 | 2328  | 
intro: order_trans [of 0 \<open>2 ^ n\<close> k])  | 
2329  | 
||
2330  | 
lemma take_bit_int_greater_self_iff:  | 
|
| 79017 | 2331  | 
\<open>k < take_bit n k \<longleftrightarrow> k < 0\<close> for k :: int  | 
| 74592 | 2332  | 
using take_bit_int_less_eq_self_iff [of n k] by auto  | 
2333  | 
||
2334  | 
lemma take_bit_int_greater_eq_self_iff:  | 
|
| 79017 | 2335  | 
\<open>k \<le> take_bit n k \<longleftrightarrow> k < 2 ^ n\<close> for k :: int  | 
| 80758 | 2336  | 
by (auto simp: le_less take_bit_int_greater_self_iff take_bit_int_eq_self_iff  | 
| 74592 | 2337  | 
dest: sym not_sym intro: less_trans [of k 0 \<open>2 ^ n\<close>])  | 
2338  | 
||
| 79070 | 2339  | 
lemma take_bit_tightened_less_eq_int:  | 
2340  | 
\<open>take_bit m k \<le> take_bit n k\<close> if \<open>m \<le> n\<close> for k :: int  | 
|
2341  | 
proof -  | 
|
2342  | 
have \<open>take_bit m (take_bit n k) \<le> take_bit n k\<close>  | 
|
2343  | 
by (simp only: take_bit_int_less_eq_self_iff take_bit_nonnegative)  | 
|
2344  | 
with that show ?thesis  | 
|
2345  | 
by simp  | 
|
2346  | 
qed  | 
|
2347  | 
||
| 74592 | 2348  | 
lemma not_exp_less_eq_0_int [simp]:  | 
2349  | 
\<open>\<not> 2 ^ n \<le> (0::int)\<close>  | 
|
2350  | 
by (simp add: power_le_zero_eq)  | 
|
2351  | 
||
2352  | 
lemma int_bit_bound:  | 
|
2353  | 
fixes k :: int  | 
|
2354  | 
obtains n where \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>  | 
|
2355  | 
and \<open>n > 0 \<Longrightarrow> bit k (n - 1) \<noteq> bit k n\<close>  | 
|
2356  | 
proof -  | 
|
2357  | 
obtain q where *: \<open>\<And>m. q \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k q\<close>  | 
|
2358  | 
proof (cases \<open>k \<ge> 0\<close>)  | 
|
2359  | 
case True  | 
|
2360  | 
moreover from power_gt_expt [of 2 \<open>nat k\<close>]  | 
|
2361  | 
have \<open>nat k < 2 ^ nat k\<close>  | 
|
2362  | 
by simp  | 
|
2363  | 
then have \<open>int (nat k) < int (2 ^ nat k)\<close>  | 
|
2364  | 
by (simp only: of_nat_less_iff)  | 
|
2365  | 
ultimately have *: \<open>k div 2 ^ nat k = 0\<close>  | 
|
2366  | 
by simp  | 
|
2367  | 
show thesis  | 
|
2368  | 
proof (rule that [of \<open>nat k\<close>])  | 
|
2369  | 
fix m  | 
|
2370  | 
assume \<open>nat k \<le> m\<close>  | 
|
2371  | 
then show \<open>bit k m \<longleftrightarrow> bit k (nat k)\<close>  | 
|
| 80758 | 2372  | 
by (auto simp: * bit_iff_odd power_add zdiv_zmult2_eq dest!: le_Suc_ex)  | 
| 74592 | 2373  | 
qed  | 
2374  | 
next  | 
|
2375  | 
case False  | 
|
2376  | 
moreover from power_gt_expt [of 2 \<open>nat (- k)\<close>]  | 
|
2377  | 
have \<open>nat (- k) < 2 ^ nat (- k)\<close>  | 
|
2378  | 
by simp  | 
|
2379  | 
then have \<open>int (nat (- k)) < int (2 ^ nat (- k))\<close>  | 
|
2380  | 
by (simp only: of_nat_less_iff)  | 
|
2381  | 
ultimately have \<open>- k div - (2 ^ nat (- k)) = - 1\<close>  | 
|
2382  | 
by (subst div_pos_neg_trivial) simp_all  | 
|
2383  | 
then have *: \<open>k div 2 ^ nat (- k) = - 1\<close>  | 
|
2384  | 
by simp  | 
|
2385  | 
show thesis  | 
|
2386  | 
proof (rule that [of \<open>nat (- k)\<close>])  | 
|
2387  | 
fix m  | 
|
2388  | 
assume \<open>nat (- k) \<le> m\<close>  | 
|
2389  | 
then show \<open>bit k m \<longleftrightarrow> bit k (nat (- k))\<close>  | 
|
| 80758 | 2390  | 
by (auto simp: * bit_iff_odd power_add zdiv_zmult2_eq minus_1_div_exp_eq_int dest!: le_Suc_ex)  | 
| 74592 | 2391  | 
qed  | 
2392  | 
qed  | 
|
2393  | 
show thesis  | 
|
2394  | 
proof (cases \<open>\<forall>m. bit k m \<longleftrightarrow> bit k q\<close>)  | 
|
2395  | 
case True  | 
|
2396  | 
then have \<open>bit k 0 \<longleftrightarrow> bit k q\<close>  | 
|
2397  | 
by blast  | 
|
2398  | 
with True that [of 0] show thesis  | 
|
2399  | 
by simp  | 
|
2400  | 
next  | 
|
2401  | 
case False  | 
|
2402  | 
then obtain r where **: \<open>bit k r \<noteq> bit k q\<close>  | 
|
2403  | 
by blast  | 
|
2404  | 
have \<open>r < q\<close>  | 
|
2405  | 
by (rule ccontr) (use * [of r] ** in simp)  | 
|
2406  | 
    define N where \<open>N = {n. n < q \<and> bit k n \<noteq> bit k q}\<close>
 | 
|
2407  | 
moreover have \<open>finite N\<close> \<open>r \<in> N\<close>  | 
|
2408  | 
using ** N_def \<open>r < q\<close> by auto  | 
|
2409  | 
moreover define n where \<open>n = Suc (Max N)\<close>  | 
|
| 80758 | 2410  | 
ultimately have \<dagger>: \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m \<longleftrightarrow> bit k n\<close>  | 
2411  | 
by (smt (verit) "*" Max_ge Suc_n_not_le_n linorder_not_less mem_Collect_eq not_less_eq_eq)  | 
|
| 74592 | 2412  | 
have \<open>bit k (Max N) \<noteq> bit k n\<close>  | 
2413  | 
by (metis (mono_tags, lifting) "*" Max_in N_def \<open>\<And>m. n \<le> m \<Longrightarrow> bit k m = bit k n\<close> \<open>finite N\<close> \<open>r \<in> N\<close> empty_iff le_cases mem_Collect_eq)  | 
|
| 80758 | 2414  | 
with \<dagger> n_def that [of n] show thesis  | 
2415  | 
by fastforce  | 
|
| 74592 | 2416  | 
qed  | 
2417  | 
qed  | 
|
2418  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2419  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2420  | 
subsection \<open>Instance \<^typ>\<open>nat\<close>\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2421  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2422  | 
instantiation nat :: semiring_bit_operations  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2423  | 
begin  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2424  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2425  | 
definition and_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2426  | 
where \<open>m AND n = nat (int m AND int n)\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2427  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2428  | 
definition or_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2429  | 
where \<open>m OR n = nat (int m OR int n)\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2430  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2431  | 
definition xor_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2432  | 
where \<open>m XOR n = nat (int m XOR int n)\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2433  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2434  | 
definition mask_nat :: \<open>nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2435  | 
where \<open>mask n = (2 :: nat) ^ n - 1\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2436  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2437  | 
definition push_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2438  | 
where \<open>push_bit_nat n m = m * 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2439  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2440  | 
definition drop_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2441  | 
where \<open>drop_bit_nat n m = m div 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2442  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2443  | 
definition take_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2444  | 
where \<open>take_bit_nat n m = m mod 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2445  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2446  | 
definition set_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2447  | 
where \<open>set_bit m n = n OR push_bit m 1\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2448  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2449  | 
definition unset_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 79489 | 2450  | 
where \<open>unset_bit m n = (n OR push_bit m 1) XOR push_bit m 1\<close> for m n :: nat  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2451  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2452  | 
definition flip_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2453  | 
where \<open>flip_bit m n = n XOR push_bit m 1\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2454  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2455  | 
instance proof  | 
| 
79031
 
4596a14d9a95
slightly more elementary characterization of unset_bit
 
haftmann 
parents: 
79030 
diff
changeset
 | 
2456  | 
fix m n :: nat  | 
| 
79008
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2457  | 
show \<open>m AND n = of_bool (odd m \<and> odd n) + 2 * (m div 2 AND n div 2)\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2458  | 
by (simp add: and_nat_def and_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2459  | 
show \<open>m OR n = of_bool (odd m \<or> odd n) + 2 * (m div 2 OR n div 2)\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2460  | 
by (simp add: or_nat_def or_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2461  | 
show \<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * (m div 2 XOR n div 2)\<close>  | 
| 
 
74a4776f7a22
operations AND, OR, XOR are specified by characteristic recursive equation
 
haftmann 
parents: 
78955 
diff
changeset
 | 
2462  | 
by (simp add: xor_nat_def xor_rec [of \<open>int m\<close> \<open>int n\<close>] nat_add_distrib of_nat_div)  | 
| 79489 | 2463  | 
qed (simp_all add: mask_nat_def set_bit_nat_def unset_bit_nat_def flip_bit_nat_def  | 
2464  | 
push_bit_nat_def drop_bit_nat_def take_bit_nat_def)  | 
|
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2465  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2466  | 
end  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2467  | 
|
| 79070 | 2468  | 
instance nat :: linordered_euclidean_semiring_bit_operations ..  | 
2469  | 
||
2470  | 
context semiring_bit_operations  | 
|
2471  | 
begin  | 
|
2472  | 
||
2473  | 
lemma push_bit_of_nat:  | 
|
2474  | 
\<open>push_bit n (of_nat m) = of_nat (push_bit n m)\<close>  | 
|
2475  | 
by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)  | 
|
2476  | 
||
2477  | 
lemma of_nat_push_bit:  | 
|
2478  | 
\<open>of_nat (push_bit m n) = push_bit m (of_nat n)\<close>  | 
|
2479  | 
by (simp add: push_bit_eq_mult Bit_Operations.push_bit_eq_mult)  | 
|
2480  | 
||
2481  | 
lemma take_bit_of_nat:  | 
|
2482  | 
\<open>take_bit n (of_nat m) = of_nat (take_bit n m)\<close>  | 
|
2483  | 
by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_nat_iff)  | 
|
2484  | 
||
2485  | 
lemma of_nat_take_bit:  | 
|
2486  | 
\<open>of_nat (take_bit n m) = take_bit n (of_nat m)\<close>  | 
|
2487  | 
by (rule bit_eqI) (simp add: bit_take_bit_iff Bit_Operations.bit_take_bit_iff bit_of_nat_iff)  | 
|
2488  | 
||
2489  | 
lemma of_nat_and_eq:  | 
|
2490  | 
\<open>of_nat (m AND n) = of_nat m AND of_nat n\<close>  | 
|
2491  | 
by (rule bit_eqI) (simp add: bit_of_nat_iff bit_and_iff Bit_Operations.bit_and_iff)  | 
|
2492  | 
||
2493  | 
lemma of_nat_or_eq:  | 
|
2494  | 
\<open>of_nat (m OR n) = of_nat m OR of_nat n\<close>  | 
|
2495  | 
by (rule bit_eqI) (simp add: bit_of_nat_iff bit_or_iff Bit_Operations.bit_or_iff)  | 
|
2496  | 
||
2497  | 
lemma of_nat_xor_eq:  | 
|
2498  | 
\<open>of_nat (m XOR n) = of_nat m XOR of_nat n\<close>  | 
|
2499  | 
by (rule bit_eqI) (simp add: bit_of_nat_iff bit_xor_iff Bit_Operations.bit_xor_iff)  | 
|
2500  | 
||
2501  | 
lemma of_nat_mask_eq:  | 
|
2502  | 
\<open>of_nat (mask n) = mask n\<close>  | 
|
2503  | 
by (induction n) (simp_all add: mask_Suc_double Bit_Operations.mask_Suc_double of_nat_or_eq)  | 
|
2504  | 
||
| 81722 | 2505  | 
lemma of_nat_set_bit_eq:  | 
2506  | 
\<open>of_nat (set_bit n m) = set_bit n (of_nat m)\<close>  | 
|
2507  | 
by (simp add: set_bit_eq_or Bit_Operations.set_bit_eq_or of_nat_or_eq Bit_Operations.push_bit_eq_mult)  | 
|
2508  | 
||
2509  | 
lemma of_nat_unset_bit_eq:  | 
|
2510  | 
\<open>of_nat (unset_bit n m) = unset_bit n (of_nat m)\<close>  | 
|
2511  | 
by (simp add: unset_bit_eq_or_xor Bit_Operations.unset_bit_eq_or_xor of_nat_or_eq of_nat_xor_eq Bit_Operations.push_bit_eq_mult)  | 
|
2512  | 
||
2513  | 
lemma of_nat_flip_bit_eq:  | 
|
2514  | 
\<open>of_nat (flip_bit n m) = flip_bit n (of_nat m)\<close>  | 
|
2515  | 
by (simp add: flip_bit_eq_xor Bit_Operations.flip_bit_eq_xor of_nat_xor_eq Bit_Operations.push_bit_eq_mult)  | 
|
2516  | 
||
| 79070 | 2517  | 
end  | 
2518  | 
||
2519  | 
context linordered_euclidean_semiring_bit_operations  | 
|
2520  | 
begin  | 
|
2521  | 
||
2522  | 
lemma drop_bit_of_nat:  | 
|
2523  | 
"drop_bit n (of_nat m) = of_nat (drop_bit n m)"  | 
|
2524  | 
by (simp add: drop_bit_eq_div Bit_Operations.drop_bit_eq_div of_nat_div [of m "2 ^ n"])  | 
|
2525  | 
||
2526  | 
lemma of_nat_drop_bit:  | 
|
2527  | 
\<open>of_nat (drop_bit m n) = drop_bit m (of_nat n)\<close>  | 
|
2528  | 
by (simp add: drop_bit_eq_div Bit_Operations.drop_bit_eq_div of_nat_div)  | 
|
2529  | 
||
2530  | 
end  | 
|
2531  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2532  | 
lemma take_bit_nat_less_exp [simp]:  | 
| 79068 | 2533  | 
\<open>take_bit n m < 2 ^ n\<close> for n m :: nat  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2534  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2535  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2536  | 
lemma take_bit_nat_eq_self_iff:  | 
| 79017 | 2537  | 
\<open>take_bit n m = m \<longleftrightarrow> m < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for n m :: nat  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2538  | 
proof  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2539  | 
assume ?P  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2540  | 
moreover note take_bit_nat_less_exp [of n m]  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2541  | 
ultimately show ?Q  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2542  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2543  | 
next  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2544  | 
assume ?Q  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2545  | 
then show ?P  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2546  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2547  | 
qed  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2548  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2549  | 
lemma take_bit_nat_eq_self:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2550  | 
\<open>take_bit n m = m\<close> if \<open>m < 2 ^ n\<close> for m n :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2551  | 
using that by (simp add: take_bit_nat_eq_self_iff)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2552  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2553  | 
lemma take_bit_nat_less_eq_self [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2554  | 
\<open>take_bit n m \<le> m\<close> for n m :: nat  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2555  | 
by (simp add: take_bit_eq_mod)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2556  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2557  | 
lemma take_bit_nat_less_self_iff:  | 
| 79017 | 2558  | 
\<open>take_bit n m < m \<longleftrightarrow> 2 ^ n \<le> m\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) for m n :: nat  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2559  | 
proof  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2560  | 
assume ?P  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2561  | 
then have \<open>take_bit n m \<noteq> m\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2562  | 
by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2563  | 
then show \<open>?Q\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2564  | 
by (simp add: take_bit_nat_eq_self_iff)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2565  | 
next  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2566  | 
have \<open>take_bit n m < 2 ^ n\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2567  | 
by (fact take_bit_nat_less_exp)  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2568  | 
also assume ?Q  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2569  | 
finally show ?P .  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2570  | 
qed  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2571  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2572  | 
lemma Suc_0_and_eq [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2573  | 
\<open>Suc 0 AND n = n mod 2\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2574  | 
using one_and_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2575  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2576  | 
lemma and_Suc_0_eq [simp]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2577  | 
\<open>n AND Suc 0 = n mod 2\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2578  | 
using and_one_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2579  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2580  | 
lemma Suc_0_or_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2581  | 
\<open>Suc 0 OR n = n + of_bool (even n)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2582  | 
using one_or_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2583  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2584  | 
lemma or_Suc_0_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2585  | 
\<open>n OR Suc 0 = n + of_bool (even n)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2586  | 
using or_one_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2587  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2588  | 
lemma Suc_0_xor_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2589  | 
\<open>Suc 0 XOR n = n + of_bool (even n) - of_bool (odd n)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2590  | 
using one_xor_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2591  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2592  | 
lemma xor_Suc_0_eq:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2593  | 
\<open>n XOR Suc 0 = n + of_bool (even n) - of_bool (odd n)\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2594  | 
using xor_one_eq [of n] by simp  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2595  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2596  | 
lemma and_nat_unfold [code]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2597  | 
\<open>m AND n = (if m = 0 \<or> n = 0 then 0 else (m mod 2) * (n mod 2) + 2 * ((m div 2) AND (n div 2)))\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2598  | 
for m n :: nat  | 
| 80758 | 2599  | 
by (auto simp: and_rec [of m n] elim: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2600  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2601  | 
lemma or_nat_unfold [code]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2602  | 
\<open>m OR n = (if m = 0 then n else if n = 0 then m  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2603  | 
else max (m mod 2) (n mod 2) + 2 * ((m div 2) OR (n div 2)))\<close> for m n :: nat  | 
| 80758 | 2604  | 
by (auto simp: or_rec [of m n] elim: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2605  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2606  | 
lemma xor_nat_unfold [code]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2607  | 
\<open>m XOR n = (if m = 0 then n else if n = 0 then m  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2608  | 
else (m mod 2 + n mod 2) mod 2 + 2 * ((m div 2) XOR (n div 2)))\<close> for m n :: nat  | 
| 80758 | 2609  | 
by (auto simp: xor_rec [of m n] elim!: oddE)  | 
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2610  | 
|
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2611  | 
lemma [code]:  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2612  | 
\<open>unset_bit 0 m = 2 * (m div 2)\<close>  | 
| 74163 | 2613  | 
\<open>unset_bit (Suc n) m = m mod 2 + 2 * unset_bit n (m div 2)\<close> for m n :: nat  | 
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
2614  | 
by (simp_all add: unset_bit_0 unset_bit_Suc)  | 
| 74495 | 2615  | 
|
| 74592 | 2616  | 
lemma push_bit_of_Suc_0 [simp]:  | 
2617  | 
\<open>push_bit n (Suc 0) = 2 ^ n\<close>  | 
|
2618  | 
using push_bit_of_1 [where ?'a = nat] by simp  | 
|
2619  | 
||
2620  | 
lemma take_bit_of_Suc_0 [simp]:  | 
|
2621  | 
\<open>take_bit n (Suc 0) = of_bool (0 < n)\<close>  | 
|
2622  | 
using take_bit_of_1 [where ?'a = nat] by simp  | 
|
2623  | 
||
2624  | 
lemma drop_bit_of_Suc_0 [simp]:  | 
|
2625  | 
\<open>drop_bit n (Suc 0) = of_bool (n = 0)\<close>  | 
|
2626  | 
using drop_bit_of_1 [where ?'a = nat] by simp  | 
|
2627  | 
||
2628  | 
lemma Suc_mask_eq_exp:  | 
|
2629  | 
\<open>Suc (mask n) = 2 ^ n\<close>  | 
|
2630  | 
by (simp add: mask_eq_exp_minus_1)  | 
|
2631  | 
||
2632  | 
lemma less_eq_mask:  | 
|
2633  | 
\<open>n \<le> mask n\<close>  | 
|
2634  | 
by (simp add: mask_eq_exp_minus_1 le_diff_conv2)  | 
|
2635  | 
(metis Suc_mask_eq_exp diff_Suc_1 diff_le_diff_pow diff_zero le_refl not_less_eq_eq power_0)  | 
|
2636  | 
||
2637  | 
lemma less_mask:  | 
|
2638  | 
\<open>n < mask n\<close> if \<open>Suc 0 < n\<close>  | 
|
2639  | 
proof -  | 
|
2640  | 
define m where \<open>m = n - 2\<close>  | 
|
2641  | 
with that have *: \<open>n = m + 2\<close>  | 
|
2642  | 
by simp  | 
|
2643  | 
have \<open>Suc (Suc (Suc m)) < 4 * 2 ^ m\<close>  | 
|
2644  | 
by (induction m) simp_all  | 
|
2645  | 
then have \<open>Suc (m + 2) < Suc (mask (m + 2))\<close>  | 
|
2646  | 
by (simp add: Suc_mask_eq_exp)  | 
|
2647  | 
then have \<open>m + 2 < mask (m + 2)\<close>  | 
|
2648  | 
by (simp add: less_le)  | 
|
2649  | 
with * show ?thesis  | 
|
2650  | 
by simp  | 
|
2651  | 
qed  | 
|
2652  | 
||
2653  | 
lemma mask_nat_less_exp [simp]:  | 
|
2654  | 
\<open>(mask n :: nat) < 2 ^ n\<close>  | 
|
2655  | 
by (simp add: mask_eq_exp_minus_1)  | 
|
2656  | 
||
2657  | 
lemma mask_nat_positive_iff [simp]:  | 
|
2658  | 
\<open>(0::nat) < mask n \<longleftrightarrow> 0 < n\<close>  | 
|
2659  | 
proof (cases \<open>n = 0\<close>)  | 
|
2660  | 
case True  | 
|
2661  | 
then show ?thesis  | 
|
2662  | 
by simp  | 
|
2663  | 
next  | 
|
2664  | 
case False  | 
|
2665  | 
then have \<open>0 < n\<close>  | 
|
2666  | 
by simp  | 
|
2667  | 
then have \<open>(0::nat) < mask n\<close>  | 
|
2668  | 
using less_eq_mask [of n] by (rule order_less_le_trans)  | 
|
2669  | 
with \<open>0 < n\<close> show ?thesis  | 
|
2670  | 
by simp  | 
|
2671  | 
qed  | 
|
2672  | 
||
2673  | 
lemma take_bit_tightened_less_eq_nat:  | 
|
2674  | 
\<open>take_bit m q \<le> take_bit n q\<close> if \<open>m \<le> n\<close> for q :: nat  | 
|
2675  | 
proof -  | 
|
2676  | 
have \<open>take_bit m (take_bit n q) \<le> take_bit n q\<close>  | 
|
2677  | 
by (rule take_bit_nat_less_eq_self)  | 
|
2678  | 
with that show ?thesis  | 
|
2679  | 
by simp  | 
|
2680  | 
qed  | 
|
2681  | 
||
2682  | 
lemma push_bit_nat_eq:  | 
|
2683  | 
\<open>push_bit n (nat k) = nat (push_bit n k)\<close>  | 
|
2684  | 
by (cases \<open>k \<ge> 0\<close>) (simp_all add: push_bit_eq_mult nat_mult_distrib not_le mult_nonneg_nonpos2)  | 
|
2685  | 
||
2686  | 
lemma drop_bit_nat_eq:  | 
|
2687  | 
\<open>drop_bit n (nat k) = nat (drop_bit n k)\<close>  | 
|
| 80758 | 2688  | 
proof (cases \<open>k \<ge> 0\<close>)  | 
2689  | 
case True  | 
|
2690  | 
then show ?thesis  | 
|
2691  | 
by (metis drop_bit_of_nat int_nat_eq nat_int)  | 
|
2692  | 
qed (simp add: nat_eq_iff2)  | 
|
| 74592 | 2693  | 
|
2694  | 
lemma take_bit_nat_eq:  | 
|
2695  | 
\<open>take_bit n (nat k) = nat (take_bit n k)\<close> if \<open>k \<ge> 0\<close>  | 
|
2696  | 
using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)  | 
|
2697  | 
||
2698  | 
lemma nat_take_bit_eq:  | 
|
2699  | 
\<open>nat (take_bit n k) = take_bit n (nat k)\<close>  | 
|
2700  | 
if \<open>k \<ge> 0\<close>  | 
|
2701  | 
using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq)  | 
|
2702  | 
||
2703  | 
lemma nat_mask_eq:  | 
|
2704  | 
\<open>nat (mask n) = mask n\<close>  | 
|
2705  | 
by (simp add: nat_eq_iff of_nat_mask_eq)  | 
|
2706  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
2707  | 
|
| 74163 | 2708  | 
subsection \<open>Symbolic computations on numeral expressions\<close>  | 
2709  | 
||
| 75138 | 2710  | 
context semiring_bits  | 
| 74163 | 2711  | 
begin  | 
2712  | 
||
| 
81641
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2713  | 
lemma bit_1_0 [simp]:  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2714  | 
\<open>bit 1 0\<close>  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2715  | 
by (simp add: bit_0)  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2716  | 
|
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2717  | 
lemma not_bit_1_Suc [simp]:  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2718  | 
\<open>\<not> bit 1 (Suc n)\<close>  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2719  | 
by (simp add: bit_Suc)  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2720  | 
|
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2721  | 
lemma not_bit_1_numeral [simp]:  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2722  | 
\<open>\<not> bit 1 (numeral m)\<close>  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2723  | 
by (simp add: numeral_eq_Suc)  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2724  | 
|
| 75085 | 2725  | 
lemma not_bit_numeral_Bit0_0 [simp]:  | 
2726  | 
\<open>\<not> bit (numeral (Num.Bit0 m)) 0\<close>  | 
|
2727  | 
by (simp add: bit_0)  | 
|
2728  | 
||
2729  | 
lemma bit_numeral_Bit1_0 [simp]:  | 
|
2730  | 
\<open>bit (numeral (Num.Bit1 m)) 0\<close>  | 
|
2731  | 
by (simp add: bit_0)  | 
|
2732  | 
||
| 79590 | 2733  | 
lemma bit_numeral_Bit0_iff:  | 
2734  | 
\<open>bit (numeral (num.Bit0 m)) n  | 
|
2735  | 
    \<longleftrightarrow> possible_bit TYPE('a) n \<and> n > 0 \<and> bit (numeral m) (n - 1)\<close>
 | 
|
2736  | 
by (simp only: numeral_Bit0_eq_double [of m] bit_simps) simp  | 
|
2737  | 
||
2738  | 
lemma bit_numeral_Bit1_Suc_iff:  | 
|
2739  | 
\<open>bit (numeral (num.Bit1 m)) (Suc n)  | 
|
2740  | 
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit (numeral m) n\<close>
 | 
|
2741  | 
using even_bit_succ_iff [of \<open>2 * numeral m\<close> \<open>Suc n\<close>]  | 
|
2742  | 
by (simp only: numeral_Bit1_eq_inc_double [of m] bit_simps) simp  | 
|
2743  | 
||
| 75138 | 2744  | 
end  | 
2745  | 
||
2746  | 
context ring_bit_operations  | 
|
2747  | 
begin  | 
|
2748  | 
||
2749  | 
lemma not_bit_minus_numeral_Bit0_0 [simp]:  | 
|
2750  | 
\<open>\<not> bit (- numeral (Num.Bit0 m)) 0\<close>  | 
|
2751  | 
by (simp add: bit_0)  | 
|
2752  | 
||
2753  | 
lemma bit_minus_numeral_Bit1_0 [simp]:  | 
|
2754  | 
\<open>bit (- numeral (Num.Bit1 m)) 0\<close>  | 
|
2755  | 
by (simp add: bit_0)  | 
|
2756  | 
||
| 79590 | 2757  | 
lemma bit_minus_numeral_Bit0_Suc_iff:  | 
2758  | 
\<open>bit (- numeral (num.Bit0 m)) (Suc n)  | 
|
2759  | 
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> bit (- numeral m) n\<close>
 | 
|
2760  | 
by (simp only: numeral_Bit0_eq_double [of m] minus_mult_right bit_simps) auto  | 
|
2761  | 
||
2762  | 
lemma bit_minus_numeral_Bit1_Suc_iff:  | 
|
2763  | 
\<open>bit (- numeral (num.Bit1 m)) (Suc n)  | 
|
2764  | 
    \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> \<not> bit (numeral m) n\<close>
 | 
|
2765  | 
by (simp only: numeral_Bit1_eq_inc_double [of m] minus_add_distrib minus_mult_right add_uminus_conv_diff  | 
|
2766  | 
bit_decr_iff bit_double_iff)  | 
|
2767  | 
auto  | 
|
2768  | 
||
2769  | 
lemma bit_numeral_BitM_0 [simp]:  | 
|
2770  | 
\<open>bit (numeral (Num.BitM m)) 0\<close>  | 
|
2771  | 
by (simp only: numeral_BitM bit_decr_iff not_bit_minus_numeral_Bit0_0) simp  | 
|
2772  | 
||
2773  | 
lemma bit_numeral_BitM_Suc_iff:  | 
|
2774  | 
  \<open>bit (numeral (Num.BitM m)) (Suc n) \<longleftrightarrow> possible_bit TYPE('a) (Suc n) \<and> \<not> bit (- numeral m) n\<close>
 | 
|
2775  | 
by (simp_all only: numeral_BitM bit_decr_iff bit_minus_numeral_Bit0_Suc_iff) auto  | 
|
2776  | 
||
| 75138 | 2777  | 
end  | 
2778  | 
||
| 78955 | 2779  | 
context linordered_euclidean_semiring_bit_operations  | 
| 75138 | 2780  | 
begin  | 
2781  | 
||
2782  | 
lemma bit_numeral_iff:  | 
|
2783  | 
\<open>bit (numeral m) n \<longleftrightarrow> bit (numeral m :: nat) n\<close>  | 
|
2784  | 
using bit_of_nat_iff_bit [of \<open>numeral m\<close> n] by simp  | 
|
2785  | 
||
| 74163 | 2786  | 
lemma bit_numeral_Bit0_Suc_iff [simp]:  | 
2787  | 
\<open>bit (numeral (Num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>  | 
|
2788  | 
by (simp add: bit_Suc numeral_Bit0_div_2)  | 
|
2789  | 
||
2790  | 
lemma bit_numeral_Bit1_Suc_iff [simp]:  | 
|
2791  | 
\<open>bit (numeral (Num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (numeral m) n\<close>  | 
|
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
2792  | 
by (simp add: bit_Suc numeral_Bit0_div_2)  | 
| 74163 | 2793  | 
|
2794  | 
lemma bit_numeral_rec:  | 
|
2795  | 
\<open>bit (numeral (Num.Bit0 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> False | Suc m \<Rightarrow> bit (numeral w) m)\<close>  | 
|
2796  | 
\<open>bit (numeral (Num.Bit1 w)) n \<longleftrightarrow> (case n of 0 \<Rightarrow> True | Suc m \<Rightarrow> bit (numeral w) m)\<close>  | 
|
| 75085 | 2797  | 
by (cases n; simp add: bit_0)+  | 
| 74163 | 2798  | 
|
2799  | 
lemma bit_numeral_simps [simp]:  | 
|
2800  | 
\<open>bit (numeral (Num.Bit0 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>  | 
|
2801  | 
\<open>bit (numeral (Num.Bit1 w)) (numeral n) \<longleftrightarrow> bit (numeral w) (pred_numeral n)\<close>  | 
|
2802  | 
by (simp_all add: bit_1_iff numeral_eq_Suc)  | 
|
2803  | 
||
2804  | 
lemma and_numerals [simp]:  | 
|
2805  | 
\<open>1 AND numeral (Num.Bit0 y) = 0\<close>  | 
|
2806  | 
\<open>1 AND numeral (Num.Bit1 y) = 1\<close>  | 
|
2807  | 
\<open>numeral (Num.Bit0 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>  | 
|
2808  | 
\<open>numeral (Num.Bit0 x) AND numeral (Num.Bit1 y) = 2 * (numeral x AND numeral y)\<close>  | 
|
2809  | 
\<open>numeral (Num.Bit0 x) AND 1 = 0\<close>  | 
|
2810  | 
\<open>numeral (Num.Bit1 x) AND numeral (Num.Bit0 y) = 2 * (numeral x AND numeral y)\<close>  | 
|
2811  | 
\<open>numeral (Num.Bit1 x) AND numeral (Num.Bit1 y) = 1 + 2 * (numeral x AND numeral y)\<close>  | 
|
2812  | 
\<open>numeral (Num.Bit1 x) AND 1 = 1\<close>  | 
|
| 75085 | 2813  | 
by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)  | 
| 74163 | 2814  | 
|
2815  | 
lemma or_numerals [simp]:  | 
|
2816  | 
\<open>1 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>  | 
|
2817  | 
\<open>1 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>  | 
|
2818  | 
\<open>numeral (Num.Bit0 x) OR numeral (Num.Bit0 y) = 2 * (numeral x OR numeral y)\<close>  | 
|
2819  | 
\<open>numeral (Num.Bit0 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>  | 
|
2820  | 
\<open>numeral (Num.Bit0 x) OR 1 = numeral (Num.Bit1 x)\<close>  | 
|
2821  | 
\<open>numeral (Num.Bit1 x) OR numeral (Num.Bit0 y) = 1 + 2 * (numeral x OR numeral y)\<close>  | 
|
2822  | 
\<open>numeral (Num.Bit1 x) OR numeral (Num.Bit1 y) = 1 + 2 * (numeral x OR numeral y)\<close>  | 
|
2823  | 
\<open>numeral (Num.Bit1 x) OR 1 = numeral (Num.Bit1 x)\<close>  | 
|
| 75085 | 2824  | 
by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)  | 
| 74163 | 2825  | 
|
2826  | 
lemma xor_numerals [simp]:  | 
|
2827  | 
\<open>1 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>  | 
|
2828  | 
\<open>1 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>  | 
|
2829  | 
\<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit0 y) = 2 * (numeral x XOR numeral y)\<close>  | 
|
2830  | 
\<open>numeral (Num.Bit0 x) XOR numeral (Num.Bit1 y) = 1 + 2 * (numeral x XOR numeral y)\<close>  | 
|
2831  | 
\<open>numeral (Num.Bit0 x) XOR 1 = numeral (Num.Bit1 x)\<close>  | 
|
2832  | 
\<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit0 y) = 1 + 2 * (numeral x XOR numeral y)\<close>  | 
|
2833  | 
\<open>numeral (Num.Bit1 x) XOR numeral (Num.Bit1 y) = 2 * (numeral x XOR numeral y)\<close>  | 
|
2834  | 
\<open>numeral (Num.Bit1 x) XOR 1 = numeral (Num.Bit0 x)\<close>  | 
|
| 75085 | 2835  | 
by (simp_all add: bit_eq_iff) (simp_all add: bit_0 bit_simps bit_Suc bit_numeral_rec split: nat.splits)  | 
| 74163 | 2836  | 
|
2837  | 
end  | 
|
2838  | 
||
| 79017 | 2839  | 
lemma drop_bit_Suc_minus_bit0 [simp]:  | 
2840  | 
\<open>drop_bit (Suc n) (- numeral (Num.Bit0 k)) = drop_bit n (- numeral k :: int)\<close>  | 
|
2841  | 
by (simp add: drop_bit_Suc numeral_Bit0_div_2)  | 
|
2842  | 
||
2843  | 
lemma drop_bit_Suc_minus_bit1 [simp]:  | 
|
2844  | 
\<open>drop_bit (Suc n) (- numeral (Num.Bit1 k)) = drop_bit n (- numeral (Num.inc k) :: int)\<close>  | 
|
2845  | 
by (simp add: drop_bit_Suc numeral_Bit1_div_2 add_One)  | 
|
2846  | 
||
2847  | 
lemma drop_bit_numeral_minus_bit0 [simp]:  | 
|
2848  | 
\<open>drop_bit (numeral l) (- numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (- numeral k :: int)\<close>  | 
|
2849  | 
by (simp add: numeral_eq_Suc numeral_Bit0_div_2)  | 
|
2850  | 
||
2851  | 
lemma drop_bit_numeral_minus_bit1 [simp]:  | 
|
2852  | 
\<open>drop_bit (numeral l) (- numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (- numeral (Num.inc k) :: int)\<close>  | 
|
2853  | 
by (simp add: numeral_eq_Suc numeral_Bit1_div_2)  | 
|
2854  | 
||
2855  | 
lemma take_bit_Suc_minus_bit0:  | 
|
2856  | 
\<open>take_bit (Suc n) (- numeral (Num.Bit0 k)) = take_bit n (- numeral k) * (2 :: int)\<close>  | 
|
2857  | 
by (simp add: take_bit_Suc numeral_Bit0_div_2)  | 
|
2858  | 
||
2859  | 
lemma take_bit_Suc_minus_bit1:  | 
|
2860  | 
\<open>take_bit (Suc n) (- numeral (Num.Bit1 k)) = take_bit n (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>  | 
|
2861  | 
by (simp add: take_bit_Suc numeral_Bit1_div_2 add_One)  | 
|
2862  | 
||
2863  | 
lemma take_bit_numeral_minus_bit0:  | 
|
2864  | 
\<open>take_bit (numeral l) (- numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>  | 
|
2865  | 
by (simp add: numeral_eq_Suc numeral_Bit0_div_2 take_bit_Suc_minus_bit0)  | 
|
2866  | 
||
2867  | 
lemma take_bit_numeral_minus_bit1:  | 
|
2868  | 
\<open>take_bit (numeral l) (- numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (- numeral (Num.inc k)) * 2 + (1 :: int)\<close>  | 
|
2869  | 
by (simp add: numeral_eq_Suc numeral_Bit1_div_2 take_bit_Suc_minus_bit1)  | 
|
2870  | 
||
| 74495 | 2871  | 
lemma and_nat_numerals [simp]:  | 
2872  | 
\<open>Suc 0 AND numeral (Num.Bit0 y) = 0\<close>  | 
|
2873  | 
\<open>Suc 0 AND numeral (Num.Bit1 y) = 1\<close>  | 
|
2874  | 
\<open>numeral (Num.Bit0 x) AND Suc 0 = 0\<close>  | 
|
2875  | 
\<open>numeral (Num.Bit1 x) AND Suc 0 = 1\<close>  | 
|
2876  | 
by (simp_all only: and_numerals flip: One_nat_def)  | 
|
2877  | 
||
2878  | 
lemma or_nat_numerals [simp]:  | 
|
2879  | 
\<open>Suc 0 OR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>  | 
|
2880  | 
\<open>Suc 0 OR numeral (Num.Bit1 y) = numeral (Num.Bit1 y)\<close>  | 
|
2881  | 
\<open>numeral (Num.Bit0 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>  | 
|
2882  | 
\<open>numeral (Num.Bit1 x) OR Suc 0 = numeral (Num.Bit1 x)\<close>  | 
|
2883  | 
by (simp_all only: or_numerals flip: One_nat_def)  | 
|
2884  | 
||
2885  | 
lemma xor_nat_numerals [simp]:  | 
|
2886  | 
\<open>Suc 0 XOR numeral (Num.Bit0 y) = numeral (Num.Bit1 y)\<close>  | 
|
2887  | 
\<open>Suc 0 XOR numeral (Num.Bit1 y) = numeral (Num.Bit0 y)\<close>  | 
|
2888  | 
\<open>numeral (Num.Bit0 x) XOR Suc 0 = numeral (Num.Bit1 x)\<close>  | 
|
2889  | 
\<open>numeral (Num.Bit1 x) XOR Suc 0 = numeral (Num.Bit0 x)\<close>  | 
|
2890  | 
by (simp_all only: xor_numerals flip: One_nat_def)  | 
|
2891  | 
||
| 74163 | 2892  | 
context ring_bit_operations  | 
2893  | 
begin  | 
|
2894  | 
||
2895  | 
lemma minus_numeral_inc_eq:  | 
|
2896  | 
\<open>- numeral (Num.inc n) = NOT (numeral n)\<close>  | 
|
2897  | 
by (simp add: not_eq_complement sub_inc_One_eq add_One)  | 
|
2898  | 
||
2899  | 
lemma sub_one_eq_not_neg:  | 
|
2900  | 
\<open>Num.sub n num.One = NOT (- numeral n)\<close>  | 
|
2901  | 
by (simp add: not_eq_complement)  | 
|
2902  | 
||
2903  | 
lemma minus_numeral_eq_not_sub_one:  | 
|
2904  | 
\<open>- numeral n = NOT (Num.sub n num.One)\<close>  | 
|
2905  | 
by (simp add: not_eq_complement)  | 
|
2906  | 
||
| 74495 | 2907  | 
lemma not_numeral_eq [simp]:  | 
| 74163 | 2908  | 
\<open>NOT (numeral n) = - numeral (Num.inc n)\<close>  | 
2909  | 
by (simp add: minus_numeral_inc_eq)  | 
|
2910  | 
||
2911  | 
lemma not_minus_numeral_eq [simp]:  | 
|
2912  | 
\<open>NOT (- numeral n) = Num.sub n num.One\<close>  | 
|
2913  | 
by (simp add: sub_one_eq_not_neg)  | 
|
2914  | 
||
2915  | 
lemma minus_not_numeral_eq [simp]:  | 
|
2916  | 
\<open>- (NOT (numeral n)) = numeral (Num.inc n)\<close>  | 
|
| 74495 | 2917  | 
by simp  | 
2918  | 
||
2919  | 
lemma not_numeral_BitM_eq:  | 
|
2920  | 
\<open>NOT (numeral (Num.BitM n)) = - numeral (num.Bit0 n)\<close>  | 
|
| 79068 | 2921  | 
by (simp add: inc_BitM_eq)  | 
| 74495 | 2922  | 
|
2923  | 
lemma not_numeral_Bit0_eq:  | 
|
2924  | 
\<open>NOT (numeral (Num.Bit0 n)) = - numeral (num.Bit1 n)\<close>  | 
|
2925  | 
by simp  | 
|
| 74163 | 2926  | 
|
2927  | 
end  | 
|
2928  | 
||
2929  | 
lemma bit_minus_numeral_int [simp]:  | 
|
2930  | 
\<open>bit (- numeral (num.Bit0 w) :: int) (numeral n) \<longleftrightarrow> bit (- numeral w :: int) (pred_numeral n)\<close>  | 
|
2931  | 
\<open>bit (- numeral (num.Bit1 w) :: int) (numeral n) \<longleftrightarrow> \<not> bit (numeral w :: int) (pred_numeral n)\<close>  | 
|
2932  | 
by (simp_all add: bit_minus_iff bit_not_iff numeral_eq_Suc bit_Suc add_One sub_inc_One_eq)  | 
|
2933  | 
||
| 74592 | 2934  | 
lemma bit_minus_numeral_Bit0_Suc_iff [simp]:  | 
2935  | 
\<open>bit (- numeral (num.Bit0 w) :: int) (Suc n) \<longleftrightarrow> bit (- numeral w :: int) n\<close>  | 
|
2936  | 
by (simp add: bit_Suc)  | 
|
2937  | 
||
2938  | 
lemma bit_minus_numeral_Bit1_Suc_iff [simp]:  | 
|
2939  | 
\<open>bit (- numeral (num.Bit1 w) :: int) (Suc n) \<longleftrightarrow> \<not> bit (numeral w :: int) n\<close>  | 
|
2940  | 
by (simp add: bit_Suc add_One flip: bit_not_int_iff)  | 
|
2941  | 
||
| 74495 | 2942  | 
lemma and_not_numerals:  | 
| 74163 | 2943  | 
\<open>1 AND NOT 1 = (0 :: int)\<close>  | 
2944  | 
\<open>1 AND NOT (numeral (Num.Bit0 n)) = (1 :: int)\<close>  | 
|
2945  | 
\<open>1 AND NOT (numeral (Num.Bit1 n)) = (0 :: int)\<close>  | 
|
2946  | 
\<open>numeral (Num.Bit0 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>  | 
|
2947  | 
\<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit0 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>  | 
|
2948  | 
\<open>numeral (Num.Bit0 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>  | 
|
2949  | 
\<open>numeral (Num.Bit1 m) AND NOT (1 :: int) = numeral (Num.Bit0 m)\<close>  | 
|
2950  | 
\<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m AND NOT (numeral n))\<close>  | 
|
2951  | 
\<open>numeral (Num.Bit1 m) AND NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m AND NOT (numeral n))\<close>  | 
|
| 
81641
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2952  | 
by (simp_all add: bit_eq_iff)  | 
| 
 
5af6a5e4343b
avoid default simp rule which would produce strange recursive unfolding in presence of bit_eq_iff
 
haftmann 
parents: 
81132 
diff
changeset
 | 
2953  | 
(auto simp: bit_0 bit_simps bit_Suc bit_numeral_rec BitM_inc_eq sub_inc_One_eq split: nat.split)  | 
| 74163 | 2954  | 
|
2955  | 
fun and_not_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>  | 
|
2956  | 
where  | 
|
2957  | 
\<open>and_not_num num.One num.One = None\<close>  | 
|
2958  | 
| \<open>and_not_num num.One (num.Bit0 n) = Some num.One\<close>  | 
|
2959  | 
| \<open>and_not_num num.One (num.Bit1 n) = None\<close>  | 
|
2960  | 
| \<open>and_not_num (num.Bit0 m) num.One = Some (num.Bit0 m)\<close>  | 
|
2961  | 
| \<open>and_not_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_not_num m n)\<close>  | 
|
2962  | 
| \<open>and_not_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>  | 
|
2963  | 
| \<open>and_not_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>  | 
|
2964  | 
| \<open>and_not_num (num.Bit1 m) (num.Bit0 n) = (case and_not_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>  | 
|
2965  | 
| \<open>and_not_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (and_not_num m n)\<close>  | 
|
2966  | 
||
2967  | 
lemma int_numeral_and_not_num:  | 
|
2968  | 
\<open>numeral m AND NOT (numeral n) = (case and_not_num m n of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
| 74495 | 2969  | 
by (induction m n rule: and_not_num.induct) (simp_all del: not_numeral_eq not_one_eq add: and_not_numerals split: option.splits)  | 
| 74163 | 2970  | 
|
2971  | 
lemma int_numeral_not_and_num:  | 
|
2972  | 
\<open>NOT (numeral m) AND numeral n = (case and_not_num n m of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
2973  | 
using int_numeral_and_not_num [of n m] by (simp add: ac_simps)  | 
|
2974  | 
||
2975  | 
lemma and_not_num_eq_None_iff:  | 
|
2976  | 
\<open>and_not_num m n = None \<longleftrightarrow> numeral m AND NOT (numeral n) = (0 :: int)\<close>  | 
|
| 74495 | 2977  | 
by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)  | 
| 74163 | 2978  | 
|
2979  | 
lemma and_not_num_eq_Some_iff:  | 
|
2980  | 
\<open>and_not_num m n = Some q \<longleftrightarrow> numeral m AND NOT (numeral n) = (numeral q :: int)\<close>  | 
|
| 74495 | 2981  | 
by (simp del: not_numeral_eq add: int_numeral_and_not_num split: option.split)  | 
2982  | 
||
2983  | 
lemma and_minus_numerals [simp]:  | 
|
2984  | 
\<open>1 AND - (numeral (num.Bit0 n)) = (0::int)\<close>  | 
|
2985  | 
\<open>1 AND - (numeral (num.Bit1 n)) = (1::int)\<close>  | 
|
2986  | 
\<open>numeral m AND - (numeral (num.Bit0 n)) = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
2987  | 
\<open>numeral m AND - (numeral (num.Bit1 n)) = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
2988  | 
\<open>- (numeral (num.Bit0 n)) AND 1 = (0::int)\<close>  | 
|
2989  | 
\<open>- (numeral (num.Bit1 n)) AND 1 = (1::int)\<close>  | 
|
2990  | 
\<open>- (numeral (num.Bit0 n)) AND numeral m = (case and_not_num m (Num.BitM n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
2991  | 
\<open>- (numeral (num.Bit1 n)) AND numeral m = (case and_not_num m (Num.Bit0 n) of None \<Rightarrow> 0 :: int | Some n' \<Rightarrow> numeral n')\<close>  | 
|
2992  | 
by (simp_all del: not_numeral_eq add: ac_simps  | 
|
2993  | 
and_not_numerals one_and_eq not_numeral_BitM_eq not_numeral_Bit0_eq and_not_num_eq_None_iff and_not_num_eq_Some_iff split: option.split)  | 
|
2994  | 
||
2995  | 
lemma and_minus_minus_numerals [simp]:  | 
|
2996  | 
\<open>- (numeral m :: int) AND - (numeral n :: int) = NOT ((numeral m - 1) OR (numeral n - 1))\<close>  | 
|
2997  | 
by (simp add: minus_numeral_eq_not_sub_one)  | 
|
2998  | 
||
2999  | 
lemma or_not_numerals:  | 
|
| 74163 | 3000  | 
\<open>1 OR NOT 1 = NOT (0 :: int)\<close>  | 
3001  | 
\<open>1 OR NOT (numeral (Num.Bit0 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>  | 
|
3002  | 
\<open>1 OR NOT (numeral (Num.Bit1 n)) = NOT (numeral (Num.Bit0 n) :: int)\<close>  | 
|
3003  | 
\<open>numeral (Num.Bit0 m) OR NOT (1 :: int) = NOT (1 :: int)\<close>  | 
|
3004  | 
\<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>  | 
|
3005  | 
\<open>numeral (Num.Bit0 m) OR NOT (numeral (Num.Bit1 n)) = (2 :: int) * (numeral m OR NOT (numeral n))\<close>  | 
|
3006  | 
\<open>numeral (Num.Bit1 m) OR NOT (1 :: int) = NOT (0 :: int)\<close>  | 
|
3007  | 
\<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit0 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>  | 
|
3008  | 
\<open>numeral (Num.Bit1 m) OR NOT (numeral (Num.Bit1 n)) = 1 + (2 :: int) * (numeral m OR NOT (numeral n))\<close>  | 
|
| 74495 | 3009  | 
by (simp_all add: bit_eq_iff)  | 
| 80758 | 3010  | 
(auto simp: bit_0 bit_simps bit_Suc bit_numeral_rec sub_inc_One_eq split: nat.split)  | 
| 74163 | 3011  | 
|
3012  | 
fun or_not_num_neg :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>  | 
|
3013  | 
where  | 
|
3014  | 
\<open>or_not_num_neg num.One num.One = num.One\<close>  | 
|
3015  | 
| \<open>or_not_num_neg num.One (num.Bit0 m) = num.Bit1 m\<close>  | 
|
3016  | 
| \<open>or_not_num_neg num.One (num.Bit1 m) = num.Bit1 m\<close>  | 
|
3017  | 
| \<open>or_not_num_neg (num.Bit0 n) num.One = num.Bit0 num.One\<close>  | 
|
3018  | 
| \<open>or_not_num_neg (num.Bit0 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>  | 
|
3019  | 
| \<open>or_not_num_neg (num.Bit0 n) (num.Bit1 m) = num.Bit0 (or_not_num_neg n m)\<close>  | 
|
3020  | 
| \<open>or_not_num_neg (num.Bit1 n) num.One = num.One\<close>  | 
|
3021  | 
| \<open>or_not_num_neg (num.Bit1 n) (num.Bit0 m) = Num.BitM (or_not_num_neg n m)\<close>  | 
|
3022  | 
| \<open>or_not_num_neg (num.Bit1 n) (num.Bit1 m) = Num.BitM (or_not_num_neg n m)\<close>  | 
|
3023  | 
||
3024  | 
lemma int_numeral_or_not_num_neg:  | 
|
3025  | 
\<open>numeral m OR NOT (numeral n :: int) = - numeral (or_not_num_neg m n)\<close>  | 
|
| 74495 | 3026  | 
by (induction m n rule: or_not_num_neg.induct) (simp_all del: not_numeral_eq not_one_eq add: or_not_numerals, simp_all)  | 
| 74163 | 3027  | 
|
3028  | 
lemma int_numeral_not_or_num_neg:  | 
|
3029  | 
\<open>NOT (numeral m) OR (numeral n :: int) = - numeral (or_not_num_neg n m)\<close>  | 
|
3030  | 
using int_numeral_or_not_num_neg [of n m] by (simp add: ac_simps)  | 
|
3031  | 
||
3032  | 
lemma numeral_or_not_num_eq:  | 
|
3033  | 
\<open>numeral (or_not_num_neg m n) = - (numeral m OR NOT (numeral n :: int))\<close>  | 
|
3034  | 
using int_numeral_or_not_num_neg [of m n] by simp  | 
|
3035  | 
||
| 74495 | 3036  | 
lemma or_minus_numerals [simp]:  | 
3037  | 
\<open>1 OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>  | 
|
3038  | 
\<open>1 OR - (numeral (num.Bit1 n)) = - (numeral (num.Bit1 n) :: int)\<close>  | 
|
3039  | 
\<open>numeral m OR - (numeral (num.Bit0 n)) = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>  | 
|
3040  | 
\<open>numeral m OR - (numeral (num.Bit1 n)) = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>  | 
|
3041  | 
\<open>- (numeral (num.Bit0 n)) OR 1 = - (numeral (or_not_num_neg num.One (Num.BitM n)) :: int)\<close>  | 
|
3042  | 
\<open>- (numeral (num.Bit1 n)) OR 1 = - (numeral (num.Bit1 n) :: int)\<close>  | 
|
3043  | 
\<open>- (numeral (num.Bit0 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.BitM n)) :: int)\<close>  | 
|
3044  | 
\<open>- (numeral (num.Bit1 n)) OR numeral m = - (numeral (or_not_num_neg m (Num.Bit0 n)) :: int)\<close>  | 
|
3045  | 
by (simp_all only: or.commute [of _ 1] or.commute [of _ \<open>numeral m\<close>]  | 
|
3046  | 
minus_numeral_eq_not_sub_one or_not_numerals  | 
|
3047  | 
numeral_or_not_num_eq arith_simps minus_minus numeral_One)  | 
|
3048  | 
||
3049  | 
lemma or_minus_minus_numerals [simp]:  | 
|
3050  | 
\<open>- (numeral m :: int) OR - (numeral n :: int) = NOT ((numeral m - 1) AND (numeral n - 1))\<close>  | 
|
3051  | 
by (simp add: minus_numeral_eq_not_sub_one)  | 
|
3052  | 
||
| 74163 | 3053  | 
lemma xor_minus_numerals [simp]:  | 
3054  | 
\<open>- numeral n XOR k = NOT (neg_numeral_class.sub n num.One XOR k)\<close>  | 
|
3055  | 
\<open>k XOR - numeral n = NOT (k XOR (neg_numeral_class.sub n num.One))\<close> for k :: int  | 
|
3056  | 
by (simp_all add: minus_numeral_eq_not_sub_one)  | 
|
3057  | 
||
| 74592 | 3058  | 
definition take_bit_num :: \<open>nat \<Rightarrow> num \<Rightarrow> num option\<close>  | 
3059  | 
where \<open>take_bit_num n m =  | 
|
| 
75651
 
f4116b7a6679
Move code lemmas for symbolic computation of bit operations on int to distribution.
 
haftmann 
parents: 
75138 
diff
changeset
 | 
3060  | 
(if take_bit n (numeral m :: nat) = 0 then None else Some (num_of_nat (take_bit n (numeral m :: nat))))\<close>  | 
| 74592 | 3061  | 
|
| 74618 | 3062  | 
lemma take_bit_num_simps:  | 
| 74592 | 3063  | 
\<open>take_bit_num 0 m = None\<close>  | 
3064  | 
\<open>take_bit_num (Suc n) Num.One =  | 
|
3065  | 
Some Num.One\<close>  | 
|
3066  | 
\<open>take_bit_num (Suc n) (Num.Bit0 m) =  | 
|
3067  | 
(case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>  | 
|
3068  | 
\<open>take_bit_num (Suc n) (Num.Bit1 m) =  | 
|
3069  | 
Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>  | 
|
| 74618 | 3070  | 
\<open>take_bit_num (numeral r) Num.One =  | 
| 74592 | 3071  | 
Some Num.One\<close>  | 
| 74618 | 3072  | 
\<open>take_bit_num (numeral r) (Num.Bit0 m) =  | 
3073  | 
(case take_bit_num (pred_numeral r) m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))\<close>  | 
|
3074  | 
\<open>take_bit_num (numeral r) (Num.Bit1 m) =  | 
|
3075  | 
Some (case take_bit_num (pred_numeral r) m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q)\<close>  | 
|
| 80758 | 3076  | 
by (auto simp: take_bit_num_def ac_simps mult_2 num_of_nat_double  | 
| 74618 | 3077  | 
take_bit_Suc_bit0 take_bit_Suc_bit1 take_bit_numeral_bit0 take_bit_numeral_bit1)  | 
3078  | 
||
3079  | 
lemma take_bit_num_code [code]:  | 
|
3080  | 
\<comment> \<open>Ocaml-style pattern matching is more robust wrt. different representations of \<^typ>\<open>nat\<close>\<close>  | 
|
3081  | 
\<open>take_bit_num n m = (case (n, m)  | 
|
3082  | 
of (0, _) \<Rightarrow> None  | 
|
3083  | 
| (Suc n, Num.One) \<Rightarrow> Some Num.One  | 
|
3084  | 
| (Suc n, Num.Bit0 m) \<Rightarrow> (case take_bit_num n m of None \<Rightarrow> None | Some q \<Rightarrow> Some (Num.Bit0 q))  | 
|
3085  | 
| (Suc n, Num.Bit1 m) \<Rightarrow> Some (case take_bit_num n m of None \<Rightarrow> Num.One | Some q \<Rightarrow> Num.Bit1 q))\<close>  | 
|
3086  | 
by (cases n; cases m) (simp_all add: take_bit_num_simps)  | 
|
| 74592 | 3087  | 
|
3088  | 
context semiring_bit_operations  | 
|
3089  | 
begin  | 
|
3090  | 
||
3091  | 
lemma take_bit_num_eq_None_imp:  | 
|
3092  | 
\<open>take_bit m (numeral n) = 0\<close> if \<open>take_bit_num m n = None\<close>  | 
|
3093  | 
proof -  | 
|
3094  | 
from that have \<open>take_bit m (numeral n :: nat) = 0\<close>  | 
|
3095  | 
by (simp add: take_bit_num_def split: if_splits)  | 
|
3096  | 
then have \<open>of_nat (take_bit m (numeral n)) = of_nat 0\<close>  | 
|
3097  | 
by simp  | 
|
3098  | 
then show ?thesis  | 
|
3099  | 
by (simp add: of_nat_take_bit)  | 
|
3100  | 
qed  | 
|
| 79068 | 3101  | 
|
| 74592 | 3102  | 
lemma take_bit_num_eq_Some_imp:  | 
3103  | 
\<open>take_bit m (numeral n) = numeral q\<close> if \<open>take_bit_num m n = Some q\<close>  | 
|
3104  | 
proof -  | 
|
3105  | 
from that have \<open>take_bit m (numeral n :: nat) = numeral q\<close>  | 
|
| 80758 | 3106  | 
by (auto simp: take_bit_num_def Num.numeral_num_of_nat_unfold split: if_splits)  | 
| 74592 | 3107  | 
then have \<open>of_nat (take_bit m (numeral n)) = of_nat (numeral q)\<close>  | 
3108  | 
by simp  | 
|
3109  | 
then show ?thesis  | 
|
3110  | 
by (simp add: of_nat_take_bit)  | 
|
3111  | 
qed  | 
|
3112  | 
||
3113  | 
lemma take_bit_numeral_numeral:  | 
|
3114  | 
\<open>take_bit (numeral m) (numeral n) =  | 
|
3115  | 
(case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> numeral q)\<close>  | 
|
3116  | 
by (auto split: option.split dest: take_bit_num_eq_None_imp take_bit_num_eq_Some_imp)  | 
|
3117  | 
||
3118  | 
end  | 
|
3119  | 
||
3120  | 
lemma take_bit_numeral_minus_numeral_int:  | 
|
3121  | 
\<open>take_bit (numeral m) (- numeral n :: int) =  | 
|
3122  | 
(case take_bit_num (numeral m) n of None \<Rightarrow> 0 | Some q \<Rightarrow> take_bit (numeral m) (2 ^ numeral m - numeral q))\<close> (is \<open>?lhs = ?rhs\<close>)  | 
|
3123  | 
proof (cases \<open>take_bit_num (numeral m) n\<close>)  | 
|
3124  | 
case None  | 
|
3125  | 
then show ?thesis  | 
|
3126  | 
by (auto dest: take_bit_num_eq_None_imp [where ?'a = int] simp add: take_bit_eq_0_iff)  | 
|
3127  | 
next  | 
|
3128  | 
case (Some q)  | 
|
3129  | 
then have q: \<open>take_bit (numeral m) (numeral n :: int) = numeral q\<close>  | 
|
3130  | 
by (auto dest: take_bit_num_eq_Some_imp)  | 
|
3131  | 
let ?T = \<open>take_bit (numeral m) :: int \<Rightarrow> int\<close>  | 
|
3132  | 
have *: \<open>?T (2 ^ numeral m) = ?T (?T 0)\<close>  | 
|
3133  | 
by (simp add: take_bit_eq_0_iff)  | 
|
3134  | 
have \<open>?lhs = ?T (0 - numeral n)\<close>  | 
|
3135  | 
by simp  | 
|
3136  | 
also have \<open>\<dots> = ?T (?T (?T 0) - ?T (?T (numeral n)))\<close>  | 
|
3137  | 
by (simp only: take_bit_diff)  | 
|
3138  | 
also have \<open>\<dots> = ?T (2 ^ numeral m - ?T (numeral n))\<close>  | 
|
3139  | 
by (simp only: take_bit_diff flip: *)  | 
|
3140  | 
also have \<open>\<dots> = ?rhs\<close>  | 
|
3141  | 
by (simp add: q Some)  | 
|
3142  | 
finally show ?thesis .  | 
|
3143  | 
qed  | 
|
3144  | 
||
| 74618 | 3145  | 
declare take_bit_num_simps [simp]  | 
3146  | 
take_bit_numeral_numeral [simp]  | 
|
| 74592 | 3147  | 
take_bit_numeral_minus_numeral_int [simp]  | 
3148  | 
||
| 74163 | 3149  | 
|
| 79069 | 3150  | 
subsection \<open>Symbolic computations for code generation\<close>  | 
3151  | 
||
3152  | 
lemma bit_int_code [code]:  | 
|
3153  | 
\<open>bit (0::int) n \<longleftrightarrow> False\<close>  | 
|
3154  | 
\<open>bit (Int.Neg num.One) n \<longleftrightarrow> True\<close>  | 
|
3155  | 
\<open>bit (Int.Pos num.One) 0 \<longleftrightarrow> True\<close>  | 
|
3156  | 
\<open>bit (Int.Pos (num.Bit0 m)) 0 \<longleftrightarrow> False\<close>  | 
|
3157  | 
\<open>bit (Int.Pos (num.Bit1 m)) 0 \<longleftrightarrow> True\<close>  | 
|
3158  | 
\<open>bit (Int.Neg (num.Bit0 m)) 0 \<longleftrightarrow> False\<close>  | 
|
3159  | 
\<open>bit (Int.Neg (num.Bit1 m)) 0 \<longleftrightarrow> True\<close>  | 
|
3160  | 
\<open>bit (Int.Pos num.One) (Suc n) \<longleftrightarrow> False\<close>  | 
|
3161  | 
\<open>bit (Int.Pos (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>  | 
|
3162  | 
\<open>bit (Int.Pos (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Pos m) n\<close>  | 
|
3163  | 
\<open>bit (Int.Neg (num.Bit0 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg m) n\<close>  | 
|
3164  | 
\<open>bit (Int.Neg (num.Bit1 m)) (Suc n) \<longleftrightarrow> bit (Int.Neg (Num.inc m)) n\<close>  | 
|
3165  | 
by (simp_all add: Num.add_One bit_0 bit_Suc)  | 
|
3166  | 
||
3167  | 
lemma not_int_code [code]:  | 
|
3168  | 
\<open>NOT (0 :: int) = - 1\<close>  | 
|
3169  | 
\<open>NOT (Int.Pos n) = Int.Neg (Num.inc n)\<close>  | 
|
3170  | 
\<open>NOT (Int.Neg n) = Num.sub n num.One\<close>  | 
|
3171  | 
by (simp_all add: Num.add_One not_int_def)  | 
|
3172  | 
||
3173  | 
fun and_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>  | 
|
3174  | 
where  | 
|
3175  | 
\<open>and_num num.One num.One = Some num.One\<close>  | 
|
3176  | 
| \<open>and_num num.One (num.Bit0 n) = None\<close>  | 
|
3177  | 
| \<open>and_num num.One (num.Bit1 n) = Some num.One\<close>  | 
|
3178  | 
| \<open>and_num (num.Bit0 m) num.One = None\<close>  | 
|
3179  | 
| \<open>and_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>  | 
|
3180  | 
| \<open>and_num (num.Bit0 m) (num.Bit1 n) = map_option num.Bit0 (and_num m n)\<close>  | 
|
3181  | 
| \<open>and_num (num.Bit1 m) num.One = Some num.One\<close>  | 
|
3182  | 
| \<open>and_num (num.Bit1 m) (num.Bit0 n) = map_option num.Bit0 (and_num m n)\<close>  | 
|
3183  | 
| \<open>and_num (num.Bit1 m) (num.Bit1 n) = (case and_num m n of None \<Rightarrow> Some num.One | Some n' \<Rightarrow> Some (num.Bit1 n'))\<close>  | 
|
3184  | 
||
3185  | 
context linordered_euclidean_semiring_bit_operations  | 
|
3186  | 
begin  | 
|
3187  | 
||
3188  | 
lemma numeral_and_num:  | 
|
3189  | 
\<open>numeral m AND numeral n = (case and_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>  | 
|
3190  | 
by (induction m n rule: and_num.induct) (simp_all add: split: option.split)  | 
|
3191  | 
||
3192  | 
lemma and_num_eq_None_iff:  | 
|
3193  | 
\<open>and_num m n = None \<longleftrightarrow> numeral m AND numeral n = 0\<close>  | 
|
3194  | 
by (simp add: numeral_and_num split: option.split)  | 
|
3195  | 
||
3196  | 
lemma and_num_eq_Some_iff:  | 
|
3197  | 
\<open>and_num m n = Some q \<longleftrightarrow> numeral m AND numeral n = numeral q\<close>  | 
|
3198  | 
by (simp add: numeral_and_num split: option.split)  | 
|
3199  | 
||
3200  | 
end  | 
|
3201  | 
||
3202  | 
lemma and_int_code [code]:  | 
|
3203  | 
fixes i j :: int shows  | 
|
3204  | 
\<open>0 AND j = 0\<close>  | 
|
3205  | 
\<open>i AND 0 = 0\<close>  | 
|
3206  | 
\<open>Int.Pos n AND Int.Pos m = (case and_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>  | 
|
3207  | 
\<open>Int.Neg n AND Int.Neg m = NOT (Num.sub n num.One OR Num.sub m num.One)\<close>  | 
|
3208  | 
\<open>Int.Pos n AND Int.Neg num.One = Int.Pos n\<close>  | 
|
3209  | 
\<open>Int.Pos n AND Int.Neg (num.Bit0 m) = Num.sub (or_not_num_neg (Num.BitM m) n) num.One\<close>  | 
|
3210  | 
\<open>Int.Pos n AND Int.Neg (num.Bit1 m) = Num.sub (or_not_num_neg (num.Bit0 m) n) num.One\<close>  | 
|
3211  | 
\<open>Int.Neg num.One AND Int.Pos m = Int.Pos m\<close>  | 
|
3212  | 
\<open>Int.Neg (num.Bit0 n) AND Int.Pos m = Num.sub (or_not_num_neg (Num.BitM n) m) num.One\<close>  | 
|
3213  | 
\<open>Int.Neg (num.Bit1 n) AND Int.Pos m = Num.sub (or_not_num_neg (num.Bit0 n) m) num.One\<close>  | 
|
| 80758 | 3214  | 
apply (auto simp: and_num_eq_None_iff [where ?'a = int] and_num_eq_Some_iff [where ?'a = int]  | 
| 79069 | 3215  | 
split: option.split)  | 
3216  | 
apply (simp_all only: sub_one_eq_not_neg numeral_or_not_num_eq minus_minus and_not_numerals  | 
|
3217  | 
bit.de_Morgan_disj bit.double_compl and_not_num_eq_None_iff and_not_num_eq_Some_iff ac_simps)  | 
|
3218  | 
done  | 
|
3219  | 
||
3220  | 
context linordered_euclidean_semiring_bit_operations  | 
|
3221  | 
begin  | 
|
3222  | 
||
3223  | 
fun or_num :: \<open>num \<Rightarrow> num \<Rightarrow> num\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>  | 
|
3224  | 
where  | 
|
3225  | 
\<open>or_num num.One num.One = num.One\<close>  | 
|
3226  | 
| \<open>or_num num.One (num.Bit0 n) = num.Bit1 n\<close>  | 
|
3227  | 
| \<open>or_num num.One (num.Bit1 n) = num.Bit1 n\<close>  | 
|
3228  | 
| \<open>or_num (num.Bit0 m) num.One = num.Bit1 m\<close>  | 
|
3229  | 
| \<open>or_num (num.Bit0 m) (num.Bit0 n) = num.Bit0 (or_num m n)\<close>  | 
|
3230  | 
| \<open>or_num (num.Bit0 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>  | 
|
3231  | 
| \<open>or_num (num.Bit1 m) num.One = num.Bit1 m\<close>  | 
|
3232  | 
| \<open>or_num (num.Bit1 m) (num.Bit0 n) = num.Bit1 (or_num m n)\<close>  | 
|
3233  | 
| \<open>or_num (num.Bit1 m) (num.Bit1 n) = num.Bit1 (or_num m n)\<close>  | 
|
3234  | 
||
3235  | 
lemma numeral_or_num:  | 
|
3236  | 
\<open>numeral m OR numeral n = numeral (or_num m n)\<close>  | 
|
3237  | 
by (induction m n rule: or_num.induct) simp_all  | 
|
3238  | 
||
3239  | 
lemma numeral_or_num_eq:  | 
|
3240  | 
\<open>numeral (or_num m n) = numeral m OR numeral n\<close>  | 
|
3241  | 
by (simp add: numeral_or_num)  | 
|
3242  | 
||
3243  | 
end  | 
|
3244  | 
||
3245  | 
lemma or_int_code [code]:  | 
|
3246  | 
fixes i j :: int shows  | 
|
3247  | 
\<open>0 OR j = j\<close>  | 
|
3248  | 
\<open>i OR 0 = i\<close>  | 
|
3249  | 
\<open>Int.Pos n OR Int.Pos m = Int.Pos (or_num n m)\<close>  | 
|
3250  | 
\<open>Int.Neg n OR Int.Neg m = NOT (Num.sub n num.One AND Num.sub m num.One)\<close>  | 
|
3251  | 
\<open>Int.Pos n OR Int.Neg num.One = Int.Neg num.One\<close>  | 
|
3252  | 
\<open>Int.Pos n OR Int.Neg (num.Bit0 m) = (case and_not_num (Num.BitM m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>  | 
|
3253  | 
\<open>Int.Pos n OR Int.Neg (num.Bit1 m) = (case and_not_num (num.Bit0 m) n of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>  | 
|
3254  | 
\<open>Int.Neg num.One OR Int.Pos m = Int.Neg num.One\<close>  | 
|
3255  | 
\<open>Int.Neg (num.Bit0 n) OR Int.Pos m = (case and_not_num (Num.BitM n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>  | 
|
3256  | 
\<open>Int.Neg (num.Bit1 n) OR Int.Pos m = (case and_not_num (num.Bit0 n) m of None \<Rightarrow> -1 | Some n' \<Rightarrow> Int.Neg (Num.inc n'))\<close>  | 
|
| 80758 | 3257  | 
apply (auto simp: numeral_or_num_eq split: option.splits)  | 
| 79069 | 3258  | 
apply (simp_all only: and_not_num_eq_None_iff and_not_num_eq_Some_iff and_not_numerals  | 
3259  | 
numeral_or_not_num_eq or_eq_not_not_and bit.double_compl ac_simps flip: numeral_eq_iff [where ?'a = int])  | 
|
3260  | 
apply simp_all  | 
|
3261  | 
done  | 
|
3262  | 
||
3263  | 
fun xor_num :: \<open>num \<Rightarrow> num \<Rightarrow> num option\<close> \<^marker>\<open>contributor \<open>Andreas Lochbihler\<close>\<close>  | 
|
3264  | 
where  | 
|
3265  | 
\<open>xor_num num.One num.One = None\<close>  | 
|
3266  | 
| \<open>xor_num num.One (num.Bit0 n) = Some (num.Bit1 n)\<close>  | 
|
3267  | 
| \<open>xor_num num.One (num.Bit1 n) = Some (num.Bit0 n)\<close>  | 
|
3268  | 
| \<open>xor_num (num.Bit0 m) num.One = Some (num.Bit1 m)\<close>  | 
|
3269  | 
| \<open>xor_num (num.Bit0 m) (num.Bit0 n) = map_option num.Bit0 (xor_num m n)\<close>  | 
|
3270  | 
| \<open>xor_num (num.Bit0 m) (num.Bit1 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>  | 
|
3271  | 
| \<open>xor_num (num.Bit1 m) num.One = Some (num.Bit0 m)\<close>  | 
|
3272  | 
| \<open>xor_num (num.Bit1 m) (num.Bit0 n) = Some (case xor_num m n of None \<Rightarrow> num.One | Some n' \<Rightarrow> num.Bit1 n')\<close>  | 
|
3273  | 
| \<open>xor_num (num.Bit1 m) (num.Bit1 n) = map_option num.Bit0 (xor_num m n)\<close>  | 
|
3274  | 
||
3275  | 
context linordered_euclidean_semiring_bit_operations  | 
|
3276  | 
begin  | 
|
3277  | 
||
3278  | 
lemma numeral_xor_num:  | 
|
3279  | 
\<open>numeral m XOR numeral n = (case xor_num m n of None \<Rightarrow> 0 | Some n' \<Rightarrow> numeral n')\<close>  | 
|
3280  | 
by (induction m n rule: xor_num.induct) (simp_all split: option.split)  | 
|
3281  | 
||
3282  | 
lemma xor_num_eq_None_iff:  | 
|
3283  | 
\<open>xor_num m n = None \<longleftrightarrow> numeral m XOR numeral n = 0\<close>  | 
|
3284  | 
by (simp add: numeral_xor_num split: option.split)  | 
|
3285  | 
||
3286  | 
lemma xor_num_eq_Some_iff:  | 
|
3287  | 
\<open>xor_num m n = Some q \<longleftrightarrow> numeral m XOR numeral n = numeral q\<close>  | 
|
3288  | 
by (simp add: numeral_xor_num split: option.split)  | 
|
3289  | 
||
3290  | 
end  | 
|
3291  | 
||
| 
81876
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3292  | 
context semiring_bit_operations  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3293  | 
begin  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3294  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3295  | 
lemma push_bit_eq_pow:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3296  | 
\<open>push_bit (numeral n) 1 = numeral (Num.pow (Num.Bit0 Num.One) n)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3297  | 
by simp  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3298  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3299  | 
lemma set_bit_of_0 [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3300  | 
\<open>set_bit n 0 = 2 ^ n\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3301  | 
by (simp add: set_bit_eq_or)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3302  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3303  | 
lemma unset_bit_of_0 [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3304  | 
\<open>unset_bit n 0 = 0\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3305  | 
by (simp add: unset_bit_eq_or_xor)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3306  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3307  | 
lemma flip_bit_of_0 [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3308  | 
\<open>flip_bit n 0 = 2 ^ n\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3309  | 
by (simp add: flip_bit_eq_xor)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3310  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3311  | 
lemma set_bit_0_numeral_eq [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3312  | 
\<open>set_bit 0 (numeral Num.One) = 1\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3313  | 
\<open>set_bit 0 (numeral (Num.Bit0 m)) = numeral (Num.Bit1 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3314  | 
\<open>set_bit 0 (numeral (Num.Bit1 m)) = numeral (Num.Bit1 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3315  | 
by (simp_all add: set_bit_0)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3316  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3317  | 
lemma set_bit_numeral_eq_or [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3318  | 
\<open>set_bit (numeral n) (numeral m) = numeral m OR push_bit (numeral n) 1\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3319  | 
by (fact set_bit_eq_or)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3320  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3321  | 
lemma unset_bit_0_numeral_eq_and_not' [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3322  | 
\<open>unset_bit 0 (numeral Num.One) = 0\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3323  | 
\<open>unset_bit 0 (numeral (Num.Bit0 m)) = numeral (Num.Bit0 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3324  | 
\<open>unset_bit 0 (numeral (Num.Bit1 m)) = numeral (Num.Bit0 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3325  | 
by (simp_all add: unset_bit_0)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3326  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3327  | 
lemma unset_bit_numeral_eq_or [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3328  | 
\<open>unset_bit (numeral n) (numeral m) =  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3329  | 
(case and_not_num m (Num.pow (Num.Bit0 Num.One) n)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3330  | 
of None \<Rightarrow> 0  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3331  | 
| Some q \<Rightarrow> numeral q)\<close> (is \<open>?lhs = _\<close>)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3332  | 
proof -  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3333  | 
have \<open>?lhs = of_nat (unset_bit (numeral n) (numeral m))\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3334  | 
by (simp add: of_nat_unset_bit_eq)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3335  | 
also have \<open>unset_bit (numeral n) (numeral m) = nat (unset_bit (numeral n) (numeral m))\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3336  | 
by (simp flip: int_int_eq add: Bit_Operations.of_nat_unset_bit_eq)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3337  | 
finally have *: \<open>?lhs = of_nat (nat (unset_bit (numeral n) (numeral m)))\<close> .  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3338  | 
show ?thesis  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3339  | 
by (simp only: * unset_bit_eq_and_not Bit_Operations.push_bit_eq_pow int_numeral_and_not_num)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3340  | 
(auto split: option.splits)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3341  | 
qed  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3342  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3343  | 
lemma flip_bit_0_numeral_eq_or [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3344  | 
\<open>flip_bit 0 (numeral Num.One) = 0\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3345  | 
\<open>flip_bit 0 (numeral (Num.Bit0 m)) = numeral (Num.Bit1 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3346  | 
\<open>flip_bit 0 (numeral (Num.Bit1 m)) = numeral (Num.Bit0 m)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3347  | 
by (simp_all add: flip_bit_0)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3348  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3349  | 
lemma flip_bit_numeral_eq_xor [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3350  | 
\<open>flip_bit (numeral n) (numeral m) = numeral m XOR push_bit (numeral n) 1\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3351  | 
by (fact flip_bit_eq_xor)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3352  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3353  | 
end  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3354  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3355  | 
context ring_bit_operations  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3356  | 
begin  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3357  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3358  | 
lemma set_bit_minus_numeral_eq_or [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3359  | 
\<open>set_bit (numeral n) (- numeral m) = - numeral m OR push_bit (numeral n) 1\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3360  | 
by (fact set_bit_eq_or)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3361  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3362  | 
lemma unset_bit_minus_numeral_eq_and_not [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3363  | 
\<open>unset_bit (numeral n) (- numeral m) = - numeral m AND NOT (push_bit (numeral n) 1)\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3364  | 
by (fact unset_bit_eq_and_not)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3365  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3366  | 
lemma flip_bit_minus_numeral_eq_xor [simp]:  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3367  | 
\<open>flip_bit (numeral n) (- numeral m) = - numeral m XOR push_bit (numeral n) 1\<close>  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3368  | 
by (fact flip_bit_eq_xor)  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3369  | 
|
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3370  | 
end  | 
| 
 
ac0716ca151b
systematic checks for bit operations and more rules on symbolic terms
 
haftmann 
parents: 
81722 
diff
changeset
 | 
3371  | 
|
| 79069 | 3372  | 
lemma xor_int_code [code]:  | 
3373  | 
fixes i j :: int shows  | 
|
3374  | 
\<open>0 XOR j = j\<close>  | 
|
3375  | 
\<open>i XOR 0 = i\<close>  | 
|
3376  | 
\<open>Int.Pos n XOR Int.Pos m = (case xor_num n m of None \<Rightarrow> 0 | Some n' \<Rightarrow> Int.Pos n')\<close>  | 
|
3377  | 
\<open>Int.Neg n XOR Int.Neg m = Num.sub n num.One XOR Num.sub m num.One\<close>  | 
|
3378  | 
\<open>Int.Neg n XOR Int.Pos m = NOT (Num.sub n num.One XOR Int.Pos m)\<close>  | 
|
3379  | 
\<open>Int.Pos n XOR Int.Neg m = NOT (Int.Pos n XOR Num.sub m num.One)\<close>  | 
|
3380  | 
by (simp_all add: xor_num_eq_None_iff [where ?'a = int] xor_num_eq_Some_iff [where ?'a = int] split: option.split)  | 
|
3381  | 
||
3382  | 
lemma push_bit_int_code [code]:  | 
|
3383  | 
\<open>push_bit 0 i = i\<close>  | 
|
3384  | 
\<open>push_bit (Suc n) i = push_bit n (Int.dup i)\<close>  | 
|
3385  | 
by (simp_all add: ac_simps)  | 
|
3386  | 
||
3387  | 
lemma drop_bit_int_code [code]:  | 
|
3388  | 
fixes i :: int shows  | 
|
3389  | 
\<open>drop_bit 0 i = i\<close>  | 
|
3390  | 
\<open>drop_bit (Suc n) 0 = (0 :: int)\<close>  | 
|
3391  | 
\<open>drop_bit (Suc n) (Int.Pos num.One) = 0\<close>  | 
|
3392  | 
\<open>drop_bit (Suc n) (Int.Pos (num.Bit0 m)) = drop_bit n (Int.Pos m)\<close>  | 
|
3393  | 
\<open>drop_bit (Suc n) (Int.Pos (num.Bit1 m)) = drop_bit n (Int.Pos m)\<close>  | 
|
3394  | 
\<open>drop_bit (Suc n) (Int.Neg num.One) = - 1\<close>  | 
|
3395  | 
\<open>drop_bit (Suc n) (Int.Neg (num.Bit0 m)) = drop_bit n (Int.Neg m)\<close>  | 
|
3396  | 
\<open>drop_bit (Suc n) (Int.Neg (num.Bit1 m)) = drop_bit n (Int.Neg (Num.inc m))\<close>  | 
|
3397  | 
by (simp_all add: drop_bit_Suc add_One)  | 
|
3398  | 
||
3399  | 
||
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
3400  | 
subsection \<open>More properties\<close>  | 
| 
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
3401  | 
|
| 72830 | 3402  | 
lemma take_bit_eq_mask_iff:  | 
3403  | 
\<open>take_bit n k = mask n \<longleftrightarrow> take_bit n (k + 1) = 0\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
|
3404  | 
for k :: int  | 
|
3405  | 
proof  | 
|
3406  | 
assume ?P  | 
|
3407  | 
then have \<open>take_bit n (take_bit n k + take_bit n 1) = 0\<close>  | 
|
| 
74108
 
3146646a43a7
simplified hierarchy of type classes for bit operations
 
haftmann 
parents: 
74101 
diff
changeset
 | 
3408  | 
by (simp add: mask_eq_exp_minus_1 take_bit_eq_0_iff)  | 
| 72830 | 3409  | 
then show ?Q  | 
3410  | 
by (simp only: take_bit_add)  | 
|
3411  | 
next  | 
|
3412  | 
assume ?Q  | 
|
3413  | 
then have \<open>take_bit n (k + 1) - 1 = - 1\<close>  | 
|
3414  | 
by simp  | 
|
3415  | 
then have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n (- 1)\<close>  | 
|
3416  | 
by simp  | 
|
3417  | 
moreover have \<open>take_bit n (take_bit n (k + 1) - 1) = take_bit n k\<close>  | 
|
3418  | 
by (simp add: take_bit_eq_mod mod_simps)  | 
|
3419  | 
ultimately show ?P  | 
|
| 74592 | 3420  | 
by simp  | 
| 72830 | 3421  | 
qed  | 
3422  | 
||
3423  | 
lemma take_bit_eq_mask_iff_exp_dvd:  | 
|
3424  | 
\<open>take_bit n k = mask n \<longleftrightarrow> 2 ^ n dvd k + 1\<close>  | 
|
3425  | 
for k :: int  | 
|
3426  | 
by (simp add: take_bit_eq_mask_iff flip: take_bit_eq_0_iff)  | 
|
3427  | 
||
| 71442 | 3428  | 
|
| 72028 | 3429  | 
subsection \<open>Bit concatenation\<close>  | 
3430  | 
||
3431  | 
definition concat_bit :: \<open>nat \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int\<close>  | 
|
| 72227 | 3432  | 
where \<open>concat_bit n k l = take_bit n k OR push_bit n l\<close>  | 
| 72028 | 3433  | 
|
| 
72611
 
c7bc3e70a8c7
official collection for bit projection simplifications
 
haftmann 
parents: 
72512 
diff
changeset
 | 
3434  | 
lemma bit_concat_bit_iff [bit_simps]:  | 
| 72028 | 3435  | 
\<open>bit (concat_bit m k l) n \<longleftrightarrow> n < m \<and> bit k n \<or> m \<le> n \<and> bit l (n - m)\<close>  | 
| 72227 | 3436  | 
by (simp add: concat_bit_def bit_or_iff bit_and_iff bit_take_bit_iff bit_push_bit_iff ac_simps)  | 
| 72028 | 3437  | 
|
3438  | 
lemma concat_bit_eq:  | 
|
3439  | 
\<open>concat_bit n k l = take_bit n k + push_bit n l\<close>  | 
|
| 79610 | 3440  | 
proof -  | 
3441  | 
have \<open>take_bit n k AND push_bit n l = 0\<close>  | 
|
3442  | 
by (simp add: bit_eq_iff bit_simps)  | 
|
3443  | 
then show ?thesis  | 
|
3444  | 
by (simp add: bit_eq_iff bit_simps disjunctive_add_eq_or)  | 
|
3445  | 
qed  | 
|
| 72028 | 3446  | 
|
3447  | 
lemma concat_bit_0 [simp]:  | 
|
3448  | 
\<open>concat_bit 0 k l = l\<close>  | 
|
3449  | 
by (simp add: concat_bit_def)  | 
|
3450  | 
||
3451  | 
lemma concat_bit_Suc:  | 
|
3452  | 
\<open>concat_bit (Suc n) k l = k mod 2 + 2 * concat_bit n (k div 2) l\<close>  | 
|
3453  | 
by (simp add: concat_bit_eq take_bit_Suc push_bit_double)  | 
|
3454  | 
||
3455  | 
lemma concat_bit_of_zero_1 [simp]:  | 
|
3456  | 
\<open>concat_bit n 0 l = push_bit n l\<close>  | 
|
3457  | 
by (simp add: concat_bit_def)  | 
|
3458  | 
||
3459  | 
lemma concat_bit_of_zero_2 [simp]:  | 
|
3460  | 
\<open>concat_bit n k 0 = take_bit n k\<close>  | 
|
3461  | 
by (simp add: concat_bit_def take_bit_eq_mask)  | 
|
3462  | 
||
3463  | 
lemma concat_bit_nonnegative_iff [simp]:  | 
|
3464  | 
\<open>concat_bit n k l \<ge> 0 \<longleftrightarrow> l \<ge> 0\<close>  | 
|
3465  | 
by (simp add: concat_bit_def)  | 
|
3466  | 
||
3467  | 
lemma concat_bit_negative_iff [simp]:  | 
|
3468  | 
\<open>concat_bit n k l < 0 \<longleftrightarrow> l < 0\<close>  | 
|
3469  | 
by (simp add: concat_bit_def)  | 
|
3470  | 
||
3471  | 
lemma concat_bit_assoc:  | 
|
3472  | 
\<open>concat_bit n k (concat_bit m l r) = concat_bit (m + n) (concat_bit n k l) r\<close>  | 
|
| 80758 | 3473  | 
by (rule bit_eqI) (auto simp: bit_concat_bit_iff ac_simps)  | 
| 72028 | 3474  | 
|
3475  | 
lemma concat_bit_assoc_sym:  | 
|
3476  | 
\<open>concat_bit m (concat_bit n k l) r = concat_bit (min m n) k (concat_bit (m - n) l r)\<close>  | 
|
| 80758 | 3477  | 
by (rule bit_eqI) (auto simp: bit_concat_bit_iff ac_simps min_def)  | 
| 72028 | 3478  | 
|
| 72227 | 3479  | 
lemma concat_bit_eq_iff:  | 
3480  | 
\<open>concat_bit n k l = concat_bit n r s  | 
|
3481  | 
\<longleftrightarrow> take_bit n k = take_bit n r \<and> l = s\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>)  | 
|
3482  | 
proof  | 
|
3483  | 
assume ?Q  | 
|
3484  | 
then show ?P  | 
|
3485  | 
by (simp add: concat_bit_def)  | 
|
3486  | 
next  | 
|
3487  | 
assume ?P  | 
|
3488  | 
then have *: \<open>bit (concat_bit n k l) m = bit (concat_bit n r s) m\<close> for m  | 
|
3489  | 
by (simp add: bit_eq_iff)  | 
|
3490  | 
have \<open>take_bit n k = take_bit n r\<close>  | 
|
3491  | 
proof (rule bit_eqI)  | 
|
3492  | 
fix m  | 
|
3493  | 
from * [of m]  | 
|
3494  | 
show \<open>bit (take_bit n k) m \<longleftrightarrow> bit (take_bit n r) m\<close>  | 
|
| 80758 | 3495  | 
by (auto simp: bit_take_bit_iff bit_concat_bit_iff)  | 
| 72227 | 3496  | 
qed  | 
3497  | 
moreover have \<open>push_bit n l = push_bit n s\<close>  | 
|
3498  | 
proof (rule bit_eqI)  | 
|
3499  | 
fix m  | 
|
3500  | 
from * [of m]  | 
|
3501  | 
show \<open>bit (push_bit n l) m \<longleftrightarrow> bit (push_bit n s) m\<close>  | 
|
| 80758 | 3502  | 
by (auto simp: bit_push_bit_iff bit_concat_bit_iff)  | 
| 72227 | 3503  | 
qed  | 
3504  | 
then have \<open>l = s\<close>  | 
|
3505  | 
by (simp add: push_bit_eq_mult)  | 
|
3506  | 
ultimately show ?Q  | 
|
3507  | 
by (simp add: concat_bit_def)  | 
|
3508  | 
qed  | 
|
3509  | 
||
3510  | 
lemma take_bit_concat_bit_eq:  | 
|
3511  | 
\<open>take_bit m (concat_bit n k l) = concat_bit (min m n) k (take_bit (m - n) l)\<close>  | 
|
3512  | 
by (rule bit_eqI)  | 
|
| 80758 | 3513  | 
(auto simp: bit_take_bit_iff bit_concat_bit_iff min_def)  | 
| 72227 | 3514  | 
|
| 72488 | 3515  | 
lemma concat_bit_take_bit_eq:  | 
3516  | 
\<open>concat_bit n (take_bit n b) = concat_bit n b\<close>  | 
|
3517  | 
by (simp add: concat_bit_def [abs_def])  | 
|
3518  | 
||
| 72028 | 3519  | 
|
| 72241 | 3520  | 
subsection \<open>Taking bits with sign propagation\<close>  | 
| 72010 | 3521  | 
|
| 72241 | 3522  | 
context ring_bit_operations  | 
3523  | 
begin  | 
|
| 72010 | 3524  | 
|
| 72241 | 3525  | 
definition signed_take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close>  | 
3526  | 
where \<open>signed_take_bit n a = take_bit n a OR (of_bool (bit a n) * NOT (mask n))\<close>  | 
|
| 72227 | 3527  | 
|
| 72241 | 3528  | 
lemma signed_take_bit_eq_if_positive:  | 
3529  | 
\<open>signed_take_bit n a = take_bit n a\<close> if \<open>\<not> bit a n\<close>  | 
|
| 72010 | 3530  | 
using that by (simp add: signed_take_bit_def)  | 
3531  | 
||
| 72241 | 3532  | 
lemma signed_take_bit_eq_if_negative:  | 
3533  | 
\<open>signed_take_bit n a = take_bit n a OR NOT (mask n)\<close> if \<open>bit a n\<close>  | 
|
3534  | 
using that by (simp add: signed_take_bit_def)  | 
|
3535  | 
||
3536  | 
lemma even_signed_take_bit_iff:  | 
|
3537  | 
\<open>even (signed_take_bit m a) \<longleftrightarrow> even a\<close>  | 
|
| 80758 | 3538  | 
by (auto simp: bit_0 signed_take_bit_def even_or_iff even_mask_iff bit_double_iff)  | 
| 72241 | 3539  | 
|
| 
72611
 
c7bc3e70a8c7
official collection for bit projection simplifications
 
haftmann 
parents: 
72512 
diff
changeset
 | 
3540  | 
lemma bit_signed_take_bit_iff [bit_simps]:  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
3541  | 
  \<open>bit (signed_take_bit m a) n \<longleftrightarrow> possible_bit TYPE('a) n \<and> bit a (min m n)\<close>
 | 
| 72241 | 3542  | 
by (simp add: signed_take_bit_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff min_def not_le)  | 
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
3543  | 
(blast dest: bit_imp_possible_bit)  | 
| 72010 | 3544  | 
|
3545  | 
lemma signed_take_bit_0 [simp]:  | 
|
| 72241 | 3546  | 
\<open>signed_take_bit 0 a = - (a mod 2)\<close>  | 
| 75085 | 3547  | 
by (simp add: bit_0 signed_take_bit_def odd_iff_mod_2_eq_one)  | 
| 72010 | 3548  | 
|
3549  | 
lemma signed_take_bit_Suc:  | 
|
| 72241 | 3550  | 
\<open>signed_take_bit (Suc n) a = a mod 2 + 2 * signed_take_bit n (a div 2)\<close>  | 
| 75085 | 3551  | 
by (simp add: bit_eq_iff bit_sum_mult_2_cases bit_simps bit_0 possible_bit_less_imp flip: bit_Suc min_Suc_Suc)  | 
| 72010 | 3552  | 
|
| 72187 | 3553  | 
lemma signed_take_bit_of_0 [simp]:  | 
3554  | 
\<open>signed_take_bit n 0 = 0\<close>  | 
|
3555  | 
by (simp add: signed_take_bit_def)  | 
|
3556  | 
||
3557  | 
lemma signed_take_bit_of_minus_1 [simp]:  | 
|
3558  | 
\<open>signed_take_bit n (- 1) = - 1\<close>  | 
|
| 74592 | 3559  | 
by (simp add: signed_take_bit_def mask_eq_exp_minus_1 possible_bit_def)  | 
| 72187 | 3560  | 
|
| 72241 | 3561  | 
lemma signed_take_bit_Suc_1 [simp]:  | 
3562  | 
\<open>signed_take_bit (Suc n) 1 = 1\<close>  | 
|
3563  | 
by (simp add: signed_take_bit_Suc)  | 
|
3564  | 
||
| 74497 | 3565  | 
lemma signed_take_bit_numeral_of_1 [simp]:  | 
3566  | 
\<open>signed_take_bit (numeral k) 1 = 1\<close>  | 
|
3567  | 
by (simp add: bit_1_iff signed_take_bit_eq_if_positive)  | 
|
3568  | 
||
| 72241 | 3569  | 
lemma signed_take_bit_rec:  | 
3570  | 
\<open>signed_take_bit n a = (if n = 0 then - (a mod 2) else a mod 2 + 2 * signed_take_bit (n - 1) (a div 2))\<close>  | 
|
3571  | 
by (cases n) (simp_all add: signed_take_bit_Suc)  | 
|
| 72187 | 3572  | 
|
3573  | 
lemma signed_take_bit_eq_iff_take_bit_eq:  | 
|
| 72241 | 3574  | 
\<open>signed_take_bit n a = signed_take_bit n b \<longleftrightarrow> take_bit (Suc n) a = take_bit (Suc n) b\<close>  | 
3575  | 
proof -  | 
|
3576  | 
have \<open>bit (signed_take_bit n a) = bit (signed_take_bit n b) \<longleftrightarrow> bit (take_bit (Suc n) a) = bit (take_bit (Suc n) b)\<close>  | 
|
3577  | 
by (simp add: fun_eq_iff bit_signed_take_bit_iff bit_take_bit_iff not_le less_Suc_eq_le min_def)  | 
|
| 
74309
 
42523fbf643b
explicit predicate for confined bit range avoids cyclic rewriting in presence of extensionality rule for bit values (contributed by Thomas Sewell)
 
haftmann 
parents: 
74163 
diff
changeset
 | 
3578  | 
(use bit_imp_possible_bit in fastforce)  | 
| 72187 | 3579  | 
then show ?thesis  | 
| 80758 | 3580  | 
by (auto simp: fun_eq_iff intro: bit_eqI)  | 
| 72187 | 3581  | 
qed  | 
3582  | 
||
| 72241 | 3583  | 
lemma signed_take_bit_signed_take_bit [simp]:  | 
3584  | 
\<open>signed_take_bit m (signed_take_bit n a) = signed_take_bit (min m n) a\<close>  | 
|
| 80758 | 3585  | 
by (auto simp: bit_eq_iff bit_simps ac_simps)  | 
| 72241 | 3586  | 
|
3587  | 
lemma signed_take_bit_take_bit:  | 
|
3588  | 
\<open>signed_take_bit m (take_bit n a) = (if n \<le> m then take_bit n else signed_take_bit m) a\<close>  | 
|
| 80758 | 3589  | 
by (rule bit_eqI) (auto simp: bit_signed_take_bit_iff min_def bit_take_bit_iff)  | 
| 72241 | 3590  | 
|
| 72187 | 3591  | 
lemma take_bit_signed_take_bit:  | 
| 72241 | 3592  | 
\<open>take_bit m (signed_take_bit n a) = take_bit m a\<close> if \<open>m \<le> Suc n\<close>  | 
| 72187 | 3593  | 
using that by (rule le_SucE; intro bit_eqI)  | 
| 80758 | 3594  | 
(auto simp: bit_take_bit_iff bit_signed_take_bit_iff min_def less_Suc_eq)  | 
| 72187 | 3595  | 
|
| 79610 | 3596  | 
lemma signed_take_bit_eq_take_bit_add:  | 
3597  | 
\<open>signed_take_bit n k = take_bit (Suc n) k + NOT (mask (Suc n)) * of_bool (bit k n)\<close>  | 
|
3598  | 
proof (cases \<open>bit k n\<close>)  | 
|
3599  | 
case False  | 
|
3600  | 
show ?thesis  | 
|
3601  | 
by (rule bit_eqI) (simp add: False bit_simps min_def less_Suc_eq)  | 
|
3602  | 
next  | 
|
3603  | 
case True  | 
|
3604  | 
have \<open>signed_take_bit n k = take_bit (Suc n) k OR NOT (mask (Suc n))\<close>  | 
|
| 80758 | 3605  | 
by (rule bit_eqI) (auto simp: bit_signed_take_bit_iff min_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff less_Suc_eq True)  | 
| 79610 | 3606  | 
also have \<open>\<dots> = take_bit (Suc n) k + NOT (mask (Suc n))\<close>  | 
3607  | 
by (simp add: disjunctive_add_eq_or bit_eq_iff bit_simps)  | 
|
3608  | 
finally show ?thesis  | 
|
3609  | 
by (simp add: True)  | 
|
3610  | 
qed  | 
|
3611  | 
||
3612  | 
lemma signed_take_bit_eq_take_bit_minus:  | 
|
3613  | 
\<open>signed_take_bit n k = take_bit (Suc n) k - 2 ^ Suc n * of_bool (bit k n)\<close>  | 
|
3614  | 
by (simp add: signed_take_bit_eq_take_bit_add flip: minus_exp_eq_not_mask)  | 
|
3615  | 
||
| 72241 | 3616  | 
end  | 
3617  | 
||
3618  | 
text \<open>Modulus centered around 0\<close>  | 
|
3619  | 
||
3620  | 
lemma signed_take_bit_eq_concat_bit:  | 
|
3621  | 
\<open>signed_take_bit n k = concat_bit n k (- of_bool (bit k n))\<close>  | 
|
| 74592 | 3622  | 
by (simp add: concat_bit_def signed_take_bit_def)  | 
| 72241 | 3623  | 
|
| 72187 | 3624  | 
lemma signed_take_bit_add:  | 
3625  | 
\<open>signed_take_bit n (signed_take_bit n k + signed_take_bit n l) = signed_take_bit n (k + l)\<close>  | 
|
| 72241 | 3626  | 
for k l :: int  | 
| 72187 | 3627  | 
proof -  | 
3628  | 
have \<open>take_bit (Suc n)  | 
|
3629  | 
(take_bit (Suc n) (signed_take_bit n k) +  | 
|
3630  | 
take_bit (Suc n) (signed_take_bit n l)) =  | 
|
3631  | 
take_bit (Suc n) (k + l)\<close>  | 
|
3632  | 
by (simp add: take_bit_signed_take_bit take_bit_add)  | 
|
3633  | 
then show ?thesis  | 
|
3634  | 
by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_add)  | 
|
3635  | 
qed  | 
|
3636  | 
||
3637  | 
lemma signed_take_bit_diff:  | 
|
3638  | 
\<open>signed_take_bit n (signed_take_bit n k - signed_take_bit n l) = signed_take_bit n (k - l)\<close>  | 
|
| 72241 | 3639  | 
for k l :: int  | 
| 72187 | 3640  | 
proof -  | 
3641  | 
have \<open>take_bit (Suc n)  | 
|
3642  | 
(take_bit (Suc n) (signed_take_bit n k) -  | 
|
3643  | 
take_bit (Suc n) (signed_take_bit n l)) =  | 
|
3644  | 
take_bit (Suc n) (k - l)\<close>  | 
|
3645  | 
by (simp add: take_bit_signed_take_bit take_bit_diff)  | 
|
3646  | 
then show ?thesis  | 
|
3647  | 
by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_diff)  | 
|
3648  | 
qed  | 
|
3649  | 
||
3650  | 
lemma signed_take_bit_minus:  | 
|
3651  | 
\<open>signed_take_bit n (- signed_take_bit n k) = signed_take_bit n (- k)\<close>  | 
|
| 72241 | 3652  | 
for k :: int  | 
| 72187 | 3653  | 
proof -  | 
3654  | 
have \<open>take_bit (Suc n)  | 
|
3655  | 
(- take_bit (Suc n) (signed_take_bit n k)) =  | 
|
3656  | 
take_bit (Suc n) (- k)\<close>  | 
|
3657  | 
by (simp add: take_bit_signed_take_bit take_bit_minus)  | 
|
3658  | 
then show ?thesis  | 
|
3659  | 
by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_minus)  | 
|
3660  | 
qed  | 
|
3661  | 
||
3662  | 
lemma signed_take_bit_mult:  | 
|
3663  | 
\<open>signed_take_bit n (signed_take_bit n k * signed_take_bit n l) = signed_take_bit n (k * l)\<close>  | 
|
| 72241 | 3664  | 
for k l :: int  | 
| 72187 | 3665  | 
proof -  | 
3666  | 
have \<open>take_bit (Suc n)  | 
|
3667  | 
(take_bit (Suc n) (signed_take_bit n k) *  | 
|
3668  | 
take_bit (Suc n) (signed_take_bit n l)) =  | 
|
3669  | 
take_bit (Suc n) (k * l)\<close>  | 
|
3670  | 
by (simp add: take_bit_signed_take_bit take_bit_mult)  | 
|
3671  | 
then show ?thesis  | 
|
3672  | 
by (simp only: signed_take_bit_eq_iff_take_bit_eq take_bit_mult)  | 
|
3673  | 
qed  | 
|
3674  | 
||
| 72010 | 3675  | 
lemma signed_take_bit_eq_take_bit_shift:  | 
| 79610 | 3676  | 
\<open>signed_take_bit n k = take_bit (Suc n) (k + 2 ^ n) - 2 ^ n\<close> (is \<open>?lhs = ?rhs\<close>)  | 
| 72241 | 3677  | 
for k :: int  | 
| 72010 | 3678  | 
proof -  | 
| 79610 | 3679  | 
have \<open>take_bit n k AND 2 ^ n = 0\<close>  | 
3680  | 
by (rule bit_eqI) (simp add: bit_simps)  | 
|
3681  | 
then have *: \<open>take_bit n k OR 2 ^ n = take_bit n k + 2 ^ n\<close>  | 
|
3682  | 
by (simp add: disjunctive_add_eq_or)  | 
|
| 72010 | 3683  | 
have \<open>take_bit n k - 2 ^ n = take_bit n k + NOT (mask n)\<close>  | 
3684  | 
by (simp add: minus_exp_eq_not_mask)  | 
|
3685  | 
also have \<open>\<dots> = take_bit n k OR NOT (mask n)\<close>  | 
|
| 79610 | 3686  | 
by (rule disjunctive_add_eq_or) (simp add: bit_eq_iff bit_simps)  | 
| 72010 | 3687  | 
finally have **: \<open>take_bit n k - 2 ^ n = take_bit n k OR NOT (mask n)\<close> .  | 
3688  | 
have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (take_bit (Suc n) k + take_bit (Suc n) (2 ^ n))\<close>  | 
|
3689  | 
by (simp only: take_bit_add)  | 
|
3690  | 
also have \<open>take_bit (Suc n) k = 2 ^ n * of_bool (bit k n) + take_bit n k\<close>  | 
|
3691  | 
by (simp add: take_bit_Suc_from_most)  | 
|
3692  | 
finally have \<open>take_bit (Suc n) (k + 2 ^ n) = take_bit (Suc n) (2 ^ (n + of_bool (bit k n)) + take_bit n k)\<close>  | 
|
3693  | 
by (simp add: ac_simps)  | 
|
3694  | 
also have \<open>2 ^ (n + of_bool (bit k n)) + take_bit n k = 2 ^ (n + of_bool (bit k n)) OR take_bit n k\<close>  | 
|
| 79610 | 3695  | 
by (rule disjunctive_add_eq_or, rule bit_eqI) (simp add: bit_simps)  | 
| 72010 | 3696  | 
finally show ?thesis  | 
| 72241 | 3697  | 
using * ** by (simp add: signed_take_bit_def concat_bit_Suc min_def ac_simps)  | 
| 72010 | 3698  | 
qed  | 
3699  | 
||
3700  | 
lemma signed_take_bit_nonnegative_iff [simp]:  | 
|
3701  | 
\<open>0 \<le> signed_take_bit n k \<longleftrightarrow> \<not> bit k n\<close>  | 
|
| 72241 | 3702  | 
for k :: int  | 
| 72028 | 3703  | 
by (simp add: signed_take_bit_def not_less concat_bit_def)  | 
| 72010 | 3704  | 
|
3705  | 
lemma signed_take_bit_negative_iff [simp]:  | 
|
3706  | 
\<open>signed_take_bit n k < 0 \<longleftrightarrow> bit k n\<close>  | 
|
| 72241 | 3707  | 
for k :: int  | 
| 72028 | 3708  | 
by (simp add: signed_take_bit_def not_less concat_bit_def)  | 
| 72010 | 3709  | 
|
| 73868 | 3710  | 
lemma signed_take_bit_int_greater_eq_minus_exp [simp]:  | 
3711  | 
\<open>- (2 ^ n) \<le> signed_take_bit n k\<close>  | 
|
3712  | 
for k :: int  | 
|
3713  | 
by (simp add: signed_take_bit_eq_take_bit_shift)  | 
|
3714  | 
||
3715  | 
lemma signed_take_bit_int_less_exp [simp]:  | 
|
3716  | 
\<open>signed_take_bit n k < 2 ^ n\<close>  | 
|
3717  | 
for k :: int  | 
|
3718  | 
using take_bit_int_less_exp [of \<open>Suc n\<close>]  | 
|
3719  | 
by (simp add: signed_take_bit_eq_take_bit_shift)  | 
|
3720  | 
||
| 72261 | 3721  | 
lemma signed_take_bit_int_eq_self_iff:  | 
3722  | 
\<open>signed_take_bit n k = k \<longleftrightarrow> - (2 ^ n) \<le> k \<and> k < 2 ^ n\<close>  | 
|
3723  | 
for k :: int  | 
|
| 80758 | 3724  | 
by (auto simp: signed_take_bit_eq_take_bit_shift take_bit_int_eq_self_iff algebra_simps)  | 
| 72261 | 3725  | 
|
| 72262 | 3726  | 
lemma signed_take_bit_int_eq_self:  | 
3727  | 
\<open>signed_take_bit n k = k\<close> if \<open>- (2 ^ n) \<le> k\<close> \<open>k < 2 ^ n\<close>  | 
|
3728  | 
for k :: int  | 
|
3729  | 
using that by (simp add: signed_take_bit_int_eq_self_iff)  | 
|
3730  | 
||
| 72261 | 3731  | 
lemma signed_take_bit_int_less_eq_self_iff:  | 
3732  | 
\<open>signed_take_bit n k \<le> k \<longleftrightarrow> - (2 ^ n) \<le> k\<close>  | 
|
3733  | 
for k :: int  | 
|
3734  | 
by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_eq_self_iff algebra_simps)  | 
|
3735  | 
linarith  | 
|
3736  | 
||
3737  | 
lemma signed_take_bit_int_less_self_iff:  | 
|
3738  | 
\<open>signed_take_bit n k < k \<longleftrightarrow> 2 ^ n \<le> k\<close>  | 
|
3739  | 
for k :: int  | 
|
3740  | 
by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_less_self_iff algebra_simps)  | 
|
3741  | 
||
3742  | 
lemma signed_take_bit_int_greater_self_iff:  | 
|
3743  | 
\<open>k < signed_take_bit n k \<longleftrightarrow> k < - (2 ^ n)\<close>  | 
|
3744  | 
for k :: int  | 
|
3745  | 
by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_self_iff algebra_simps)  | 
|
3746  | 
linarith  | 
|
3747  | 
||
3748  | 
lemma signed_take_bit_int_greater_eq_self_iff:  | 
|
3749  | 
\<open>k \<le> signed_take_bit n k \<longleftrightarrow> k < 2 ^ n\<close>  | 
|
3750  | 
for k :: int  | 
|
3751  | 
by (simp add: signed_take_bit_eq_take_bit_shift take_bit_int_greater_eq_self_iff algebra_simps)  | 
|
3752  | 
||
3753  | 
lemma signed_take_bit_int_greater_eq:  | 
|
| 72010 | 3754  | 
\<open>k + 2 ^ Suc n \<le> signed_take_bit n k\<close> if \<open>k < - (2 ^ n)\<close>  | 
| 72241 | 3755  | 
for k :: int  | 
| 72262 | 3756  | 
using that take_bit_int_greater_eq [of \<open>k + 2 ^ n\<close> \<open>Suc n\<close>]  | 
| 72010 | 3757  | 
by (simp add: signed_take_bit_eq_take_bit_shift)  | 
3758  | 
||
| 72261 | 3759  | 
lemma signed_take_bit_int_less_eq:  | 
| 72010 | 3760  | 
\<open>signed_take_bit n k \<le> k - 2 ^ Suc n\<close> if \<open>k \<ge> 2 ^ n\<close>  | 
| 72241 | 3761  | 
for k :: int  | 
| 72262 | 3762  | 
using that take_bit_int_less_eq [of \<open>Suc n\<close> \<open>k + 2 ^ n\<close>]  | 
| 72010 | 3763  | 
by (simp add: signed_take_bit_eq_take_bit_shift)  | 
3764  | 
||
3765  | 
lemma signed_take_bit_Suc_bit0 [simp]:  | 
|
| 72241 | 3766  | 
\<open>signed_take_bit (Suc n) (numeral (Num.Bit0 k)) = signed_take_bit n (numeral k) * (2 :: int)\<close>  | 
| 72010 | 3767  | 
by (simp add: signed_take_bit_Suc)  | 
3768  | 
||
3769  | 
lemma signed_take_bit_Suc_bit1 [simp]:  | 
|
| 72241 | 3770  | 
\<open>signed_take_bit (Suc n) (numeral (Num.Bit1 k)) = signed_take_bit n (numeral k) * 2 + (1 :: int)\<close>  | 
| 72010 | 3771  | 
by (simp add: signed_take_bit_Suc)  | 
3772  | 
||
3773  | 
lemma signed_take_bit_Suc_minus_bit0 [simp]:  | 
|
| 72241 | 3774  | 
\<open>signed_take_bit (Suc n) (- numeral (Num.Bit0 k)) = signed_take_bit n (- numeral k) * (2 :: int)\<close>  | 
| 72010 | 3775  | 
by (simp add: signed_take_bit_Suc)  | 
3776  | 
||
3777  | 
lemma signed_take_bit_Suc_minus_bit1 [simp]:  | 
|
| 72241 | 3778  | 
\<open>signed_take_bit (Suc n) (- numeral (Num.Bit1 k)) = signed_take_bit n (- numeral k - 1) * 2 + (1 :: int)\<close>  | 
| 72010 | 3779  | 
by (simp add: signed_take_bit_Suc)  | 
3780  | 
||
3781  | 
lemma signed_take_bit_numeral_bit0 [simp]:  | 
|
| 72241 | 3782  | 
\<open>signed_take_bit (numeral l) (numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (numeral k) * (2 :: int)\<close>  | 
| 72010 | 3783  | 
by (simp add: signed_take_bit_rec)  | 
3784  | 
||
3785  | 
lemma signed_take_bit_numeral_bit1 [simp]:  | 
|
| 72241 | 3786  | 
\<open>signed_take_bit (numeral l) (numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (numeral k) * 2 + (1 :: int)\<close>  | 
| 72010 | 3787  | 
by (simp add: signed_take_bit_rec)  | 
3788  | 
||
3789  | 
lemma signed_take_bit_numeral_minus_bit0 [simp]:  | 
|
| 72241 | 3790  | 
\<open>signed_take_bit (numeral l) (- numeral (Num.Bit0 k)) = signed_take_bit (pred_numeral l) (- numeral k) * (2 :: int)\<close>  | 
| 72010 | 3791  | 
by (simp add: signed_take_bit_rec)  | 
3792  | 
||
3793  | 
lemma signed_take_bit_numeral_minus_bit1 [simp]:  | 
|
| 72241 | 3794  | 
\<open>signed_take_bit (numeral l) (- numeral (Num.Bit1 k)) = signed_take_bit (pred_numeral l) (- numeral k - 1) * 2 + (1 :: int)\<close>  | 
| 72010 | 3795  | 
by (simp add: signed_take_bit_rec)  | 
3796  | 
||
3797  | 
lemma signed_take_bit_code [code]:  | 
|
| 72241 | 3798  | 
\<open>signed_take_bit n a =  | 
3799  | 
(let l = take_bit (Suc n) a  | 
|
3800  | 
in if bit l n then l + push_bit (Suc n) (- 1) else l)\<close>  | 
|
| 79610 | 3801  | 
by (simp add: signed_take_bit_eq_take_bit_add bit_simps)  | 
| 72010 | 3802  | 
|
3803  | 
||
| 71800 | 3804  | 
subsection \<open>Key ideas of bit operations\<close>  | 
3805  | 
||
3806  | 
text \<open>  | 
|
3807  | 
When formalizing bit operations, it is tempting to represent  | 
|
3808  | 
bit values as explicit lists over a binary type. This however  | 
|
3809  | 
is a bad idea, mainly due to the inherent ambiguities in  | 
|
3810  | 
representation concerning repeating leading bits.  | 
|
3811  | 
||
3812  | 
Hence this approach avoids such explicit lists altogether  | 
|
3813  | 
following an algebraic path:  | 
|
3814  | 
||
3815  | 
\<^item> Bit values are represented by numeric types: idealized  | 
|
3816  | 
unbounded bit values can be represented by type \<^typ>\<open>int\<close>,  | 
|
3817  | 
bounded bit values by quotient types over \<^typ>\<open>int\<close>.  | 
|
3818  | 
||
3819  | 
\<^item> (A special case are idealized unbounded bit values ending  | 
|
3820  | 
    in @{term [source] 0} which can be represented by type \<^typ>\<open>nat\<close> but
 | 
|
3821  | 
only support a restricted set of operations).  | 
|
3822  | 
||
3823  | 
\<^item> From this idea follows that  | 
|
3824  | 
||
3825  | 
\<^item> multiplication by \<^term>\<open>2 :: int\<close> is a bit shift to the left and  | 
|
3826  | 
||
3827  | 
\<^item> division by \<^term>\<open>2 :: int\<close> is a bit shift to the right.  | 
|
3828  | 
||
3829  | 
\<^item> Concerning bounded bit values, iterated shifts to the left  | 
|
3830  | 
may result in eliminating all bits by shifting them all  | 
|
3831  | 
beyond the boundary. The property \<^prop>\<open>(2 :: int) ^ n \<noteq> 0\<close>  | 
|
3832  | 
represents that \<^term>\<open>n\<close> is \<^emph>\<open>not\<close> beyond that boundary.  | 
|
3833  | 
||
| 
71965
 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 
haftmann 
parents: 
71956 
diff
changeset
 | 
3834  | 
  \<^item> The projection on a single bit is then @{thm bit_iff_odd [where ?'a = int, no_vars]}.
 | 
| 71800 | 3835  | 
|
3836  | 
\<^item> This leads to the most fundamental properties of bit values:  | 
|
3837  | 
||
3838  | 
      \<^item> Equality rule: @{thm bit_eqI [where ?'a = int, no_vars]}
 | 
|
3839  | 
||
| 
79480
 
c7cb1bf6efa0
consolidated name of lemma analogously to nat/int/word_bit_induct
 
haftmann 
parents: 
79117 
diff
changeset
 | 
3840  | 
      \<^item> Induction rule: @{thm bit_induct [where ?'a = int, no_vars]}
 | 
| 71800 | 3841  | 
|
3842  | 
\<^item> Typical operations are characterized as follows:  | 
|
3843  | 
||
3844  | 
\<^item> Singleton \<^term>\<open>n\<close>th bit: \<^term>\<open>(2 :: int) ^ n\<close>  | 
|
3845  | 
||
| 71956 | 3846  | 
      \<^item> Bit mask upto bit \<^term>\<open>n\<close>: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]}
 | 
| 71800 | 3847  | 
|
3848  | 
      \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]}
 | 
|
3849  | 
||
3850  | 
      \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]}
 | 
|
3851  | 
||
3852  | 
      \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]}
 | 
|
3853  | 
||
3854  | 
      \<^item> Negation: @{thm bit_not_iff [where ?'a = int, no_vars]}
 | 
|
3855  | 
||
3856  | 
      \<^item> And: @{thm bit_and_iff [where ?'a = int, no_vars]}
 | 
|
3857  | 
||
3858  | 
      \<^item> Or: @{thm bit_or_iff [where ?'a = int, no_vars]}
 | 
|
3859  | 
||
3860  | 
      \<^item> Xor: @{thm bit_xor_iff [where ?'a = int, no_vars]}
 | 
|
3861  | 
||
| 79068 | 3862  | 
      \<^item> Set a single bit: @{thm set_bit_eq_or [where ?'a = int, no_vars]}
 | 
3863  | 
||
3864  | 
      \<^item> Unset a single bit: @{thm unset_bit_eq_and_not [where ?'a = int, no_vars]}
 | 
|
3865  | 
||
3866  | 
      \<^item> Flip a single bit: @{thm flip_bit_eq_xor [where ?'a = int, no_vars]}
 | 
|
| 72028 | 3867  | 
|
| 72241 | 3868  | 
      \<^item> Signed truncation, or modulus centered around \<^term>\<open>0::int\<close>: @{thm signed_take_bit_def [no_vars]}
 | 
| 72028 | 3869  | 
|
| 72241 | 3870  | 
      \<^item> Bit concatenation: @{thm concat_bit_def [no_vars]}
 | 
| 72028 | 3871  | 
|
3872  | 
      \<^item> (Bounded) conversion from and to a list of bits: @{thm horner_sum_bit_eq_take_bit [where ?'a = int, no_vars]}
 | 
|
| 71800 | 3873  | 
\<close>  | 
3874  | 
||
| 79068 | 3875  | 
|
3876  | 
subsection \<open>Lemma duplicates and other\<close>  | 
|
3877  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3878  | 
context semiring_bits  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3879  | 
begin  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3880  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3881  | 
lemma exp_div_exp_eq:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3882  | 
\<open>2 ^ m div 2 ^ n = of_bool (2 ^ m \<noteq> 0 \<and> m \<ge> n) * 2 ^ (m - n)\<close>  | 
| 80758 | 3883  | 
using bit_exp_iff div_exp_eq  | 
3884  | 
by (intro bit_eqI) (auto simp: bit_iff_odd possible_bit_def)  | 
|
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3885  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3886  | 
lemma bits_1_div_2:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3887  | 
\<open>1 div 2 = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3888  | 
by (fact half_1)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3889  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3890  | 
lemma bits_1_div_exp:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3891  | 
\<open>1 div 2 ^ n = of_bool (n = 0)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3892  | 
using div_exp_eq [of 1 1] by (cases n) simp_all  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3893  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3894  | 
lemma exp_add_not_zero_imp:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3895  | 
\<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> if \<open>2 ^ (m + n) \<noteq> 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3896  | 
proof -  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3897  | 
have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3898  | 
proof (rule notI)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3899  | 
assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3900  | 
then have \<open>2 ^ (m + n) = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3901  | 
by (rule disjE) (simp_all add: power_add)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3902  | 
with that show False ..  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3903  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3904  | 
then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3905  | 
by simp_all  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3906  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3907  | 
|
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3908  | 
lemma  | 
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3909  | 
exp_add_not_zero_imp_left: \<open>2 ^ m \<noteq> 0\<close>  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3910  | 
and exp_add_not_zero_imp_right: \<open>2 ^ n \<noteq> 0\<close>  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3911  | 
if \<open>2 ^ (m + n) \<noteq> 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3912  | 
proof -  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3913  | 
have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3914  | 
proof (rule notI)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3915  | 
assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3916  | 
then have \<open>2 ^ (m + n) = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3917  | 
by (rule disjE) (simp_all add: power_add)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3918  | 
with that show False ..  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3919  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3920  | 
then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3921  | 
by simp_all  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3922  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3923  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3924  | 
lemma exp_not_zero_imp_exp_diff_not_zero:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3925  | 
\<open>2 ^ (n - m) \<noteq> 0\<close> if \<open>2 ^ n \<noteq> 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3926  | 
proof (cases \<open>m \<le> n\<close>)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3927  | 
case True  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3928  | 
moreover define q where \<open>q = n - m\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3929  | 
ultimately have \<open>n = m + q\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3930  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3931  | 
with that show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3932  | 
by (simp add: exp_add_not_zero_imp_right)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3933  | 
next  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3934  | 
case False  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3935  | 
with that show ?thesis  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3936  | 
by simp  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3937  | 
qed  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3938  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3939  | 
lemma exp_eq_0_imp_not_bit:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3940  | 
\<open>\<not> bit a n\<close> if \<open>2 ^ n = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3941  | 
using that by (simp add: bit_iff_odd)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3942  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3943  | 
lemma bit_disjunctive_add_iff:  | 
| 79610 | 3944  | 
\<open>bit (a + b) n \<longleftrightarrow> bit a n \<or> bit b n\<close>  | 
3945  | 
if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>  | 
|
3946  | 
proof (cases \<open>possible_bit TYPE('a) n\<close>)
 | 
|
3947  | 
case False  | 
|
3948  | 
then show ?thesis  | 
|
3949  | 
by (auto dest: impossible_bit)  | 
|
3950  | 
next  | 
|
3951  | 
case True  | 
|
3952  | 
with that show ?thesis proof (induction n arbitrary: a b)  | 
|
3953  | 
case 0  | 
|
3954  | 
from "0.prems"(1) [of 0] show ?case  | 
|
| 80758 | 3955  | 
by (auto simp: bit_0)  | 
| 79610 | 3956  | 
next  | 
3957  | 
case (Suc n)  | 
|
3958  | 
from Suc.prems(1) [of 0] have even: \<open>even a \<or> even b\<close>  | 
|
| 80758 | 3959  | 
by (auto simp: bit_0)  | 
| 79610 | 3960  | 
have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n  | 
3961  | 
using Suc.prems(1) [of \<open>Suc n\<close>] by (simp add: bit_Suc)  | 
|
3962  | 
    from Suc.prems(2) have \<open>possible_bit TYPE('a) (Suc n)\<close> \<open>possible_bit TYPE('a) n\<close>
 | 
|
3963  | 
by (simp_all add: possible_bit_less_imp)  | 
|
3964  | 
have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close>  | 
|
3965  | 
using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp  | 
|
3966  | 
also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close>  | 
|
| 80758 | 3967  | 
using even by (auto simp: algebra_simps mod2_eq_if)  | 
| 79610 | 3968  | 
finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close>  | 
3969  | 
      using \<open>possible_bit TYPE('a) (Suc n)\<close> by simp (simp_all flip: bit_Suc add: bit_double_iff possible_bit_def)
 | 
|
3970  | 
also have \<open>\<dots> \<longleftrightarrow> bit (a div 2) n \<or> bit (b div 2) n\<close>  | 
|
3971  | 
      using bit \<open>possible_bit TYPE('a) n\<close> by (rule Suc.IH)
 | 
|
3972  | 
finally show ?case  | 
|
3973  | 
by (simp add: bit_Suc)  | 
|
3974  | 
qed  | 
|
3975  | 
qed  | 
|
3976  | 
||
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3977  | 
end  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3978  | 
|
| 79116 | 3979  | 
context semiring_bit_operations  | 
3980  | 
begin  | 
|
3981  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3982  | 
lemma even_mask_div_iff:  | 
| 79588 | 3983  | 
\<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> 2 ^ n = 0 \<or> m \<le> n\<close>  | 
| 80758 | 3984  | 
using bit_mask_iff [of m n] by (auto simp: mask_eq_exp_minus_1 bit_iff_odd possible_bit_def)  | 
| 79588 | 3985  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3986  | 
lemma mod_exp_eq:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3987  | 
\<open>a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3988  | 
by (simp flip: take_bit_eq_mod add: ac_simps)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3989  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3990  | 
lemma mult_exp_mod_exp_eq:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3991  | 
\<open>m \<le> n \<Longrightarrow> (a * 2 ^ m) mod (2 ^ n) = (a mod 2 ^ (n - m)) * 2 ^ m\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3992  | 
by (simp flip: push_bit_eq_mult take_bit_eq_mod add: push_bit_take_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3993  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3994  | 
lemma div_exp_mod_exp_eq:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3995  | 
\<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3996  | 
by (simp flip: drop_bit_eq_div take_bit_eq_mod add: drop_bit_take_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3997  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
3998  | 
lemma even_mult_exp_div_exp_iff:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
3999  | 
\<open>even (a * 2 ^ m div 2 ^ n) \<longleftrightarrow> m > n \<or> 2 ^ n = 0 \<or> (m \<le> n \<and> even (a div 2 ^ (n - m)))\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
4000  | 
by (simp flip: push_bit_eq_mult drop_bit_eq_div add: even_drop_bit_iff_not_bit bit_simps possible_bit_def) auto  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
4001  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4002  | 
lemma mod_exp_div_exp_eq_0:  | 
| 
79531
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
4003  | 
\<open>a mod 2 ^ n div 2 ^ n = 0\<close>  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
4004  | 
by (simp flip: take_bit_eq_mod drop_bit_eq_div add: drop_bit_take_bit)  | 
| 
 
22a137a6de44
rearranged and reformulated abstract classes for bit structures and operations
 
haftmann 
parents: 
79489 
diff
changeset
 | 
4005  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4006  | 
lemmas bits_one_mod_two_eq_one = one_mod_two_eq_one  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4007  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4008  | 
lemmas set_bit_def = set_bit_eq_or  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4009  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4010  | 
lemmas unset_bit_def = unset_bit_eq_and_not  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4011  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4012  | 
lemmas flip_bit_def = flip_bit_eq_xor  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4013  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4014  | 
lemma disjunctive_add:  | 
| 79610 | 4015  | 
\<open>a + b = a OR b\<close> if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close>  | 
4016  | 
by (rule disjunctive_add_eq_or) (use that in \<open>simp add: bit_eq_iff bit_simps\<close>)  | 
|
4017  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4018  | 
lemma even_mod_exp_div_exp_iff:  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
4019  | 
\<open>even (a mod 2 ^ m div 2 ^ n) \<longleftrightarrow> m \<le> n \<or> even (a div 2 ^ n)\<close>  | 
| 80758 | 4020  | 
by (auto simp: even_drop_bit_iff_not_bit bit_simps simp flip: drop_bit_eq_div take_bit_eq_mod)  | 
| 
79673
 
c172eecba85d
simplified specification of type class semiring_bits
 
haftmann 
parents: 
79610 
diff
changeset
 | 
4021  | 
|
| 79610 | 4022  | 
end  | 
4023  | 
||
4024  | 
context ring_bit_operations  | 
|
4025  | 
begin  | 
|
4026  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4027  | 
lemma disjunctive_diff:  | 
| 79610 | 4028  | 
\<open>a - b = a AND NOT b\<close> if \<open>\<And>n. bit b n \<Longrightarrow> bit a n\<close>  | 
4029  | 
proof -  | 
|
4030  | 
have \<open>NOT a + b = NOT a OR b\<close>  | 
|
| 80758 | 4031  | 
by (rule disjunctive_add) (auto simp: bit_not_iff dest: that)  | 
| 79610 | 4032  | 
then have \<open>NOT (NOT a + b) = NOT (NOT a OR b)\<close>  | 
4033  | 
by simp  | 
|
4034  | 
then show ?thesis  | 
|
4035  | 
by (simp add: not_add_distrib)  | 
|
4036  | 
qed  | 
|
4037  | 
||
| 79116 | 4038  | 
end  | 
4039  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4040  | 
lemma and_nat_rec:  | 
| 79070 | 4041  | 
\<open>m AND n = of_bool (odd m \<and> odd n) + 2 * ((m div 2) AND (n div 2))\<close> for m n :: nat  | 
4042  | 
by (fact and_rec)  | 
|
4043  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4044  | 
lemma or_nat_rec:  | 
| 79070 | 4045  | 
\<open>m OR n = of_bool (odd m \<or> odd n) + 2 * ((m div 2) OR (n div 2))\<close> for m n :: nat  | 
4046  | 
by (fact or_rec)  | 
|
4047  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4048  | 
lemma xor_nat_rec:  | 
| 79070 | 4049  | 
\<open>m XOR n = of_bool (odd m \<noteq> odd n) + 2 * ((m div 2) XOR (n div 2))\<close> for m n :: nat  | 
4050  | 
by (fact xor_rec)  | 
|
4051  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4052  | 
lemma bit_push_bit_iff_nat:  | 
| 79071 | 4053  | 
\<open>bit (push_bit m q) n \<longleftrightarrow> m \<le> n \<and> bit q (n - m)\<close> for q :: nat  | 
4054  | 
by (fact bit_push_bit_iff')  | 
|
4055  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4056  | 
lemma mask_half_int:  | 
| 79116 | 4057  | 
\<open>mask n div 2 = (mask (n - 1) :: int)\<close>  | 
4058  | 
by (fact mask_half)  | 
|
4059  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4060  | 
lemma not_int_rec:  | 
| 79068 | 4061  | 
\<open>NOT k = of_bool (even k) + 2 * NOT (k div 2)\<close> for k :: int  | 
4062  | 
by (fact not_rec)  | 
|
4063  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4064  | 
lemma even_not_iff_int:  | 
| 79068 | 4065  | 
\<open>even (NOT k) \<longleftrightarrow> odd k\<close> for k :: int  | 
4066  | 
by (fact even_not_iff)  | 
|
4067  | 
||
| 
79072
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
4068  | 
lemma bit_not_int_iff':  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
4069  | 
\<open>bit (- k - 1) n \<longleftrightarrow> \<not> bit k n\<close> for k :: int  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
4070  | 
by (simp flip: not_eq_complement add: bit_simps)  | 
| 
 
a91050cd5c93
de-duplicated specification of class ring_bit_operations
 
haftmann 
parents: 
79071 
diff
changeset
 | 
4071  | 
|
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4072  | 
lemmas and_int_rec = and_int.rec  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4073  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4074  | 
lemma even_and_iff_int:  | 
| 79116 | 4075  | 
\<open>even (k AND l) \<longleftrightarrow> even k \<or> even l\<close> for k l :: int  | 
4076  | 
by (fact even_and_iff)  | 
|
4077  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4078  | 
lemmas bit_and_int_iff = and_int.bit_iff  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4079  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4080  | 
lemmas or_int_rec = or_int.rec  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4081  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4082  | 
lemmas bit_or_int_iff = or_int.bit_iff  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4083  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4084  | 
lemmas xor_int_rec = xor_int.rec  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4085  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4086  | 
lemmas bit_xor_int_iff = xor_int.bit_iff  | 
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4087  | 
|
| 
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4088  | 
lemma drop_bit_push_bit_int:  | 
| 79116 | 4089  | 
\<open>drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\<close> for k :: int  | 
4090  | 
by (fact drop_bit_push_bit)  | 
|
4091  | 
||
| 
79893
 
7ea70796acaa
avoid [no_atp] declations shadowing propositions from sledgehammer
 
haftmann 
parents: 
79673 
diff
changeset
 | 
4092  | 
lemma bit_push_bit_iff_int:  | 
| 79116 | 4093  | 
\<open>bit (push_bit m k) n \<longleftrightarrow> m \<le> n \<and> bit k (n - m)\<close> for k :: int  | 
4094  | 
by (fact bit_push_bit_iff')  | 
|
4095  | 
||
| 74097 | 4096  | 
bundle bit_operations_syntax  | 
| 74101 | 4097  | 
begin  | 
| 74097 | 4098  | 
notation  | 
| 74391 | 4099  | 
not (\<open>NOT\<close>)  | 
| 74364 | 4100  | 
and "and" (infixr \<open>AND\<close> 64)  | 
| 74097 | 4101  | 
and or (infixr \<open>OR\<close> 59)  | 
4102  | 
and xor (infixr \<open>XOR\<close> 59)  | 
|
| 
81132
 
dff7dfd8dce3
more robust declarations via "no syntax" bundles;
 
wenzelm 
parents: 
80758 
diff
changeset
 | 
4103  | 
end  | 
| 
 
dff7dfd8dce3
more robust declarations via "no syntax" bundles;
 
wenzelm 
parents: 
80758 
diff
changeset
 | 
4104  | 
|
| 
 
dff7dfd8dce3
more robust declarations via "no syntax" bundles;
 
wenzelm 
parents: 
80758 
diff
changeset
 | 
4105  | 
unbundle no bit_operations_syntax  | 
| 74097 | 4106  | 
|
| 71442 | 4107  | 
end  |