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