| author | wenzelm | 
| Tue, 26 Jan 2021 23:34:40 +0100 | |
| changeset 73194 | c0d6d57a9a31 | 
| parent 72792 | 26492b600d78 | 
| child 73535 | 0f33c7031ec9 | 
| permissions | -rw-r--r-- | 
| 41959 | 1 | (* Title: HOL/Parity.thy | 
| 2 | Author: Jeremy Avigad | |
| 3 | Author: Jacques D. Fleuriot | |
| 21256 | 4 | *) | 
| 5 | ||
| 60758 | 6 | section \<open>Parity in rings and semirings\<close> | 
| 21256 | 7 | |
| 8 | theory Parity | |
| 66815 | 9 | imports Euclidean_Division | 
| 21256 | 10 | begin | 
| 11 | ||
| 61799 | 12 | subsection \<open>Ring structures with parity and \<open>even\<close>/\<open>odd\<close> predicates\<close> | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 13 | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 14 | class semiring_parity = comm_semiring_1 + semiring_modulo + | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 15 | assumes even_iff_mod_2_eq_zero: "2 dvd a \<longleftrightarrow> a mod 2 = 0" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 16 | and odd_iff_mod_2_eq_one: "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 17 | and odd_one [simp]: "\<not> 2 dvd 1" | 
| 66839 | 18 | begin | 
| 19 | ||
| 58740 | 20 | abbreviation even :: "'a \<Rightarrow> bool" | 
| 63654 | 21 | where "even a \<equiv> 2 dvd a" | 
| 54228 | 22 | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 23 | abbreviation odd :: "'a \<Rightarrow> bool" | 
| 63654 | 24 | where "odd a \<equiv> \<not> 2 dvd a" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 25 | |
| 66815 | 26 | lemma parity_cases [case_names even odd]: | 
| 27 | assumes "even a \<Longrightarrow> a mod 2 = 0 \<Longrightarrow> P" | |
| 28 | assumes "odd a \<Longrightarrow> a mod 2 = 1 \<Longrightarrow> P" | |
| 29 | shows P | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 30 | using assms by (cases "even a") | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 31 | (simp_all add: even_iff_mod_2_eq_zero [symmetric] odd_iff_mod_2_eq_one [symmetric]) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 32 | |
| 71181 | 33 | lemma odd_of_bool_self [simp]: | 
| 34 | \<open>odd (of_bool p) \<longleftrightarrow> p\<close> | |
| 35 | by (cases p) simp_all | |
| 36 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 37 | lemma not_mod_2_eq_0_eq_1 [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 38 | "a mod 2 \<noteq> 0 \<longleftrightarrow> a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 39 | by (cases a rule: parity_cases) simp_all | 
| 66815 | 40 | |
| 41 | lemma not_mod_2_eq_1_eq_0 [simp]: | |
| 42 | "a mod 2 \<noteq> 1 \<longleftrightarrow> a mod 2 = 0" | |
| 43 | by (cases a rule: parity_cases) simp_all | |
| 44 | ||
| 58690 | 45 | lemma evenE [elim?]: | 
| 46 | assumes "even a" | |
| 47 | obtains b where "a = 2 * b" | |
| 58740 | 48 | using assms by (rule dvdE) | 
| 58690 | 49 | |
| 58681 | 50 | lemma oddE [elim?]: | 
| 58680 | 51 | assumes "odd a" | 
| 52 | obtains b where "a = 2 * b + 1" | |
| 58787 | 53 | proof - | 
| 66815 | 54 | have "a = 2 * (a div 2) + a mod 2" | 
| 55 | by (simp add: mult_div_mod_eq) | |
| 56 | with assms have "a = 2 * (a div 2) + 1" | |
| 57 | by (simp add: odd_iff_mod_2_eq_one) | |
| 58 | then show ?thesis .. | |
| 59 | qed | |
| 60 | ||
| 61 | lemma mod_2_eq_odd: | |
| 62 | "a mod 2 = of_bool (odd a)" | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 63 | by (auto elim: oddE simp add: even_iff_mod_2_eq_zero) | 
| 66815 | 64 | |
| 67816 | 65 | lemma of_bool_odd_eq_mod_2: | 
| 66 | "of_bool (odd a) = a mod 2" | |
| 67 | by (simp add: mod_2_eq_odd) | |
| 68 | ||
| 71426 | 69 | lemma even_mod_2_iff [simp]: | 
| 70 | \<open>even (a mod 2) \<longleftrightarrow> even a\<close> | |
| 71 | by (simp add: mod_2_eq_odd) | |
| 72 | ||
| 73 | lemma mod2_eq_if: | |
| 74 | "a mod 2 = (if even a then 0 else 1)" | |
| 75 | by (simp add: mod_2_eq_odd) | |
| 76 | ||
| 66815 | 77 | lemma even_zero [simp]: | 
| 78 | "even 0" | |
| 79 | by (fact dvd_0_right) | |
| 80 | ||
| 81 | lemma odd_even_add: | |
| 82 | "even (a + b)" if "odd a" and "odd b" | |
| 83 | proof - | |
| 84 | from that obtain c d where "a = 2 * c + 1" and "b = 2 * d + 1" | |
| 85 | by (blast elim: oddE) | |
| 86 | then have "a + b = 2 * c + 2 * d + (1 + 1)" | |
| 87 | by (simp only: ac_simps) | |
| 88 | also have "\<dots> = 2 * (c + d + 1)" | |
| 89 | by (simp add: algebra_simps) | |
| 90 | finally show ?thesis .. | |
| 91 | qed | |
| 92 | ||
| 93 | lemma even_add [simp]: | |
| 94 | "even (a + b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)" | |
| 95 | by (auto simp add: dvd_add_right_iff dvd_add_left_iff odd_even_add) | |
| 96 | ||
| 97 | lemma odd_add [simp]: | |
| 98 | "odd (a + b) \<longleftrightarrow> \<not> (odd a \<longleftrightarrow> odd b)" | |
| 99 | by simp | |
| 100 | ||
| 101 | lemma even_plus_one_iff [simp]: | |
| 102 | "even (a + 1) \<longleftrightarrow> odd a" | |
| 103 | by (auto simp add: dvd_add_right_iff intro: odd_even_add) | |
| 104 | ||
| 105 | lemma even_mult_iff [simp]: | |
| 106 | "even (a * b) \<longleftrightarrow> even a \<or> even b" (is "?P \<longleftrightarrow> ?Q") | |
| 107 | proof | |
| 108 | assume ?Q | |
| 109 | then show ?P | |
| 110 | by auto | |
| 111 | next | |
| 112 | assume ?P | |
| 113 | show ?Q | |
| 114 | proof (rule ccontr) | |
| 115 | assume "\<not> (even a \<or> even b)" | |
| 116 | then have "odd a" and "odd b" | |
| 117 | by auto | |
| 118 | then obtain r s where "a = 2 * r + 1" and "b = 2 * s + 1" | |
| 119 | by (blast elim: oddE) | |
| 120 | then have "a * b = (2 * r + 1) * (2 * s + 1)" | |
| 121 | by simp | |
| 122 | also have "\<dots> = 2 * (2 * r * s + r + s) + 1" | |
| 123 | by (simp add: algebra_simps) | |
| 124 | finally have "odd (a * b)" | |
| 125 | by simp | |
| 126 | with \<open>?P\<close> show False | |
| 127 | by auto | |
| 128 | qed | |
| 129 | qed | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 130 | |
| 63654 | 131 | lemma even_numeral [simp]: "even (numeral (Num.Bit0 n))" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 132 | proof - | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 133 | have "even (2 * numeral n)" | 
| 66815 | 134 | unfolding even_mult_iff by simp | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 135 | then have "even (numeral n + numeral n)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 136 | unfolding mult_2 . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 137 | then show ?thesis | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 138 | unfolding numeral.simps . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 139 | qed | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 140 | |
| 63654 | 141 | lemma odd_numeral [simp]: "odd (numeral (Num.Bit1 n))" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 142 | proof | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 143 | assume "even (numeral (num.Bit1 n))" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 144 | then have "even (numeral n + numeral n + 1)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 145 | unfolding numeral.simps . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 146 | then have "even (2 * numeral n + 1)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 147 | unfolding mult_2 . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 148 | then have "2 dvd numeral n * 2 + 1" | 
| 58740 | 149 | by (simp add: ac_simps) | 
| 63654 | 150 | then have "2 dvd 1" | 
| 151 | using dvd_add_times_triv_left_iff [of 2 "numeral n" 1] by simp | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 152 | then show False by simp | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 153 | qed | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 154 | |
| 71755 | 155 | lemma odd_numeral_BitM [simp]: | 
| 156 | \<open>odd (numeral (Num.BitM w))\<close> | |
| 157 | by (cases w) simp_all | |
| 158 | ||
| 63654 | 159 | lemma even_power [simp]: "even (a ^ n) \<longleftrightarrow> even a \<and> n > 0" | 
| 58680 | 160 | by (induct n) auto | 
| 161 | ||
| 71412 | 162 | lemma mask_eq_sum_exp: | 
| 163 |   \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
 | |
| 164 | proof - | |
| 165 |   have *: \<open>{q. q < Suc m} = insert m {q. q < m}\<close> for m
 | |
| 166 | by auto | |
| 167 |   have \<open>2 ^ n = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1\<close>
 | |
| 168 | by (induction n) (simp_all add: ac_simps mult_2 *) | |
| 169 |   then have \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1 - 1\<close>
 | |
| 170 | by simp | |
| 171 | then show ?thesis | |
| 172 | by simp | |
| 173 | qed | |
| 174 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 175 | end | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 176 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 177 | class ring_parity = ring + semiring_parity | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 178 | begin | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 179 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 180 | subclass comm_ring_1 .. | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 181 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 182 | lemma even_minus: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 183 | "even (- a) \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 184 | by (fact dvd_minus_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 185 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 186 | lemma even_diff [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 187 | "even (a - b) \<longleftrightarrow> even (a + b)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 188 | using even_add [of a "- b"] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 189 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 190 | end | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 191 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 192 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 193 | subsection \<open>Special case: euclidean rings containing the natural numbers\<close> | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 194 | |
| 71157 | 195 | context unique_euclidean_semiring_with_nat | 
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 196 | begin | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 197 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 198 | subclass semiring_parity | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 199 | proof | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 200 | show "2 dvd a \<longleftrightarrow> a mod 2 = 0" for a | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 201 | by (fact dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 202 | show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" for a | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 203 | proof | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 204 | assume "a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 205 | then show "\<not> 2 dvd a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 206 | by auto | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 207 | next | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 208 | assume "\<not> 2 dvd a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 209 | have eucl: "euclidean_size (a mod 2) = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 210 | proof (rule order_antisym) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 211 | show "euclidean_size (a mod 2) \<le> 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 212 | using mod_size_less [of 2 a] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 213 | show "1 \<le> euclidean_size (a mod 2)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 214 | using \<open>\<not> 2 dvd a\<close> by (simp add: Suc_le_eq dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 215 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 216 | from \<open>\<not> 2 dvd a\<close> have "\<not> of_nat 2 dvd division_segment a * of_nat (euclidean_size a)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 217 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 218 | then have "\<not> of_nat 2 dvd of_nat (euclidean_size a)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 219 | by (auto simp only: dvd_mult_unit_iff' is_unit_division_segment) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 220 | then have "\<not> 2 dvd euclidean_size a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 221 | using of_nat_dvd_iff [of 2] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 222 | then have "euclidean_size a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 223 | by (simp add: semidom_modulo_class.dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 224 | then have "of_nat (euclidean_size a mod 2) = of_nat 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 225 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 226 | then have "of_nat (euclidean_size a) mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 227 | by (simp add: of_nat_mod) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 228 | from \<open>\<not> 2 dvd a\<close> eucl | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 229 | show "a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 230 | by (auto intro: division_segment_eq_iff simp add: division_segment_mod) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 231 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 232 | show "\<not> is_unit 2" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 233 | proof (rule notI) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 234 | assume "is_unit 2" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 235 | then have "of_nat 2 dvd of_nat 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 236 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 237 | then have "is_unit (2::nat)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 238 | by (simp only: of_nat_dvd_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 239 | then show False | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 240 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 241 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 242 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 243 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 244 | lemma even_of_nat [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 245 | "even (of_nat a) \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 246 | proof - | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 247 | have "even (of_nat a) \<longleftrightarrow> of_nat 2 dvd of_nat a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 248 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 249 | also have "\<dots> \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 250 | by (simp only: of_nat_dvd_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 251 | finally show ?thesis . | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 252 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 253 | |
| 66815 | 254 | lemma even_succ_div_two [simp]: | 
| 255 | "even a \<Longrightarrow> (a + 1) div 2 = a div 2" | |
| 256 | by (cases "a = 0") (auto elim!: evenE dest: mult_not_zero) | |
| 257 | ||
| 258 | lemma odd_succ_div_two [simp]: | |
| 259 | "odd a \<Longrightarrow> (a + 1) div 2 = a div 2 + 1" | |
| 260 | by (auto elim!: oddE simp add: add.assoc) | |
| 261 | ||
| 262 | lemma even_two_times_div_two: | |
| 263 | "even a \<Longrightarrow> 2 * (a div 2) = a" | |
| 264 | by (fact dvd_mult_div_cancel) | |
| 265 | ||
| 266 | lemma odd_two_times_div_two_succ [simp]: | |
| 267 | "odd a \<Longrightarrow> 2 * (a div 2) + 1 = a" | |
| 268 | using mult_div_mod_eq [of 2 a] | |
| 269 | by (simp add: even_iff_mod_2_eq_zero) | |
| 270 | ||
| 67051 | 271 | lemma coprime_left_2_iff_odd [simp]: | 
| 272 | "coprime 2 a \<longleftrightarrow> odd a" | |
| 273 | proof | |
| 274 | assume "odd a" | |
| 275 | show "coprime 2 a" | |
| 276 | proof (rule coprimeI) | |
| 277 | fix b | |
| 278 | assume "b dvd 2" "b dvd a" | |
| 279 | then have "b dvd a mod 2" | |
| 280 | by (auto intro: dvd_mod) | |
| 281 | with \<open>odd a\<close> show "is_unit b" | |
| 282 | by (simp add: mod_2_eq_odd) | |
| 283 | qed | |
| 284 | next | |
| 285 | assume "coprime 2 a" | |
| 286 | show "odd a" | |
| 287 | proof (rule notI) | |
| 288 | assume "even a" | |
| 289 | then obtain b where "a = 2 * b" .. | |
| 290 | with \<open>coprime 2 a\<close> have "coprime 2 (2 * b)" | |
| 291 | by simp | |
| 292 | moreover have "\<not> coprime 2 (2 * b)" | |
| 293 | by (rule not_coprimeI [of 2]) simp_all | |
| 294 | ultimately show False | |
| 295 | by blast | |
| 296 | qed | |
| 297 | qed | |
| 298 | ||
| 299 | lemma coprime_right_2_iff_odd [simp]: | |
| 300 | "coprime a 2 \<longleftrightarrow> odd a" | |
| 301 | using coprime_left_2_iff_odd [of a] by (simp add: ac_simps) | |
| 302 | ||
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 303 | end | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 304 | |
| 71157 | 305 | context unique_euclidean_ring_with_nat | 
| 58679 | 306 | begin | 
| 307 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 308 | subclass ring_parity .. | 
| 58680 | 309 | |
| 67906 | 310 | lemma minus_1_mod_2_eq [simp]: | 
| 311 | "- 1 mod 2 = 1" | |
| 312 | by (simp add: mod_2_eq_odd) | |
| 313 | ||
| 314 | lemma minus_1_div_2_eq [simp]: | |
| 315 | "- 1 div 2 = - 1" | |
| 316 | proof - | |
| 317 | from div_mult_mod_eq [of "- 1" 2] | |
| 318 | have "- 1 div 2 * 2 = - 1 * 2" | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 319 | using add_implies_diff by fastforce | 
| 67906 | 320 | then show ?thesis | 
| 321 | using mult_right_cancel [of 2 "- 1 div 2" "- 1"] by simp | |
| 322 | qed | |
| 323 | ||
| 58679 | 324 | end | 
| 325 | ||
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 326 | |
| 69593 | 327 | subsection \<open>Instance for \<^typ>\<open>nat\<close>\<close> | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 328 | |
| 70340 | 329 | instance nat :: unique_euclidean_semiring_with_nat | 
| 66815 | 330 | by standard (simp_all add: dvd_eq_mod_eq_0) | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 331 | |
| 66815 | 332 | lemma even_Suc_Suc_iff [simp]: | 
| 333 | "even (Suc (Suc n)) \<longleftrightarrow> even n" | |
| 58787 | 334 | using dvd_add_triv_right_iff [of 2 n] by simp | 
| 58687 | 335 | |
| 66815 | 336 | lemma even_Suc [simp]: "even (Suc n) \<longleftrightarrow> odd n" | 
| 337 | using even_plus_one_iff [of n] by simp | |
| 58787 | 338 | |
| 66815 | 339 | lemma even_diff_nat [simp]: | 
| 340 | "even (m - n) \<longleftrightarrow> m < n \<or> even (m + n)" for m n :: nat | |
| 58787 | 341 | proof (cases "n \<le> m") | 
| 342 | case True | |
| 343 | then have "m - n + n * 2 = m + n" by (simp add: mult_2_right) | |
| 66815 | 344 | moreover have "even (m - n) \<longleftrightarrow> even (m - n + n * 2)" by simp | 
| 345 | ultimately have "even (m - n) \<longleftrightarrow> even (m + n)" by (simp only:) | |
| 58787 | 346 | then show ?thesis by auto | 
| 347 | next | |
| 348 | case False | |
| 349 | then show ?thesis by simp | |
| 63654 | 350 | qed | 
| 351 | ||
| 66815 | 352 | lemma odd_pos: | 
| 353 | "odd n \<Longrightarrow> 0 < n" for n :: nat | |
| 58690 | 354 | by (auto elim: oddE) | 
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 355 | |
| 66815 | 356 | lemma Suc_double_not_eq_double: | 
| 357 | "Suc (2 * m) \<noteq> 2 * n" | |
| 62597 | 358 | proof | 
| 359 | assume "Suc (2 * m) = 2 * n" | |
| 360 | moreover have "odd (Suc (2 * m))" and "even (2 * n)" | |
| 361 | by simp_all | |
| 362 | ultimately show False by simp | |
| 363 | qed | |
| 364 | ||
| 66815 | 365 | lemma double_not_eq_Suc_double: | 
| 366 | "2 * m \<noteq> Suc (2 * n)" | |
| 62597 | 367 | using Suc_double_not_eq_double [of n m] by simp | 
| 368 | ||
| 66815 | 369 | lemma odd_Suc_minus_one [simp]: "odd n \<Longrightarrow> Suc (n - Suc 0) = n" | 
| 370 | by (auto elim: oddE) | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 371 | |
| 66815 | 372 | lemma even_Suc_div_two [simp]: | 
| 373 | "even n \<Longrightarrow> Suc n div 2 = n div 2" | |
| 374 | using even_succ_div_two [of n] by simp | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 375 | |
| 66815 | 376 | lemma odd_Suc_div_two [simp]: | 
| 377 | "odd n \<Longrightarrow> Suc n div 2 = Suc (n div 2)" | |
| 378 | using odd_succ_div_two [of n] by simp | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 379 | |
| 66815 | 380 | lemma odd_two_times_div_two_nat [simp]: | 
| 381 | assumes "odd n" | |
| 382 | shows "2 * (n div 2) = n - (1 :: nat)" | |
| 383 | proof - | |
| 384 | from assms have "2 * (n div 2) + 1 = n" | |
| 385 | by (rule odd_two_times_div_two_succ) | |
| 386 | then have "Suc (2 * (n div 2)) - 1 = n - 1" | |
| 58787 | 387 | by simp | 
| 66815 | 388 | then show ?thesis | 
| 389 | by simp | |
| 58787 | 390 | qed | 
| 58680 | 391 | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 392 | lemma not_mod2_eq_Suc_0_eq_0 [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 393 | "n mod 2 \<noteq> Suc 0 \<longleftrightarrow> n mod 2 = 0" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 394 | using not_mod_2_eq_1_eq_0 [of n] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 395 | |
| 69502 | 396 | lemma odd_card_imp_not_empty: | 
| 397 |   \<open>A \<noteq> {}\<close> if \<open>odd (card A)\<close>
 | |
| 398 | using that by auto | |
| 399 | ||
| 70365 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 400 | lemma nat_induct2 [case_names 0 1 step]: | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 401 | assumes "P 0" "P 1" and step: "\<And>n::nat. P n \<Longrightarrow> P (n + 2)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 402 | shows "P n" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 403 | proof (induct n rule: less_induct) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 404 | case (less n) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 405 | show ?case | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 406 | proof (cases "n < Suc (Suc 0)") | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 407 | case True | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 408 | then show ?thesis | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 409 | using assms by (auto simp: less_Suc_eq) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 410 | next | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 411 | case False | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 412 | then obtain k where k: "n = Suc (Suc k)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 413 | by (force simp: not_less nat_le_iff_add) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 414 | then have "k<n" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 415 | by simp | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 416 | with less assms have "P (k+2)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 417 | by blast | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 418 | then show ?thesis | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 419 | by (simp add: k) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 420 | qed | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 421 | qed | 
| 58687 | 422 | |
| 71413 | 423 | lemma mask_eq_sum_exp_nat: | 
| 424 |   \<open>2 ^ n - Suc 0 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
 | |
| 425 | using mask_eq_sum_exp [where ?'a = nat] by simp | |
| 426 | ||
| 71412 | 427 | context semiring_parity | 
| 428 | begin | |
| 429 | ||
| 430 | lemma even_sum_iff: | |
| 431 |   \<open>even (sum f A) \<longleftrightarrow> even (card {a\<in>A. odd (f a)})\<close> if \<open>finite A\<close>
 | |
| 432 | using that proof (induction A) | |
| 433 | case empty | |
| 434 | then show ?case | |
| 435 | by simp | |
| 436 | next | |
| 437 | case (insert a A) | |
| 438 |   moreover have \<open>{b \<in> insert a A. odd (f b)} = (if odd (f a) then {a} else {}) \<union> {b \<in> A. odd (f b)}\<close>
 | |
| 439 | by auto | |
| 440 | ultimately show ?case | |
| 441 | by simp | |
| 442 | qed | |
| 443 | ||
| 444 | lemma even_prod_iff: | |
| 445 | \<open>even (prod f A) \<longleftrightarrow> (\<exists>a\<in>A. even (f a))\<close> if \<open>finite A\<close> | |
| 446 | using that by (induction A) simp_all | |
| 447 | ||
| 448 | lemma even_mask_iff [simp]: | |
| 449 | \<open>even (2 ^ n - 1) \<longleftrightarrow> n = 0\<close> | |
| 450 | proof (cases \<open>n = 0\<close>) | |
| 451 | case True | |
| 452 | then show ?thesis | |
| 453 | by simp | |
| 454 | next | |
| 455 | case False | |
| 456 |   then have \<open>{a. a = 0 \<and> a < n} = {0}\<close>
 | |
| 457 | by auto | |
| 458 | then show ?thesis | |
| 459 | by (auto simp add: mask_eq_sum_exp even_sum_iff) | |
| 460 | qed | |
| 461 | ||
| 462 | end | |
| 463 | ||
| 71138 | 464 | |
| 60758 | 465 | subsection \<open>Parity and powers\<close> | 
| 58689 | 466 | |
| 61531 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 eberlm parents: 
60867diff
changeset | 467 | context ring_1 | 
| 58689 | 468 | begin | 
| 469 | ||
| 63654 | 470 | lemma power_minus_even [simp]: "even n \<Longrightarrow> (- a) ^ n = a ^ n" | 
| 58690 | 471 | by (auto elim: evenE) | 
| 58689 | 472 | |
| 63654 | 473 | lemma power_minus_odd [simp]: "odd n \<Longrightarrow> (- a) ^ n = - (a ^ n)" | 
| 58690 | 474 | by (auto elim: oddE) | 
| 475 | ||
| 66815 | 476 | lemma uminus_power_if: | 
| 477 | "(- a) ^ n = (if even n then a ^ n else - (a ^ n))" | |
| 478 | by auto | |
| 479 | ||
| 63654 | 480 | lemma neg_one_even_power [simp]: "even n \<Longrightarrow> (- 1) ^ n = 1" | 
| 58690 | 481 | by simp | 
| 58689 | 482 | |
| 63654 | 483 | lemma neg_one_odd_power [simp]: "odd n \<Longrightarrow> (- 1) ^ n = - 1" | 
| 58690 | 484 | by simp | 
| 58689 | 485 | |
| 66582 | 486 | lemma neg_one_power_add_eq_neg_one_power_diff: "k \<le> n \<Longrightarrow> (- 1) ^ (n + k) = (- 1) ^ (n - k)" | 
| 487 | by (cases "even (n + k)") auto | |
| 488 | ||
| 67371 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 489 | lemma minus_one_power_iff: "(- 1) ^ n = (if even n then 1 else - 1)" | 
| 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 490 | by (induct n) auto | 
| 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 491 | |
| 63654 | 492 | end | 
| 58689 | 493 | |
| 494 | context linordered_idom | |
| 495 | begin | |
| 496 | ||
| 63654 | 497 | lemma zero_le_even_power: "even n \<Longrightarrow> 0 \<le> a ^ n" | 
| 58690 | 498 | by (auto elim: evenE) | 
| 58689 | 499 | |
| 63654 | 500 | lemma zero_le_odd_power: "odd n \<Longrightarrow> 0 \<le> a ^ n \<longleftrightarrow> 0 \<le> a" | 
| 58689 | 501 | by (auto simp add: power_even_eq zero_le_mult_iff elim: oddE) | 
| 502 | ||
| 63654 | 503 | lemma zero_le_power_eq: "0 \<le> a ^ n \<longleftrightarrow> even n \<or> odd n \<and> 0 \<le> a" | 
| 58787 | 504 | by (auto simp add: zero_le_even_power zero_le_odd_power) | 
| 63654 | 505 | |
| 506 | lemma zero_less_power_eq: "0 < a ^ n \<longleftrightarrow> n = 0 \<or> even n \<and> a \<noteq> 0 \<or> odd n \<and> 0 < a" | |
| 58689 | 507 | proof - | 
| 508 | have [simp]: "0 = a ^ n \<longleftrightarrow> a = 0 \<and> n > 0" | |
| 58787 | 509 | unfolding power_eq_0_iff [of a n, symmetric] by blast | 
| 58689 | 510 | show ?thesis | 
| 63654 | 511 | unfolding less_le zero_le_power_eq by auto | 
| 58689 | 512 | qed | 
| 513 | ||
| 63654 | 514 | lemma power_less_zero_eq [simp]: "a ^ n < 0 \<longleftrightarrow> odd n \<and> a < 0" | 
| 58689 | 515 | unfolding not_le [symmetric] zero_le_power_eq by auto | 
| 516 | ||
| 63654 | 517 | lemma power_le_zero_eq: "a ^ n \<le> 0 \<longleftrightarrow> n > 0 \<and> (odd n \<and> a \<le> 0 \<or> even n \<and> a = 0)" | 
| 518 | unfolding not_less [symmetric] zero_less_power_eq by auto | |
| 519 | ||
| 520 | lemma power_even_abs: "even n \<Longrightarrow> \<bar>a\<bar> ^ n = a ^ n" | |
| 58689 | 521 | using power_abs [of a n] by (simp add: zero_le_even_power) | 
| 522 | ||
| 523 | lemma power_mono_even: | |
| 524 | assumes "even n" and "\<bar>a\<bar> \<le> \<bar>b\<bar>" | |
| 525 | shows "a ^ n \<le> b ^ n" | |
| 526 | proof - | |
| 527 | have "0 \<le> \<bar>a\<bar>" by auto | |
| 63654 | 528 | with \<open>\<bar>a\<bar> \<le> \<bar>b\<bar>\<close> have "\<bar>a\<bar> ^ n \<le> \<bar>b\<bar> ^ n" | 
| 529 | by (rule power_mono) | |
| 530 | with \<open>even n\<close> show ?thesis | |
| 531 | by (simp add: power_even_abs) | |
| 58689 | 532 | qed | 
| 533 | ||
| 534 | lemma power_mono_odd: | |
| 535 | assumes "odd n" and "a \<le> b" | |
| 536 | shows "a ^ n \<le> b ^ n" | |
| 537 | proof (cases "b < 0") | |
| 63654 | 538 | case True | 
| 539 | with \<open>a \<le> b\<close> have "- b \<le> - a" and "0 \<le> - b" by auto | |
| 540 | then have "(- b) ^ n \<le> (- a) ^ n" by (rule power_mono) | |
| 60758 | 541 | with \<open>odd n\<close> show ?thesis by simp | 
| 58689 | 542 | next | 
| 63654 | 543 | case False | 
| 544 | then have "0 \<le> b" by auto | |
| 58689 | 545 | show ?thesis | 
| 546 | proof (cases "a < 0") | |
| 63654 | 547 | case True | 
| 548 | then have "n \<noteq> 0" and "a \<le> 0" using \<open>odd n\<close> [THEN odd_pos] by auto | |
| 60758 | 549 | then have "a ^ n \<le> 0" unfolding power_le_zero_eq using \<open>odd n\<close> by auto | 
| 63654 | 550 | moreover from \<open>0 \<le> b\<close> have "0 \<le> b ^ n" by auto | 
| 58689 | 551 | ultimately show ?thesis by auto | 
| 552 | next | |
| 63654 | 553 | case False | 
| 554 | then have "0 \<le> a" by auto | |
| 555 | with \<open>a \<le> b\<close> show ?thesis | |
| 556 | using power_mono by auto | |
| 58689 | 557 | qed | 
| 558 | qed | |
| 62083 | 559 | |
| 60758 | 560 | text \<open>Simplify, when the exponent is a numeral\<close> | 
| 58689 | 561 | |
| 562 | lemma zero_le_power_eq_numeral [simp]: | |
| 563 | "0 \<le> a ^ numeral w \<longleftrightarrow> even (numeral w :: nat) \<or> odd (numeral w :: nat) \<and> 0 \<le> a" | |
| 564 | by (fact zero_le_power_eq) | |
| 565 | ||
| 566 | lemma zero_less_power_eq_numeral [simp]: | |
| 63654 | 567 | "0 < a ^ numeral w \<longleftrightarrow> | 
| 568 | numeral w = (0 :: nat) \<or> | |
| 569 | even (numeral w :: nat) \<and> a \<noteq> 0 \<or> | |
| 570 | odd (numeral w :: nat) \<and> 0 < a" | |
| 58689 | 571 | by (fact zero_less_power_eq) | 
| 572 | ||
| 573 | lemma power_le_zero_eq_numeral [simp]: | |
| 63654 | 574 | "a ^ numeral w \<le> 0 \<longleftrightarrow> | 
| 575 | (0 :: nat) < numeral w \<and> | |
| 576 | (odd (numeral w :: nat) \<and> a \<le> 0 \<or> even (numeral w :: nat) \<and> a = 0)" | |
| 58689 | 577 | by (fact power_le_zero_eq) | 
| 578 | ||
| 579 | lemma power_less_zero_eq_numeral [simp]: | |
| 580 | "a ^ numeral w < 0 \<longleftrightarrow> odd (numeral w :: nat) \<and> a < 0" | |
| 581 | by (fact power_less_zero_eq) | |
| 582 | ||
| 583 | lemma power_even_abs_numeral [simp]: | |
| 584 | "even (numeral w :: nat) \<Longrightarrow> \<bar>a\<bar> ^ numeral w = a ^ numeral w" | |
| 585 | by (fact power_even_abs) | |
| 586 | ||
| 587 | end | |
| 588 | ||
| 71413 | 589 | context unique_euclidean_semiring_with_nat | 
| 590 | begin | |
| 591 | ||
| 592 | lemma even_mask_div_iff': | |
| 593 | \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close> | |
| 594 | proof - | |
| 595 | have \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> even (of_nat ((2 ^ m - Suc 0) div 2 ^ n))\<close> | |
| 596 | by (simp only: of_nat_div) (simp add: of_nat_diff) | |
| 597 | also have \<open>\<dots> \<longleftrightarrow> even ((2 ^ m - Suc 0) div 2 ^ n)\<close> | |
| 598 | by simp | |
| 599 | also have \<open>\<dots> \<longleftrightarrow> m \<le> n\<close> | |
| 600 | proof (cases \<open>m \<le> n\<close>) | |
| 601 | case True | |
| 602 | then show ?thesis | |
| 603 | by (simp add: Suc_le_lessD) | |
| 604 | next | |
| 605 | case False | |
| 606 | then obtain r where r: \<open>m = n + Suc r\<close> | |
| 607 | using less_imp_Suc_add by fastforce | |
| 608 |     from r have \<open>{q. q < m} \<inter> {q. 2 ^ n dvd (2::nat) ^ q} = {q. n \<le> q \<and> q < m}\<close>
 | |
| 609 | by (auto simp add: dvd_power_iff_le) | |
| 610 |     moreover from r have \<open>{q. q < m} \<inter> {q. \<not> 2 ^ n dvd (2::nat) ^ q} = {q. q < n}\<close>
 | |
| 611 | by (auto simp add: dvd_power_iff_le) | |
| 612 |     moreover from False have \<open>{q. n \<le> q \<and> q < m \<and> q \<le> n} = {n}\<close>
 | |
| 613 | by auto | |
| 614 |     then have \<open>odd ((\<Sum>a\<in>{q. n \<le> q \<and> q < m}. 2 ^ a div (2::nat) ^ n) + sum ((^) 2) {q. q < n} div 2 ^ n)\<close>
 | |
| 615 | by (simp_all add: euclidean_semiring_cancel_class.power_diff_power_eq semiring_parity_class.even_sum_iff not_less mask_eq_sum_exp_nat [symmetric]) | |
| 616 |     ultimately have \<open>odd (sum ((^) (2::nat)) {q. q < m} div 2 ^ n)\<close>
 | |
| 617 | by (subst euclidean_semiring_cancel_class.sum_div_partition) simp_all | |
| 618 | with False show ?thesis | |
| 619 | by (simp add: mask_eq_sum_exp_nat) | |
| 620 | qed | |
| 621 | finally show ?thesis . | |
| 622 | qed | |
| 623 | ||
| 624 | end | |
| 625 | ||
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 626 | |
| 69593 | 627 | subsection \<open>Instance for \<^typ>\<open>int\<close>\<close> | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 628 | |
| 67816 | 629 | lemma even_diff_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 630 | "even (k - l) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 631 | by (fact even_diff) | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 632 | |
| 67816 | 633 | lemma even_abs_add_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 634 | "even (\<bar>k\<bar> + l) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 635 | by simp | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 636 | |
| 67816 | 637 | lemma even_add_abs_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 638 | "even (k + \<bar>l\<bar>) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 639 | by simp | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 640 | |
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 641 | lemma even_nat_iff: "0 \<le> k \<Longrightarrow> even (nat k) \<longleftrightarrow> even k" | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 642 | by (simp add: even_of_nat [of "nat k", where ?'a = int, symmetric]) | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 643 | |
| 71138 | 644 | lemma zdiv_zmult2_eq: | 
| 645 | \<open>a div (b * c) = (a div b) div c\<close> if \<open>c \<ge> 0\<close> for a b c :: int | |
| 646 | proof (cases \<open>b \<ge> 0\<close>) | |
| 647 | case True | |
| 648 | with that show ?thesis | |
| 649 | using div_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp | |
| 650 | next | |
| 651 | case False | |
| 652 | with that show ?thesis | |
| 653 | using div_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp | |
| 654 | qed | |
| 655 | ||
| 656 | lemma zmod_zmult2_eq: | |
| 657 | \<open>a mod (b * c) = b * (a div b mod c) + a mod b\<close> if \<open>c \<ge> 0\<close> for a b c :: int | |
| 658 | proof (cases \<open>b \<ge> 0\<close>) | |
| 659 | case True | |
| 660 | with that show ?thesis | |
| 661 | using mod_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp | |
| 662 | next | |
| 663 | case False | |
| 664 | with that show ?thesis | |
| 665 | using mod_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp | |
| 666 | qed | |
| 667 | ||
| 71837 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 668 | context | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 669 |   assumes "SORT_CONSTRAINT('a::division_ring)"
 | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 670 | begin | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 671 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 672 | lemma power_int_minus_left: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 673 | "power_int (-a :: 'a) n = (if even n then power_int a n else -power_int a n)" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 674 | by (auto simp: power_int_def minus_one_power_iff even_nat_iff) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 675 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 676 | lemma power_int_minus_left_even [simp]: "even n \<Longrightarrow> power_int (-a :: 'a) n = power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 677 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 678 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 679 | lemma power_int_minus_left_odd [simp]: "odd n \<Longrightarrow> power_int (-a :: 'a) n = -power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 680 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 681 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 682 | lemma power_int_minus_left_distrib: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 683 | "NO_MATCH (-1) x \<Longrightarrow> power_int (-a :: 'a) n = power_int (-1) n * power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 684 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 685 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 686 | lemma power_int_minus_one_minus: "power_int (-1 :: 'a) (-n) = power_int (-1) n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 687 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 688 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 689 | lemma power_int_minus_one_diff_commute: "power_int (-1 :: 'a) (a - b) = power_int (-1) (b - a)" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 690 | by (subst power_int_minus_one_minus [symmetric]) auto | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 691 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 692 | lemma power_int_minus_one_mult_self [simp]: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 693 | "power_int (-1 :: 'a) m * power_int (-1) m = 1" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 694 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 695 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 696 | lemma power_int_minus_one_mult_self' [simp]: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 697 | "power_int (-1 :: 'a) m * (power_int (-1) m * b) = b" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 698 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 699 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 700 | end | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 701 | |
| 71094 | 702 | |
| 71181 | 703 | subsection \<open>Abstract bit structures\<close> | 
| 71094 | 704 | |
| 705 | class semiring_bits = semiring_parity + | |
| 71195 | 706 | assumes bits_induct [case_names stable rec]: | 
| 71094 | 707 | \<open>(\<And>a. a div 2 = a \<Longrightarrow> P a) | 
| 708 | \<Longrightarrow> (\<And>a b. P a \<Longrightarrow> (of_bool b + 2 * a) div 2 = a \<Longrightarrow> P (of_bool b + 2 * a)) | |
| 709 | \<Longrightarrow> P a\<close> | |
| 71138 | 710 | assumes bits_div_0 [simp]: \<open>0 div a = 0\<close> | 
| 711 | and bits_div_by_1 [simp]: \<open>a div 1 = a\<close> | |
| 71195 | 712 | and bits_mod_div_trivial [simp]: \<open>a mod b div b = 0\<close> | 
| 71138 | 713 | and even_succ_div_2 [simp]: \<open>even a \<Longrightarrow> (1 + a) div 2 = a div 2\<close> | 
| 71413 | 714 | and even_mask_div_iff: \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> 2 ^ n = 0 \<or> m \<le> n\<close> | 
| 71182 | 715 | 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> | 
| 71138 | 716 | and div_exp_eq: \<open>a div 2 ^ m div 2 ^ n = a div 2 ^ (m + n)\<close> | 
| 717 | and mod_exp_eq: \<open>a mod 2 ^ m mod 2 ^ n = a mod 2 ^ min m n\<close> | |
| 718 | 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> | |
| 719 | and div_exp_mod_exp_eq: \<open>a div 2 ^ n mod 2 ^ m = a mod (2 ^ (n + m)) div 2 ^ n\<close> | |
| 71424 | 720 | 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> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 721 | fixes bit :: \<open>'a \<Rightarrow> nat \<Rightarrow> bool\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 722 | assumes bit_iff_odd: \<open>bit a n \<longleftrightarrow> odd (a div 2 ^ n)\<close> | 
| 71138 | 723 | begin | 
| 724 | ||
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 725 | text \<open> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 726 | Having \<^const>\<open>bit\<close> as definitional class operation | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 727 | takes into account that specific instances can be implemented | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 728 | differently wrt. code generation. | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 729 | \<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 730 | |
| 71195 | 731 | lemma bits_div_by_0 [simp]: | 
| 732 | \<open>a div 0 = 0\<close> | |
| 733 | by (metis add_cancel_right_right bits_mod_div_trivial mod_mult_div_eq mult_not_zero) | |
| 734 | ||
| 71138 | 735 | lemma bits_1_div_2 [simp]: | 
| 736 | \<open>1 div 2 = 0\<close> | |
| 737 | using even_succ_div_2 [of 0] by simp | |
| 738 | ||
| 739 | lemma bits_1_div_exp [simp]: | |
| 740 | \<open>1 div 2 ^ n = of_bool (n = 0)\<close> | |
| 741 | using div_exp_eq [of 1 1] by (cases n) simp_all | |
| 742 | ||
| 743 | lemma even_succ_div_exp [simp]: | |
| 744 | \<open>(1 + a) div 2 ^ n = a div 2 ^ n\<close> if \<open>even a\<close> and \<open>n > 0\<close> | |
| 745 | proof (cases n) | |
| 746 | case 0 | |
| 747 | with that show ?thesis | |
| 748 | by simp | |
| 749 | next | |
| 750 | case (Suc n) | |
| 751 | with \<open>even a\<close> have \<open>(1 + a) div 2 ^ Suc n = a div 2 ^ Suc n\<close> | |
| 752 | proof (induction n) | |
| 753 | case 0 | |
| 754 | then show ?case | |
| 755 | by simp | |
| 756 | next | |
| 757 | case (Suc n) | |
| 758 | then show ?case | |
| 759 | using div_exp_eq [of _ 1 \<open>Suc n\<close>, symmetric] | |
| 760 | by simp | |
| 761 | qed | |
| 762 | with Suc show ?thesis | |
| 763 | by simp | |
| 764 | qed | |
| 765 | ||
| 766 | lemma even_succ_mod_exp [simp]: | |
| 767 | \<open>(1 + a) mod 2 ^ n = 1 + (a mod 2 ^ n)\<close> if \<open>even a\<close> and \<open>n > 0\<close> | |
| 768 | using div_mult_mod_eq [of \<open>1 + a\<close> \<open>2 ^ n\<close>] that | |
| 769 | apply simp | |
| 770 | by (metis local.add.left_commute local.add_left_cancel local.div_mult_mod_eq) | |
| 771 | ||
| 772 | lemma bits_mod_by_1 [simp]: | |
| 773 | \<open>a mod 1 = 0\<close> | |
| 774 | using div_mult_mod_eq [of a 1] by simp | |
| 775 | ||
| 776 | lemma bits_mod_0 [simp]: | |
| 777 | \<open>0 mod a = 0\<close> | |
| 778 | using div_mult_mod_eq [of 0 a] by simp | |
| 779 | ||
| 71195 | 780 | lemma bits_one_mod_two_eq_one [simp]: | 
| 71138 | 781 | \<open>1 mod 2 = 1\<close> | 
| 782 | by (simp add: mod2_eq_if) | |
| 783 | ||
| 71181 | 784 | lemma bit_0 [simp]: | 
| 785 | \<open>bit a 0 \<longleftrightarrow> odd a\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 786 | by (simp add: bit_iff_odd) | 
| 71181 | 787 | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 788 | lemma bit_Suc: | 
| 71181 | 789 | \<open>bit a (Suc n) \<longleftrightarrow> bit (a div 2) n\<close> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 790 | using div_exp_eq [of a 1 n] by (simp add: bit_iff_odd) | 
| 71181 | 791 | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 792 | lemma bit_rec: | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 793 | \<open>bit a n \<longleftrightarrow> (if n = 0 then odd a else bit (a div 2) (n - 1))\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 794 | by (cases n) (simp_all add: bit_Suc) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 795 | |
| 71195 | 796 | lemma bit_0_eq [simp]: | 
| 797 | \<open>bit 0 = bot\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 798 | by (simp add: fun_eq_iff bit_iff_odd) | 
| 71195 | 799 | |
| 71181 | 800 | context | 
| 801 | fixes a | |
| 802 | assumes stable: \<open>a div 2 = a\<close> | |
| 803 | begin | |
| 804 | ||
| 71195 | 805 | lemma bits_stable_imp_add_self: | 
| 71181 | 806 | \<open>a + a mod 2 = 0\<close> | 
| 807 | proof - | |
| 808 | have \<open>a div 2 * 2 + a mod 2 = a\<close> | |
| 809 | by (fact div_mult_mod_eq) | |
| 810 | then have \<open>a * 2 + a mod 2 = a\<close> | |
| 811 | by (simp add: stable) | |
| 812 | then show ?thesis | |
| 813 | by (simp add: mult_2_right ac_simps) | |
| 814 | qed | |
| 815 | ||
| 816 | lemma stable_imp_bit_iff_odd: | |
| 817 | \<open>bit a n \<longleftrightarrow> odd a\<close> | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 818 | by (induction n) (simp_all add: stable bit_Suc) | 
| 71181 | 819 | |
| 820 | end | |
| 821 | ||
| 822 | lemma bit_iff_idd_imp_stable: | |
| 823 | \<open>a div 2 = a\<close> if \<open>\<And>n. bit a n \<longleftrightarrow> odd a\<close> | |
| 71195 | 824 | using that proof (induction a rule: bits_induct) | 
| 71181 | 825 | case (stable a) | 
| 826 | then show ?case | |
| 827 | by simp | |
| 828 | next | |
| 829 | case (rec a b) | |
| 830 | from rec.prems [of 1] have [simp]: \<open>b = odd a\<close> | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 831 | by (simp add: rec.hyps bit_Suc) | 
| 71181 | 832 | from rec.hyps have hyp: \<open>(of_bool (odd a) + 2 * a) div 2 = a\<close> | 
| 833 | by simp | |
| 834 | have \<open>bit a n \<longleftrightarrow> odd a\<close> for n | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 835 | using rec.prems [of \<open>Suc n\<close>] by (simp add: hyp bit_Suc) | 
| 71181 | 836 | then have \<open>a div 2 = a\<close> | 
| 837 | by (rule rec.IH) | |
| 838 | then have \<open>of_bool (odd a) + 2 * a = 2 * (a div 2) + of_bool (odd a)\<close> | |
| 839 | by (simp add: ac_simps) | |
| 840 | also have \<open>\<dots> = a\<close> | |
| 841 | using mult_div_mod_eq [of 2 a] | |
| 842 | by (simp add: of_bool_odd_eq_mod_2) | |
| 843 | finally show ?case | |
| 844 | using \<open>a div 2 = a\<close> by (simp add: hyp) | |
| 845 | qed | |
| 846 | ||
| 71418 | 847 | lemma exp_eq_0_imp_not_bit: | 
| 848 | \<open>\<not> bit a n\<close> if \<open>2 ^ n = 0\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 849 | using that by (simp add: bit_iff_odd) | 
| 71418 | 850 | |
| 71181 | 851 | lemma bit_eqI: | 
| 71418 | 852 | \<open>a = b\<close> if \<open>\<And>n. 2 ^ n \<noteq> 0 \<Longrightarrow> bit a n \<longleftrightarrow> bit b n\<close> | 
| 853 | proof - | |
| 854 | have \<open>bit a n \<longleftrightarrow> bit b n\<close> for n | |
| 855 | proof (cases \<open>2 ^ n = 0\<close>) | |
| 856 | case True | |
| 857 | then show ?thesis | |
| 858 | by (simp add: exp_eq_0_imp_not_bit) | |
| 859 | next | |
| 860 | case False | |
| 861 | then show ?thesis | |
| 862 | by (rule that) | |
| 71181 | 863 | qed | 
| 71418 | 864 | then show ?thesis proof (induction a arbitrary: b rule: bits_induct) | 
| 865 | case (stable a) | |
| 866 | from stable(2) [of 0] have **: \<open>even b \<longleftrightarrow> even a\<close> | |
| 867 | by simp | |
| 868 | have \<open>b div 2 = b\<close> | |
| 869 | proof (rule bit_iff_idd_imp_stable) | |
| 870 | fix n | |
| 871 | from stable have *: \<open>bit b n \<longleftrightarrow> bit a n\<close> | |
| 872 | by simp | |
| 873 | also have \<open>bit a n \<longleftrightarrow> odd a\<close> | |
| 874 | using stable by (simp add: stable_imp_bit_iff_odd) | |
| 875 | finally show \<open>bit b n \<longleftrightarrow> odd b\<close> | |
| 876 | by (simp add: **) | |
| 877 | qed | |
| 878 | from ** have \<open>a mod 2 = b mod 2\<close> | |
| 879 | by (simp add: mod2_eq_if) | |
| 880 | then have \<open>a mod 2 + (a + b) = b mod 2 + (a + b)\<close> | |
| 881 | by simp | |
| 882 | then have \<open>a + a mod 2 + b = b + b mod 2 + a\<close> | |
| 883 | by (simp add: ac_simps) | |
| 884 | with \<open>a div 2 = a\<close> \<open>b div 2 = b\<close> show ?case | |
| 885 | by (simp add: bits_stable_imp_add_self) | |
| 886 | next | |
| 887 | case (rec a p) | |
| 888 | from rec.prems [of 0] have [simp]: \<open>p = odd b\<close> | |
| 889 | by simp | |
| 890 | from rec.hyps have \<open>bit a n \<longleftrightarrow> bit (b div 2) n\<close> for n | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 891 | using rec.prems [of \<open>Suc n\<close>] by (simp add: bit_Suc) | 
| 71418 | 892 | then have \<open>a = b div 2\<close> | 
| 893 | by (rule rec.IH) | |
| 894 | then have \<open>2 * a = 2 * (b div 2)\<close> | |
| 895 | by simp | |
| 896 | then have \<open>b mod 2 + 2 * a = b mod 2 + 2 * (b div 2)\<close> | |
| 897 | by simp | |
| 898 | also have \<open>\<dots> = b\<close> | |
| 899 | by (fact mod_mult_div_eq) | |
| 900 | finally show ?case | |
| 901 | by (auto simp add: mod2_eq_if) | |
| 902 | qed | |
| 71181 | 903 | qed | 
| 904 | ||
| 905 | lemma bit_eq_iff: | |
| 906 | \<open>a = b \<longleftrightarrow> (\<forall>n. bit a n \<longleftrightarrow> bit b n)\<close> | |
| 907 | by (auto intro: bit_eqI) | |
| 908 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 909 | named_theorems bit_simps \<open>Simplification rules for \<^const>\<open>bit\<close>\<close> | 
| 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 910 | |
| 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 911 | lemma bit_exp_iff [bit_simps]: | 
| 71182 | 912 | \<open>bit (2 ^ m) n \<longleftrightarrow> 2 ^ m \<noteq> 0 \<and> m = n\<close> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 913 | by (auto simp add: bit_iff_odd exp_div_exp_eq) | 
| 71182 | 914 | |
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 915 | lemma bit_1_iff [bit_simps]: | 
| 71408 | 916 | \<open>bit 1 n \<longleftrightarrow> 1 \<noteq> 0 \<and> n = 0\<close> | 
| 917 | using bit_exp_iff [of 0 n] by simp | |
| 918 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 919 | lemma bit_2_iff [bit_simps]: | 
| 71408 | 920 | \<open>bit 2 n \<longleftrightarrow> 2 \<noteq> 0 \<and> n = 1\<close> | 
| 921 | using bit_exp_iff [of 1 n] by auto | |
| 922 | ||
| 71418 | 923 | lemma even_bit_succ_iff: | 
| 924 | \<open>bit (1 + a) n \<longleftrightarrow> bit a n \<or> n = 0\<close> if \<open>even a\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 925 | using that by (cases \<open>n = 0\<close>) (simp_all add: bit_iff_odd) | 
| 71418 | 926 | |
| 927 | lemma odd_bit_iff_bit_pred: | |
| 928 | \<open>bit a n \<longleftrightarrow> bit (a - 1) n \<or> n = 0\<close> if \<open>odd a\<close> | |
| 929 | proof - | |
| 930 | from \<open>odd a\<close> obtain b where \<open>a = 2 * b + 1\<close> .. | |
| 931 | moreover have \<open>bit (2 * b) n \<or> n = 0 \<longleftrightarrow> bit (1 + 2 * b) n\<close> | |
| 932 | using even_bit_succ_iff by simp | |
| 933 | ultimately show ?thesis by (simp add: ac_simps) | |
| 934 | qed | |
| 935 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 936 | lemma bit_double_iff [bit_simps]: | 
| 71426 | 937 | \<open>bit (2 * a) n \<longleftrightarrow> bit a (n - 1) \<and> n \<noteq> 0 \<and> 2 ^ n \<noteq> 0\<close> | 
| 938 | using even_mult_exp_div_exp_iff [of a 1 n] | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 939 | by (cases n, auto simp add: bit_iff_odd ac_simps) | 
| 71426 | 940 | |
| 941 | lemma bit_eq_rec: | |
| 71441 | 942 | \<open>a = b \<longleftrightarrow> (even a \<longleftrightarrow> even b) \<and> a div 2 = b div 2\<close> (is \<open>?P = ?Q\<close>) | 
| 943 | proof | |
| 944 | assume ?P | |
| 945 | then show ?Q | |
| 946 | by simp | |
| 947 | next | |
| 948 | assume ?Q | |
| 949 | then have \<open>even a \<longleftrightarrow> even b\<close> and \<open>a div 2 = b div 2\<close> | |
| 950 | by simp_all | |
| 951 | show ?P | |
| 952 | proof (rule bit_eqI) | |
| 953 | fix n | |
| 954 | show \<open>bit a n \<longleftrightarrow> bit b n\<close> | |
| 955 | proof (cases n) | |
| 956 | case 0 | |
| 957 | with \<open>even a \<longleftrightarrow> even b\<close> show ?thesis | |
| 958 | by simp | |
| 959 | next | |
| 960 | case (Suc n) | |
| 961 | moreover from \<open>a div 2 = b div 2\<close> have \<open>bit (a div 2) n = bit (b div 2) n\<close> | |
| 962 | by simp | |
| 963 | ultimately show ?thesis | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 964 | by (simp add: bit_Suc) | 
| 71441 | 965 | qed | 
| 966 | qed | |
| 967 | qed | |
| 71426 | 968 | |
| 71822 | 969 | lemma bit_mod_2_iff [simp]: | 
| 970 | \<open>bit (a mod 2) n \<longleftrightarrow> n = 0 \<and> odd a\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 971 | by (cases a rule: parity_cases) (simp_all add: bit_iff_odd) | 
| 71822 | 972 | |
| 71418 | 973 | lemma bit_mask_iff: | 
| 974 | \<open>bit (2 ^ m - 1) n \<longleftrightarrow> 2 ^ n \<noteq> 0 \<and> n < m\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 975 | by (simp add: bit_iff_odd even_mask_div_iff not_le) | 
| 71418 | 976 | |
| 71757 | 977 | lemma bit_Numeral1_iff [simp]: | 
| 978 | \<open>bit (numeral Num.One) n \<longleftrightarrow> n = 0\<close> | |
| 979 | by (simp add: bit_rec) | |
| 980 | ||
| 72227 | 981 | lemma exp_add_not_zero_imp: | 
| 982 | \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> if \<open>2 ^ (m + n) \<noteq> 0\<close> | |
| 983 | proof - | |
| 984 | have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close> | |
| 985 | proof (rule notI) | |
| 986 | assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close> | |
| 987 | then have \<open>2 ^ (m + n) = 0\<close> | |
| 988 | by (rule disjE) (simp_all add: power_add) | |
| 989 | with that show False .. | |
| 990 | qed | |
| 991 | then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> | |
| 992 | by simp_all | |
| 993 | qed | |
| 994 | ||
| 72239 | 995 | lemma bit_disjunctive_add_iff: | 
| 996 | \<open>bit (a + b) n \<longleftrightarrow> bit a n \<or> bit b n\<close> | |
| 997 | if \<open>\<And>n. \<not> bit a n \<or> \<not> bit b n\<close> | |
| 998 | proof (cases \<open>2 ^ n = 0\<close>) | |
| 999 | case True | |
| 1000 | then show ?thesis | |
| 1001 | by (simp add: exp_eq_0_imp_not_bit) | |
| 1002 | next | |
| 1003 | case False | |
| 1004 | with that show ?thesis proof (induction n arbitrary: a b) | |
| 1005 | case 0 | |
| 1006 | from "0.prems"(1) [of 0] show ?case | |
| 1007 | by auto | |
| 1008 | next | |
| 1009 | case (Suc n) | |
| 1010 | from Suc.prems(1) [of 0] have even: \<open>even a \<or> even b\<close> | |
| 1011 | by auto | |
| 1012 | have bit: \<open>\<not> bit (a div 2) n \<or> \<not> bit (b div 2) n\<close> for n | |
| 1013 | using Suc.prems(1) [of \<open>Suc n\<close>] by (simp add: bit_Suc) | |
| 1014 | from Suc.prems(2) have \<open>2 * 2 ^ n \<noteq> 0\<close> \<open>2 ^ n \<noteq> 0\<close> | |
| 1015 | by (auto simp add: mult_2) | |
| 1016 | have \<open>a + b = (a div 2 * 2 + a mod 2) + (b div 2 * 2 + b mod 2)\<close> | |
| 1017 | using div_mult_mod_eq [of a 2] div_mult_mod_eq [of b 2] by simp | |
| 1018 | also have \<open>\<dots> = of_bool (odd a \<or> odd b) + 2 * (a div 2 + b div 2)\<close> | |
| 1019 | using even by (auto simp add: algebra_simps mod2_eq_if) | |
| 1020 | finally have \<open>bit ((a + b) div 2) n \<longleftrightarrow> bit (a div 2 + b div 2) n\<close> | |
| 1021 | using \<open>2 * 2 ^ n \<noteq> 0\<close> by simp (simp flip: bit_Suc add: bit_double_iff) | |
| 1022 | also have \<open>\<dots> \<longleftrightarrow> bit (a div 2) n \<or> bit (b div 2) n\<close> | |
| 1023 | using bit \<open>2 ^ n \<noteq> 0\<close> by (rule Suc.IH) | |
| 1024 | finally show ?case | |
| 1025 | by (simp add: bit_Suc) | |
| 1026 | qed | |
| 1027 | qed | |
| 1028 | ||
| 72261 | 1029 | lemma | 
| 1030 | exp_add_not_zero_imp_left: \<open>2 ^ m \<noteq> 0\<close> | |
| 1031 | and exp_add_not_zero_imp_right: \<open>2 ^ n \<noteq> 0\<close> | |
| 1032 | if \<open>2 ^ (m + n) \<noteq> 0\<close> | |
| 1033 | proof - | |
| 1034 | have \<open>\<not> (2 ^ m = 0 \<or> 2 ^ n = 0)\<close> | |
| 1035 | proof (rule notI) | |
| 1036 | assume \<open>2 ^ m = 0 \<or> 2 ^ n = 0\<close> | |
| 1037 | then have \<open>2 ^ (m + n) = 0\<close> | |
| 1038 | by (rule disjE) (simp_all add: power_add) | |
| 1039 | with that show False .. | |
| 1040 | qed | |
| 1041 | then show \<open>2 ^ m \<noteq> 0\<close> and \<open>2 ^ n \<noteq> 0\<close> | |
| 1042 | by simp_all | |
| 1043 | qed | |
| 1044 | ||
| 1045 | lemma exp_not_zero_imp_exp_diff_not_zero: | |
| 1046 | \<open>2 ^ (n - m) \<noteq> 0\<close> if \<open>2 ^ n \<noteq> 0\<close> | |
| 1047 | proof (cases \<open>m \<le> n\<close>) | |
| 1048 | case True | |
| 1049 | moreover define q where \<open>q = n - m\<close> | |
| 1050 | ultimately have \<open>n = m + q\<close> | |
| 1051 | by simp | |
| 1052 | with that show ?thesis | |
| 1053 | by (simp add: exp_add_not_zero_imp_right) | |
| 1054 | next | |
| 1055 | case False | |
| 1056 | with that show ?thesis | |
| 1057 | by simp | |
| 1058 | qed | |
| 1059 | ||
| 71138 | 1060 | end | 
| 71094 | 1061 | |
| 1062 | lemma nat_bit_induct [case_names zero even odd]: | |
| 1063 | "P n" if zero: "P 0" | |
| 1064 | and even: "\<And>n. P n \<Longrightarrow> n > 0 \<Longrightarrow> P (2 * n)" | |
| 1065 | and odd: "\<And>n. P n \<Longrightarrow> P (Suc (2 * n))" | |
| 1066 | proof (induction n rule: less_induct) | |
| 1067 | case (less n) | |
| 1068 | show "P n" | |
| 1069 | proof (cases "n = 0") | |
| 1070 | case True with zero show ?thesis by simp | |
| 1071 | next | |
| 1072 | case False | |
| 1073 | with less have hyp: "P (n div 2)" by simp | |
| 1074 | show ?thesis | |
| 1075 | proof (cases "even n") | |
| 1076 | case True | |
| 1077 | then have "n \<noteq> 1" | |
| 1078 | by auto | |
| 1079 | with \<open>n \<noteq> 0\<close> have "n div 2 > 0" | |
| 1080 | by simp | |
| 1081 | with \<open>even n\<close> hyp even [of "n div 2"] show ?thesis | |
| 1082 | by simp | |
| 1083 | next | |
| 1084 | case False | |
| 1085 | with hyp odd [of "n div 2"] show ?thesis | |
| 1086 | by simp | |
| 1087 | qed | |
| 1088 | qed | |
| 1089 | qed | |
| 1090 | ||
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1091 | instantiation nat :: semiring_bits | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1092 | begin | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1093 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1094 | definition bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> bool\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1095 | where \<open>bit_nat m n \<longleftrightarrow> odd (m div 2 ^ n)\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1096 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1097 | instance | 
| 71094 | 1098 | proof | 
| 1099 | show \<open>P n\<close> if stable: \<open>\<And>n. n div 2 = n \<Longrightarrow> P n\<close> | |
| 1100 | 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> | |
| 1101 | for P and n :: nat | |
| 1102 | proof (induction n rule: nat_bit_induct) | |
| 1103 | case zero | |
| 1104 | from stable [of 0] show ?case | |
| 1105 | by simp | |
| 1106 | next | |
| 1107 | case (even n) | |
| 1108 | with rec [of n False] show ?case | |
| 1109 | by simp | |
| 1110 | next | |
| 1111 | case (odd n) | |
| 1112 | with rec [of n True] show ?case | |
| 1113 | by simp | |
| 1114 | qed | |
| 71138 | 1115 | show \<open>q mod 2 ^ m mod 2 ^ n = q mod 2 ^ min m n\<close> | 
| 1116 | for q m n :: nat | |
| 1117 | apply (auto simp add: less_iff_Suc_add power_add mod_mod_cancel split: split_min_lin) | |
| 1118 | apply (metis div_mult2_eq mod_div_trivial mod_eq_self_iff_div_eq_0 mod_mult_self2_is_0 power_commutes) | |
| 1119 | done | |
| 1120 | show \<open>(q * 2 ^ m) mod (2 ^ n) = (q mod 2 ^ (n - m)) * 2 ^ m\<close> if \<open>m \<le> n\<close> | |
| 1121 | for q m n :: nat | |
| 1122 | using that | |
| 1123 | apply (auto simp add: mod_mod_cancel div_mult2_eq power_add mod_mult2_eq le_iff_add split: split_min_lin) | |
| 1124 | apply (simp add: mult.commute) | |
| 1125 | done | |
| 71413 | 1126 | show \<open>even ((2 ^ m - (1::nat)) div 2 ^ n) \<longleftrightarrow> 2 ^ n = (0::nat) \<or> m \<le> n\<close> | 
| 1127 | for m n :: nat | |
| 1128 | using even_mask_div_iff' [where ?'a = nat, of m n] by simp | |
| 71424 | 1129 | 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> | 
| 1130 | for m n q r :: nat | |
| 1131 | apply (auto simp add: not_less power_add ac_simps dest!: le_Suc_ex) | |
| 1132 | apply (metis (full_types) dvd_mult dvd_mult_imp_div dvd_power_iff_le not_less not_less_eq order_refl power_Suc) | |
| 1133 | done | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1134 | qed (auto simp add: div_mult2_eq mod_mult2_eq power_add power_diff bit_nat_def) | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1135 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1136 | end | 
| 71094 | 1137 | |
| 70353 | 1138 | lemma int_bit_induct [case_names zero minus even odd]: | 
| 70338 | 1139 | "P k" if zero_int: "P 0" | 
| 1140 | and minus_int: "P (- 1)" | |
| 1141 | and even_int: "\<And>k. P k \<Longrightarrow> k \<noteq> 0 \<Longrightarrow> P (k * 2)" | |
| 1142 | and odd_int: "\<And>k. P k \<Longrightarrow> k \<noteq> - 1 \<Longrightarrow> P (1 + (k * 2))" for k :: int | |
| 1143 | proof (cases "k \<ge> 0") | |
| 1144 | case True | |
| 1145 | define n where "n = nat k" | |
| 1146 | with True have "k = int n" | |
| 1147 | by simp | |
| 1148 | then show "P k" | |
| 70353 | 1149 | proof (induction n arbitrary: k rule: nat_bit_induct) | 
| 70338 | 1150 | case zero | 
| 1151 | then show ?case | |
| 1152 | by (simp add: zero_int) | |
| 1153 | next | |
| 1154 | case (even n) | |
| 1155 | have "P (int n * 2)" | |
| 1156 | by (rule even_int) (use even in simp_all) | |
| 1157 | with even show ?case | |
| 1158 | by (simp add: ac_simps) | |
| 1159 | next | |
| 1160 | case (odd n) | |
| 1161 | have "P (1 + (int n * 2))" | |
| 1162 | by (rule odd_int) (use odd in simp_all) | |
| 1163 | with odd show ?case | |
| 1164 | by (simp add: ac_simps) | |
| 1165 | qed | |
| 1166 | next | |
| 1167 | case False | |
| 1168 | define n where "n = nat (- k - 1)" | |
| 1169 | with False have "k = - int n - 1" | |
| 1170 | by simp | |
| 1171 | then show "P k" | |
| 70353 | 1172 | proof (induction n arbitrary: k rule: nat_bit_induct) | 
| 70338 | 1173 | case zero | 
| 1174 | then show ?case | |
| 1175 | by (simp add: minus_int) | |
| 1176 | next | |
| 1177 | case (even n) | |
| 1178 | have "P (1 + (- int (Suc n) * 2))" | |
| 1179 | by (rule odd_int) (use even in \<open>simp_all add: algebra_simps\<close>) | |
| 1180 | also have "\<dots> = - int (2 * n) - 1" | |
| 1181 | by (simp add: algebra_simps) | |
| 1182 | finally show ?case | |
| 72261 | 1183 | using even.prems by simp | 
| 70338 | 1184 | next | 
| 1185 | case (odd n) | |
| 1186 | have "P (- int (Suc n) * 2)" | |
| 1187 | by (rule even_int) (use odd in \<open>simp_all add: algebra_simps\<close>) | |
| 1188 | also have "\<dots> = - int (Suc (2 * n)) - 1" | |
| 1189 | by (simp add: algebra_simps) | |
| 1190 | finally show ?case | |
| 72261 | 1191 | using odd.prems by simp | 
| 70338 | 1192 | qed | 
| 1193 | qed | |
| 1194 | ||
| 72227 | 1195 | context semiring_bits | 
| 1196 | begin | |
| 1197 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1198 | lemma bit_of_bool_iff [bit_simps]: | 
| 72281 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 haftmann parents: 
72262diff
changeset | 1199 | \<open>bit (of_bool b) n \<longleftrightarrow> b \<and> n = 0\<close> | 
| 72792 | 1200 | by (simp add: bit_1_iff) | 
| 72281 
beeadb35e357
more thorough treatment of division, particularly signed division on int and word
 haftmann parents: 
72262diff
changeset | 1201 | |
| 72227 | 1202 | lemma even_of_nat_iff: | 
| 1203 | \<open>even (of_nat n) \<longleftrightarrow> even n\<close> | |
| 1204 | by (induction n rule: nat_bit_induct) simp_all | |
| 1205 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1206 | lemma bit_of_nat_iff [bit_simps]: | 
| 72227 | 1207 | \<open>bit (of_nat m) n \<longleftrightarrow> (2::'a) ^ n \<noteq> 0 \<and> bit m n\<close> | 
| 1208 | proof (cases \<open>(2::'a) ^ n = 0\<close>) | |
| 1209 | case True | |
| 1210 | then show ?thesis | |
| 1211 | by (simp add: exp_eq_0_imp_not_bit) | |
| 1212 | next | |
| 1213 | case False | |
| 1214 | then have \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close> | |
| 1215 | proof (induction m arbitrary: n rule: nat_bit_induct) | |
| 1216 | case zero | |
| 1217 | then show ?case | |
| 1218 | by simp | |
| 1219 | next | |
| 1220 | case (even m) | |
| 1221 | then show ?case | |
| 1222 | by (cases n) | |
| 1223 | (auto simp add: bit_double_iff Parity.bit_double_iff dest: mult_not_zero) | |
| 1224 | next | |
| 1225 | case (odd m) | |
| 1226 | then show ?case | |
| 1227 | by (cases n) | |
| 1228 | (auto simp add: bit_double_iff even_bit_succ_iff Parity.bit_Suc dest: mult_not_zero) | |
| 1229 | qed | |
| 1230 | with False show ?thesis | |
| 1231 | by simp | |
| 1232 | qed | |
| 1233 | ||
| 1234 | end | |
| 1235 | ||
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1236 | instantiation int :: semiring_bits | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1237 | begin | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1238 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1239 | definition bit_int :: \<open>int \<Rightarrow> nat \<Rightarrow> bool\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1240 | where \<open>bit_int k n \<longleftrightarrow> odd (k div 2 ^ n)\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1241 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1242 | instance | 
| 71094 | 1243 | proof | 
| 1244 | show \<open>P k\<close> if stable: \<open>\<And>k. k div 2 = k \<Longrightarrow> P k\<close> | |
| 1245 | 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> | |
| 1246 | for P and k :: int | |
| 1247 | proof (induction k rule: int_bit_induct) | |
| 1248 | case zero | |
| 1249 | from stable [of 0] show ?case | |
| 1250 | by simp | |
| 1251 | next | |
| 1252 | case minus | |
| 1253 | from stable [of \<open>- 1\<close>] show ?case | |
| 1254 | by simp | |
| 1255 | next | |
| 1256 | case (even k) | |
| 1257 | with rec [of k False] show ?case | |
| 1258 | by (simp add: ac_simps) | |
| 1259 | next | |
| 1260 | case (odd k) | |
| 1261 | with rec [of k True] show ?case | |
| 1262 | by (simp add: ac_simps) | |
| 1263 | qed | |
| 71182 | 1264 | show \<open>(2::int) ^ m div 2 ^ n = of_bool ((2::int) ^ m \<noteq> 0 \<and> n \<le> m) * 2 ^ (m - n)\<close> | 
| 1265 | for m n :: nat | |
| 1266 | proof (cases \<open>m < n\<close>) | |
| 1267 | case True | |
| 1268 | then have \<open>n = m + (n - m)\<close> | |
| 1269 | by simp | |
| 1270 | then have \<open>(2::int) ^ m div 2 ^ n = (2::int) ^ m div 2 ^ (m + (n - m))\<close> | |
| 1271 | by simp | |
| 1272 | also have \<open>\<dots> = (2::int) ^ m div (2 ^ m * 2 ^ (n - m))\<close> | |
| 1273 | by (simp add: power_add) | |
| 1274 | also have \<open>\<dots> = (2::int) ^ m div 2 ^ m div 2 ^ (n - m)\<close> | |
| 1275 | by (simp add: zdiv_zmult2_eq) | |
| 1276 | finally show ?thesis using \<open>m < n\<close> by simp | |
| 1277 | next | |
| 1278 | case False | |
| 1279 | then show ?thesis | |
| 1280 | by (simp add: power_diff) | |
| 1281 | qed | |
| 71138 | 1282 | show \<open>k mod 2 ^ m mod 2 ^ n = k mod 2 ^ min m n\<close> | 
| 1283 | for m n :: nat and k :: int | |
| 1284 | using mod_exp_eq [of \<open>nat k\<close> m n] | |
| 1285 | apply (auto simp add: mod_mod_cancel zdiv_zmult2_eq power_add zmod_zmult2_eq le_iff_add split: split_min_lin) | |
| 1286 | apply (auto simp add: less_iff_Suc_add mod_mod_cancel power_add) | |
| 1287 | apply (simp only: flip: mult.left_commute [of \<open>2 ^ m\<close>]) | |
| 1288 | apply (subst zmod_zmult2_eq) apply simp_all | |
| 1289 | done | |
| 1290 | show \<open>(k * 2 ^ m) mod (2 ^ n) = (k mod 2 ^ (n - m)) * 2 ^ m\<close> | |
| 1291 | if \<open>m \<le> n\<close> for m n :: nat and k :: int | |
| 1292 | using that | |
| 1293 | apply (auto simp add: power_add zmod_zmult2_eq le_iff_add split: split_min_lin) | |
| 1294 | apply (simp add: ac_simps) | |
| 1295 | done | |
| 71413 | 1296 | show \<open>even ((2 ^ m - (1::int)) div 2 ^ n) \<longleftrightarrow> 2 ^ n = (0::int) \<or> m \<le> n\<close> | 
| 1297 | for m n :: nat | |
| 1298 | using even_mask_div_iff' [where ?'a = int, of m n] by simp | |
| 71424 | 1299 | 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> | 
| 1300 | for m n :: nat and k l :: int | |
| 1301 | apply (auto simp add: not_less power_add ac_simps dest!: le_Suc_ex) | |
| 1302 | apply (metis Suc_leI dvd_mult dvd_mult_imp_div dvd_power_le dvd_refl power.simps(2)) | |
| 1303 | done | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1304 | qed (auto simp add: zdiv_zmult2_eq zmod_zmult2_eq power_add power_diff not_le bit_int_def) | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1305 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1306 | end | 
| 67816 | 1307 | |
| 71094 | 1308 | class semiring_bit_shifts = semiring_bits + | 
| 1309 | fixes push_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close> | |
| 1310 | assumes push_bit_eq_mult: \<open>push_bit n a = a * 2 ^ n\<close> | |
| 1311 | fixes drop_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close> | |
| 1312 | assumes drop_bit_eq_div: \<open>drop_bit n a = a div 2 ^ n\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1313 | fixes take_bit :: \<open>nat \<Rightarrow> 'a \<Rightarrow> 'a\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1314 | assumes take_bit_eq_mod: \<open>take_bit n a = a mod 2 ^ n\<close> | 
| 67816 | 1315 | begin | 
| 1316 | ||
| 71094 | 1317 | text \<open> | 
| 1318 | Logically, \<^const>\<open>push_bit\<close>, | |
| 1319 | \<^const>\<open>drop_bit\<close> and \<^const>\<open>take_bit\<close> are just aliases; having them | |
| 1320 | as separate operations makes proofs easier, otherwise proof automation | |
| 1321 | would fiddle with concrete expressions \<^term>\<open>2 ^ n\<close> in a way obfuscating the basic | |
| 1322 | algebraic relationships between those operations. | |
| 1323 | Having | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1324 | them as definitional class operations | 
| 71094 | 1325 | takes into account that specific instances of these can be implemented | 
| 1326 | differently wrt. code generation. | |
| 1327 | \<close> | |
| 67816 | 1328 | |
| 71408 | 1329 | lemma bit_iff_odd_drop_bit: | 
| 1330 | \<open>bit a n \<longleftrightarrow> odd (drop_bit n a)\<close> | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1331 | by (simp add: bit_iff_odd drop_bit_eq_div) | 
| 71408 | 1332 | |
| 1333 | lemma even_drop_bit_iff_not_bit: | |
| 1334 | \<open>even (drop_bit n a) \<longleftrightarrow> \<not> bit a n\<close> | |
| 1335 | by (simp add: bit_iff_odd_drop_bit) | |
| 1336 | ||
| 71423 | 1337 | lemma div_push_bit_of_1_eq_drop_bit: | 
| 1338 | \<open>a div push_bit n 1 = drop_bit n a\<close> | |
| 1339 | by (simp add: push_bit_eq_mult drop_bit_eq_div) | |
| 1340 | ||
| 71195 | 1341 | lemma bits_ident: | 
| 71138 | 1342 | "push_bit n (drop_bit n a) + take_bit n a = a" | 
| 1343 | using div_mult_mod_eq by (simp add: push_bit_eq_mult take_bit_eq_mod drop_bit_eq_div) | |
| 1344 | ||
| 1345 | lemma push_bit_push_bit [simp]: | |
| 1346 | "push_bit m (push_bit n a) = push_bit (m + n) a" | |
| 1347 | by (simp add: push_bit_eq_mult power_add ac_simps) | |
| 1348 | ||
| 1349 | lemma push_bit_0_id [simp]: | |
| 1350 | "push_bit 0 = id" | |
| 1351 | by (simp add: fun_eq_iff push_bit_eq_mult) | |
| 1352 | ||
| 1353 | lemma push_bit_of_0 [simp]: | |
| 1354 | "push_bit n 0 = 0" | |
| 1355 | by (simp add: push_bit_eq_mult) | |
| 1356 | ||
| 1357 | lemma push_bit_of_1: | |
| 1358 | "push_bit n 1 = 2 ^ n" | |
| 1359 | by (simp add: push_bit_eq_mult) | |
| 1360 | ||
| 1361 | lemma push_bit_Suc [simp]: | |
| 1362 | "push_bit (Suc n) a = push_bit n (a * 2)" | |
| 1363 | by (simp add: push_bit_eq_mult ac_simps) | |
| 1364 | ||
| 1365 | lemma push_bit_double: | |
| 1366 | "push_bit n (a * 2) = push_bit n a * 2" | |
| 1367 | by (simp add: push_bit_eq_mult ac_simps) | |
| 1368 | ||
| 1369 | lemma push_bit_add: | |
| 1370 | "push_bit n (a + b) = push_bit n a + push_bit n b" | |
| 1371 | by (simp add: push_bit_eq_mult algebra_simps) | |
| 1372 | ||
| 71991 | 1373 | lemma push_bit_numeral [simp]: | 
| 1374 | \<open>push_bit (numeral l) (numeral k) = push_bit (pred_numeral l) (numeral (Num.Bit0 k))\<close> | |
| 1375 | by (simp add: numeral_eq_Suc mult_2_right) (simp add: numeral_Bit0) | |
| 1376 | ||
| 71138 | 1377 | lemma take_bit_0 [simp]: | 
| 1378 | "take_bit 0 a = 0" | |
| 1379 | by (simp add: take_bit_eq_mod) | |
| 1380 | ||
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1381 | lemma take_bit_Suc: | 
| 71822 | 1382 | \<open>take_bit (Suc n) a = take_bit n (a div 2) * 2 + a mod 2\<close> | 
| 71138 | 1383 | proof - | 
| 1384 | 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> | |
| 1385 | using even_succ_mod_exp [of \<open>2 * (a div 2)\<close> \<open>Suc n\<close>] | |
| 1386 | mult_exp_mod_exp_eq [of 1 \<open>Suc n\<close> \<open>a div 2\<close>] | |
| 1387 | by (auto simp add: take_bit_eq_mod ac_simps) | |
| 1388 | then show ?thesis | |
| 1389 | using div_mult_mod_eq [of a 2] by (simp add: mod_2_eq_odd) | |
| 1390 | qed | |
| 1391 | ||
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1392 | lemma take_bit_rec: | 
| 71822 | 1393 | \<open>take_bit n a = (if n = 0 then 0 else take_bit (n - 1) (a div 2) * 2 + a mod 2)\<close> | 
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1394 | by (cases n) (simp_all add: take_bit_Suc) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1395 | |
| 71759 | 1396 | lemma take_bit_Suc_0 [simp]: | 
| 1397 | \<open>take_bit (Suc 0) a = a mod 2\<close> | |
| 1398 | by (simp add: take_bit_eq_mod) | |
| 1399 | ||
| 71138 | 1400 | lemma take_bit_of_0 [simp]: | 
| 1401 | "take_bit n 0 = 0" | |
| 1402 | by (simp add: take_bit_eq_mod) | |
| 1403 | ||
| 1404 | lemma take_bit_of_1 [simp]: | |
| 1405 | "take_bit n 1 = of_bool (n > 0)" | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1406 | by (cases n) (simp_all add: take_bit_Suc) | 
| 71138 | 1407 | |
| 1408 | lemma drop_bit_of_0 [simp]: | |
| 1409 | "drop_bit n 0 = 0" | |
| 1410 | by (simp add: drop_bit_eq_div) | |
| 1411 | ||
| 1412 | lemma drop_bit_of_1 [simp]: | |
| 1413 | "drop_bit n 1 = of_bool (n = 0)" | |
| 1414 | by (simp add: drop_bit_eq_div) | |
| 1415 | ||
| 1416 | lemma drop_bit_0 [simp]: | |
| 1417 | "drop_bit 0 = id" | |
| 1418 | by (simp add: fun_eq_iff drop_bit_eq_div) | |
| 1419 | ||
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1420 | lemma drop_bit_Suc: | 
| 71138 | 1421 | "drop_bit (Suc n) a = drop_bit n (a div 2)" | 
| 1422 | using div_exp_eq [of a 1] by (simp add: drop_bit_eq_div) | |
| 1423 | ||
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1424 | lemma drop_bit_rec: | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1425 | "drop_bit n a = (if n = 0 then a else drop_bit (n - 1) (a div 2))" | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1426 | by (cases n) (simp_all add: drop_bit_Suc) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1427 | |
| 71138 | 1428 | lemma drop_bit_half: | 
| 1429 | "drop_bit n (a div 2) = drop_bit n a div 2" | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1430 | by (induction n arbitrary: a) (simp_all add: drop_bit_Suc) | 
| 71138 | 1431 | |
| 1432 | lemma drop_bit_of_bool [simp]: | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1433 | "drop_bit n (of_bool b) = of_bool (n = 0 \<and> b)" | 
| 71138 | 1434 | by (cases n) simp_all | 
| 1435 | ||
| 1436 | lemma even_take_bit_eq [simp]: | |
| 1437 | \<open>even (take_bit n a) \<longleftrightarrow> n = 0 \<or> even a\<close> | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1438 | by (simp add: take_bit_rec [of n a]) | 
| 71138 | 1439 | |
| 1440 | lemma take_bit_take_bit [simp]: | |
| 1441 | "take_bit m (take_bit n a) = take_bit (min m n) a" | |
| 1442 | by (simp add: take_bit_eq_mod mod_exp_eq ac_simps) | |
| 1443 | ||
| 1444 | lemma drop_bit_drop_bit [simp]: | |
| 1445 | "drop_bit m (drop_bit n a) = drop_bit (m + n) a" | |
| 1446 | by (simp add: drop_bit_eq_div power_add div_exp_eq ac_simps) | |
| 1447 | ||
| 1448 | lemma push_bit_take_bit: | |
| 1449 | "push_bit m (take_bit n a) = take_bit (m + n) (push_bit m a)" | |
| 1450 | apply (simp add: push_bit_eq_mult take_bit_eq_mod power_add ac_simps) | |
| 1451 | using mult_exp_mod_exp_eq [of m \<open>m + n\<close> a] apply (simp add: ac_simps power_add) | |
| 1452 | done | |
| 1453 | ||
| 1454 | lemma take_bit_push_bit: | |
| 1455 | "take_bit m (push_bit n a) = push_bit n (take_bit (m - n) a)" | |
| 1456 | proof (cases "m \<le> n") | |
| 1457 | case True | |
| 1458 | then show ?thesis | |
| 1459 | apply (simp add:) | |
| 1460 | apply (simp_all add: push_bit_eq_mult take_bit_eq_mod) | |
| 1461 | apply (auto dest!: le_Suc_ex simp add: power_add ac_simps) | |
| 1462 | using mult_exp_mod_exp_eq [of m m \<open>a * 2 ^ n\<close> for n] | |
| 1463 | apply (simp add: ac_simps) | |
| 1464 | done | |
| 1465 | next | |
| 1466 | case False | |
| 1467 | then show ?thesis | |
| 1468 | using push_bit_take_bit [of n "m - n" a] | |
| 1469 | by simp | |
| 1470 | qed | |
| 1471 | ||
| 1472 | lemma take_bit_drop_bit: | |
| 1473 | "take_bit m (drop_bit n a) = drop_bit n (take_bit (m + n) a)" | |
| 1474 | by (simp add: drop_bit_eq_div take_bit_eq_mod ac_simps div_exp_mod_exp_eq) | |
| 1475 | ||
| 1476 | lemma drop_bit_take_bit: | |
| 1477 | "drop_bit m (take_bit n a) = take_bit (n - m) (drop_bit m a)" | |
| 1478 | proof (cases "m \<le> n") | |
| 1479 | case True | |
| 1480 | then show ?thesis | |
| 1481 | using take_bit_drop_bit [of "n - m" m a] by simp | |
| 1482 | next | |
| 1483 | case False | |
| 1484 | then obtain q where \<open>m = n + q\<close> | |
| 1485 | by (auto simp add: not_le dest: less_imp_Suc_add) | |
| 1486 | then have \<open>drop_bit m (take_bit n a) = 0\<close> | |
| 1487 | using div_exp_eq [of \<open>a mod 2 ^ n\<close> n q] | |
| 1488 | by (simp add: take_bit_eq_mod drop_bit_eq_div) | |
| 1489 | with False show ?thesis | |
| 1490 | by simp | |
| 1491 | qed | |
| 1492 | ||
| 71424 | 1493 | lemma even_push_bit_iff [simp]: | 
| 1494 | \<open>even (push_bit n a) \<longleftrightarrow> n \<noteq> 0 \<or> even a\<close> | |
| 1495 | by (simp add: push_bit_eq_mult) auto | |
| 1496 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1497 | lemma bit_push_bit_iff [bit_simps]: | 
| 71991 | 1498 | \<open>bit (push_bit m a) n \<longleftrightarrow> m \<le> n \<and> 2 ^ n \<noteq> 0 \<and> bit a (n - m)\<close> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1499 | by (auto simp add: bit_iff_odd push_bit_eq_mult even_mult_exp_div_exp_iff) | 
| 71424 | 1500 | |
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1501 | lemma bit_drop_bit_eq [bit_simps]: | 
| 71181 | 1502 | \<open>bit (drop_bit n a) = bit a \<circ> (+) n\<close> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1503 | by (simp add: bit_iff_odd fun_eq_iff ac_simps flip: drop_bit_eq_div) | 
| 71181 | 1504 | |
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1505 | lemma bit_take_bit_iff [bit_simps]: | 
| 71181 | 1506 | \<open>bit (take_bit m a) n \<longleftrightarrow> n < m \<and> bit a n\<close> | 
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1507 | by (simp add: bit_iff_odd drop_bit_take_bit not_le flip: drop_bit_eq_div) | 
| 71181 | 1508 | |
| 71535 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1509 | lemma stable_imp_drop_bit_eq: | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1510 | \<open>drop_bit n a = a\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1511 | if \<open>a div 2 = a\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1512 | by (induction n) (simp_all add: that drop_bit_Suc) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1513 | |
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1514 | lemma stable_imp_take_bit_eq: | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1515 | \<open>take_bit n a = (if even a then 0 else 2 ^ n - 1)\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1516 | if \<open>a div 2 = a\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1517 | proof (rule bit_eqI) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1518 | fix m | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1519 | assume \<open>2 ^ m \<noteq> 0\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1520 | with that show \<open>bit (take_bit n a) m \<longleftrightarrow> bit (if even a then 0 else 2 ^ n - 1) m\<close> | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1521 | by (simp add: bit_take_bit_iff bit_mask_iff stable_imp_bit_iff_odd) | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1522 | qed | 
| 
b612edee9b0c
more frugal simp rules for bit operations; more pervasive use of bit selector
 haftmann parents: 
71441diff
changeset | 1523 | |
| 71958 | 1524 | lemma exp_dvdE: | 
| 1525 | assumes \<open>2 ^ n dvd a\<close> | |
| 1526 | obtains b where \<open>a = push_bit n b\<close> | |
| 1527 | proof - | |
| 1528 | from assms obtain b where \<open>a = 2 ^ n * b\<close> .. | |
| 1529 | then have \<open>a = push_bit n b\<close> | |
| 1530 | by (simp add: push_bit_eq_mult ac_simps) | |
| 1531 | with that show thesis . | |
| 1532 | qed | |
| 1533 | ||
| 1534 | lemma take_bit_eq_0_iff: | |
| 1535 | \<open>take_bit n a = 0 \<longleftrightarrow> 2 ^ n dvd a\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) | |
| 1536 | proof | |
| 1537 | assume ?P | |
| 1538 | then show ?Q | |
| 72792 | 1539 | by (simp add: take_bit_eq_mod mod_0_imp_dvd) | 
| 71958 | 1540 | next | 
| 1541 | assume ?Q | |
| 1542 | then obtain b where \<open>a = push_bit n b\<close> | |
| 1543 | by (rule exp_dvdE) | |
| 1544 | then show ?P | |
| 1545 | by (simp add: take_bit_push_bit) | |
| 1546 | qed | |
| 1547 | ||
| 72079 | 1548 | lemma take_bit_tightened: | 
| 1549 | \<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> | |
| 1550 | proof - | |
| 1551 | from that have \<open>take_bit m (take_bit n a) = take_bit m (take_bit n b)\<close> | |
| 1552 | by simp | |
| 1553 | then have \<open>take_bit (min m n) a = take_bit (min m n) b\<close> | |
| 1554 | by simp | |
| 1555 | with that show ?thesis | |
| 1556 | by (simp add: min_def) | |
| 1557 | qed | |
| 1558 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 1559 | end | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 1560 | |
| 71094 | 1561 | instantiation nat :: semiring_bit_shifts | 
| 1562 | begin | |
| 1563 | ||
| 1564 | definition push_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close> | |
| 1565 | where \<open>push_bit_nat n m = m * 2 ^ n\<close> | |
| 1566 | ||
| 1567 | definition drop_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close> | |
| 1568 | where \<open>drop_bit_nat n m = m div 2 ^ n\<close> | |
| 1569 | ||
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1570 | definition take_bit_nat :: \<open>nat \<Rightarrow> nat \<Rightarrow> nat\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1571 | where \<open>take_bit_nat n m = m mod 2 ^ n\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1572 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1573 | instance | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1574 | by standard (simp_all add: push_bit_nat_def drop_bit_nat_def take_bit_nat_def) | 
| 71094 | 1575 | |
| 1576 | end | |
| 1577 | ||
| 72227 | 1578 | context semiring_bit_shifts | 
| 1579 | begin | |
| 1580 | ||
| 1581 | lemma push_bit_of_nat: | |
| 1582 | \<open>push_bit n (of_nat m) = of_nat (push_bit n m)\<close> | |
| 1583 | by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult) | |
| 1584 | ||
| 1585 | lemma of_nat_push_bit: | |
| 1586 | \<open>of_nat (push_bit m n) = push_bit m (of_nat n)\<close> | |
| 1587 | by (simp add: push_bit_eq_mult semiring_bit_shifts_class.push_bit_eq_mult) | |
| 1588 | ||
| 1589 | lemma take_bit_of_nat: | |
| 1590 | \<open>take_bit n (of_nat m) = of_nat (take_bit n m)\<close> | |
| 1591 | by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_nat_iff) | |
| 1592 | ||
| 1593 | lemma of_nat_take_bit: | |
| 1594 | \<open>of_nat (take_bit n m) = take_bit n (of_nat m)\<close> | |
| 1595 | by (rule bit_eqI) (simp add: bit_take_bit_iff Parity.bit_take_bit_iff bit_of_nat_iff) | |
| 1596 | ||
| 1597 | end | |
| 1598 | ||
| 71094 | 1599 | instantiation int :: semiring_bit_shifts | 
| 1600 | begin | |
| 1601 | ||
| 1602 | definition push_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close> | |
| 1603 | where \<open>push_bit_int n k = k * 2 ^ n\<close> | |
| 1604 | ||
| 1605 | definition drop_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close> | |
| 1606 | where \<open>drop_bit_int n k = k div 2 ^ n\<close> | |
| 1607 | ||
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1608 | definition take_bit_int :: \<open>nat \<Rightarrow> int \<Rightarrow> int\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1609 | where \<open>take_bit_int n k = k mod 2 ^ n\<close> | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1610 | |
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1611 | instance | 
| 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1612 | by standard (simp_all add: push_bit_int_def drop_bit_int_def take_bit_int_def) | 
| 71094 | 1613 | |
| 1614 | end | |
| 1615 | ||
| 71412 | 1616 | lemma bit_push_bit_iff_nat: | 
| 1617 | \<open>bit (push_bit m q) n \<longleftrightarrow> m \<le> n \<and> bit q (n - m)\<close> for q :: nat | |
| 71424 | 1618 | by (auto simp add: bit_push_bit_iff) | 
| 71412 | 1619 | |
| 1620 | lemma bit_push_bit_iff_int: | |
| 1621 | \<open>bit (push_bit m k) n \<longleftrightarrow> m \<le> n \<and> bit k (n - m)\<close> for k :: int | |
| 71424 | 1622 | by (auto simp add: bit_push_bit_iff) | 
| 71412 | 1623 | |
| 72262 | 1624 | lemma take_bit_nat_less_exp [simp]: | 
| 72261 | 1625 | \<open>take_bit n m < 2 ^ n\<close> for n m ::nat | 
| 1626 | by (simp add: take_bit_eq_mod) | |
| 1627 | ||
| 72262 | 1628 | lemma take_bit_nonnegative [simp]: | 
| 1629 | \<open>take_bit n k \<ge> 0\<close> for k :: int | |
| 1630 | by (simp add: take_bit_eq_mod) | |
| 1631 | ||
| 1632 | lemma not_take_bit_negative [simp]: | |
| 1633 | \<open>\<not> take_bit n k < 0\<close> for k :: int | |
| 1634 | by (simp add: not_less) | |
| 1635 | ||
| 1636 | lemma take_bit_int_less_exp [simp]: | |
| 1637 | \<open>take_bit n k < 2 ^ n\<close> for k :: int | |
| 1638 | by (simp add: take_bit_eq_mod) | |
| 1639 | ||
| 72261 | 1640 | lemma take_bit_nat_eq_self_iff: | 
| 1641 | \<open>take_bit n m = m \<longleftrightarrow> m < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) | |
| 1642 | for n m :: nat | |
| 1643 | proof | |
| 1644 | assume ?P | |
| 1645 | moreover note take_bit_nat_less_exp [of n m] | |
| 1646 | ultimately show ?Q | |
| 1647 | by simp | |
| 1648 | next | |
| 1649 | assume ?Q | |
| 1650 | then show ?P | |
| 1651 | by (simp add: take_bit_eq_mod) | |
| 1652 | qed | |
| 1653 | ||
| 72262 | 1654 | lemma take_bit_nat_eq_self: | 
| 1655 | \<open>take_bit n m = m\<close> if \<open>m < 2 ^ n\<close> for m n :: nat | |
| 1656 | using that by (simp add: take_bit_nat_eq_self_iff) | |
| 72261 | 1657 | |
| 1658 | lemma take_bit_int_eq_self_iff: | |
| 1659 | \<open>take_bit n k = k \<longleftrightarrow> 0 \<le> k \<and> k < 2 ^ n\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) | |
| 1660 | for k :: int | |
| 1661 | proof | |
| 1662 | assume ?P | |
| 1663 | moreover note take_bit_int_less_exp [of n k] take_bit_nonnegative [of n k] | |
| 1664 | ultimately show ?Q | |
| 1665 | by simp | |
| 1666 | next | |
| 1667 | assume ?Q | |
| 1668 | then show ?P | |
| 1669 | by (simp add: take_bit_eq_mod) | |
| 1670 | qed | |
| 1671 | ||
| 72262 | 1672 | lemma take_bit_int_eq_self: | 
| 1673 | \<open>take_bit n k = k\<close> if \<open>0 \<le> k\<close> \<open>k < 2 ^ n\<close> for k :: int | |
| 1674 | using that by (simp add: take_bit_int_eq_self_iff) | |
| 1675 | ||
| 1676 | lemma take_bit_nat_less_eq_self [simp]: | |
| 1677 | \<open>take_bit n m \<le> m\<close> for n m :: nat | |
| 1678 | by (simp add: take_bit_eq_mod) | |
| 1679 | ||
| 1680 | lemma take_bit_nat_less_self_iff: | |
| 1681 | \<open>take_bit n m < m \<longleftrightarrow> 2 ^ n \<le> m\<close> (is \<open>?P \<longleftrightarrow> ?Q\<close>) | |
| 1682 | for m n :: nat | |
| 1683 | proof | |
| 1684 | assume ?P | |
| 1685 | then have \<open>take_bit n m \<noteq> m\<close> | |
| 1686 | by simp | |
| 1687 | then show \<open>?Q\<close> | |
| 1688 | by (simp add: take_bit_nat_eq_self_iff) | |
| 1689 | next | |
| 1690 | have \<open>take_bit n m < 2 ^ n\<close> | |
| 1691 | by (fact take_bit_nat_less_exp) | |
| 1692 | also assume ?Q | |
| 1693 | finally show ?P . | |
| 1694 | qed | |
| 1695 | ||
| 71094 | 1696 | class unique_euclidean_semiring_with_bit_shifts = | 
| 1697 | unique_euclidean_semiring_with_nat + semiring_bit_shifts | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 1698 | begin | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 1699 | |
| 71138 | 1700 | lemma take_bit_of_exp [simp]: | 
| 1701 | \<open>take_bit m (2 ^ n) = of_bool (n < m) * 2 ^ n\<close> | |
| 1702 | by (simp add: take_bit_eq_mod exp_mod_exp) | |
| 67960 | 1703 | |
| 71138 | 1704 | lemma take_bit_of_2 [simp]: | 
| 1705 | \<open>take_bit n 2 = of_bool (2 \<le> n) * 2\<close> | |
| 1706 | using take_bit_of_exp [of n 1] by simp | |
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1707 | |
| 71412 | 1708 | lemma take_bit_of_mask: | 
| 71408 | 1709 | \<open>take_bit m (2 ^ n - 1) = 2 ^ min m n - 1\<close> | 
| 71412 | 1710 | by (simp add: take_bit_eq_mod mask_mod_exp) | 
| 71408 | 1711 | |
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1712 | lemma push_bit_eq_0_iff [simp]: | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1713 | "push_bit n a = 0 \<longleftrightarrow> a = 0" | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1714 | by (simp add: push_bit_eq_mult) | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1715 | |
| 67961 | 1716 | lemma take_bit_add: | 
| 67907 
02a14c1cb917
prefer convention to place operation name before type name
 haftmann parents: 
67906diff
changeset | 1717 | "take_bit n (take_bit n a + take_bit n b) = take_bit n (a + b)" | 
| 
02a14c1cb917
prefer convention to place operation name before type name
 haftmann parents: 
67906diff
changeset | 1718 | by (simp add: take_bit_eq_mod mod_simps) | 
| 67816 | 1719 | |
| 67907 
02a14c1cb917
prefer convention to place operation name before type name
 haftmann parents: 
67906diff
changeset | 1720 | lemma take_bit_of_1_eq_0_iff [simp]: | 
| 
02a14c1cb917
prefer convention to place operation name before type name
 haftmann parents: 
67906diff
changeset | 1721 | "take_bit n 1 = 0 \<longleftrightarrow> n = 0" | 
| 
02a14c1cb917
prefer convention to place operation name before type name
 haftmann parents: 
67906diff
changeset | 1722 | by (simp add: take_bit_eq_mod) | 
| 67816 | 1723 | |
| 72026 | 1724 | lemma take_bit_Suc_1 [simp]: | 
| 1725 | \<open>take_bit (Suc n) 1 = 1\<close> | |
| 1726 | by (simp add: take_bit_Suc) | |
| 1727 | ||
| 71799 | 1728 | lemma take_bit_Suc_bit0 [simp]: | 
| 1729 | \<open>take_bit (Suc n) (numeral (Num.Bit0 k)) = take_bit n (numeral k) * 2\<close> | |
| 1730 | by (simp add: take_bit_Suc numeral_Bit0_div_2) | |
| 1731 | ||
| 1732 | lemma take_bit_Suc_bit1 [simp]: | |
| 1733 | \<open>take_bit (Suc n) (numeral (Num.Bit1 k)) = take_bit n (numeral k) * 2 + 1\<close> | |
| 71822 | 1734 | by (simp add: take_bit_Suc numeral_Bit1_div_2 mod_2_eq_odd) | 
| 71799 | 1735 | |
| 72026 | 1736 | lemma take_bit_numeral_1 [simp]: | 
| 1737 | \<open>take_bit (numeral l) 1 = 1\<close> | |
| 1738 | by (simp add: take_bit_rec [of \<open>numeral l\<close> 1]) | |
| 1739 | ||
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1740 | lemma take_bit_numeral_bit0 [simp]: | 
| 71799 | 1741 | \<open>take_bit (numeral l) (numeral (Num.Bit0 k)) = take_bit (pred_numeral l) (numeral k) * 2\<close> | 
| 1742 | by (simp add: take_bit_rec numeral_Bit0_div_2) | |
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1743 | |
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1744 | lemma take_bit_numeral_bit1 [simp]: | 
| 71799 | 1745 | \<open>take_bit (numeral l) (numeral (Num.Bit1 k)) = take_bit (pred_numeral l) (numeral k) * 2 + 1\<close> | 
| 71822 | 1746 | by (simp add: take_bit_rec numeral_Bit1_div_2 mod_2_eq_odd) | 
| 67961 | 1747 | |
| 71799 | 1748 | lemma drop_bit_Suc_bit0 [simp]: | 
| 1749 | \<open>drop_bit (Suc n) (numeral (Num.Bit0 k)) = drop_bit n (numeral k)\<close> | |
| 1750 | by (simp add: drop_bit_Suc numeral_Bit0_div_2) | |
| 1751 | ||
| 1752 | lemma drop_bit_Suc_bit1 [simp]: | |
| 1753 | \<open>drop_bit (Suc n) (numeral (Num.Bit1 k)) = drop_bit n (numeral k)\<close> | |
| 1754 | by (simp add: drop_bit_Suc numeral_Bit1_div_2) | |
| 1755 | ||
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1756 | lemma drop_bit_numeral_bit0 [simp]: | 
| 71799 | 1757 | \<open>drop_bit (numeral l) (numeral (Num.Bit0 k)) = drop_bit (pred_numeral l) (numeral k)\<close> | 
| 1758 | by (simp add: drop_bit_rec numeral_Bit0_div_2) | |
| 67816 | 1759 | |
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1760 | lemma drop_bit_numeral_bit1 [simp]: | 
| 71799 | 1761 | \<open>drop_bit (numeral l) (numeral (Num.Bit1 k)) = drop_bit (pred_numeral l) (numeral k)\<close> | 
| 1762 | by (simp add: drop_bit_rec numeral_Bit1_div_2) | |
| 67816 | 1763 | |
| 68010 | 1764 | lemma drop_bit_of_nat: | 
| 1765 | "drop_bit n (of_nat m) = of_nat (drop_bit n m)" | |
| 68389 | 1766 | by (simp add: drop_bit_eq_div Parity.drop_bit_eq_div of_nat_div [of m "2 ^ n"]) | 
| 68010 | 1767 | |
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1768 | lemma bit_of_nat_iff_bit [bit_simps]: | 
| 71412 | 1769 | \<open>bit (of_nat m) n \<longleftrightarrow> bit m n\<close> | 
| 1770 | proof - | |
| 1771 | have \<open>even (m div 2 ^ n) \<longleftrightarrow> even (of_nat (m div 2 ^ n))\<close> | |
| 1772 | by simp | |
| 1773 | also have \<open>of_nat (m div 2 ^ n) = of_nat m div of_nat (2 ^ n)\<close> | |
| 1774 | by (simp add: of_nat_div) | |
| 1775 | finally show ?thesis | |
| 71965 
d45f5d4c41bd
more class operations for the sake of efficient generated code
 haftmann parents: 
71958diff
changeset | 1776 | by (simp add: bit_iff_odd semiring_bits_class.bit_iff_odd) | 
| 71412 | 1777 | qed | 
| 1778 | ||
| 1779 | lemma of_nat_drop_bit: | |
| 1780 | \<open>of_nat (drop_bit m n) = drop_bit m (of_nat n)\<close> | |
| 1781 | by (simp add: drop_bit_eq_div semiring_bit_shifts_class.drop_bit_eq_div of_nat_div) | |
| 1782 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1783 | lemma bit_push_bit_iff_of_nat_iff [bit_simps]: | 
| 71412 | 1784 | \<open>bit (push_bit m (of_nat r)) n \<longleftrightarrow> m \<le> n \<and> bit (of_nat r) (n - m)\<close> | 
| 71424 | 1785 | by (auto simp add: bit_push_bit_iff) | 
| 71412 | 1786 | |
| 58770 | 1787 | end | 
| 67816 | 1788 | |
| 71094 | 1789 | instance nat :: unique_euclidean_semiring_with_bit_shifts .. | 
| 1790 | ||
| 1791 | instance int :: unique_euclidean_semiring_with_bit_shifts .. | |
| 1792 | ||
| 72512 | 1793 | lemma bit_not_int_iff': | 
| 1794 | \<open>bit (- k - 1) n \<longleftrightarrow> \<not> bit k n\<close> | |
| 1795 | for k :: int | |
| 1796 | proof (induction n arbitrary: k) | |
| 1797 | case 0 | |
| 1798 | show ?case | |
| 1799 | by simp | |
| 1800 | next | |
| 1801 | case (Suc n) | |
| 1802 | have \<open>- k - 1 = - (k + 2) + 1\<close> | |
| 1803 | by simp | |
| 1804 | also have \<open>(- (k + 2) + 1) div 2 = - (k div 2) - 1\<close> | |
| 1805 | proof (cases \<open>even k\<close>) | |
| 1806 | case True | |
| 1807 | then have \<open>- k div 2 = - (k div 2)\<close> | |
| 1808 | by rule (simp flip: mult_minus_right) | |
| 1809 | with True show ?thesis | |
| 1810 | by simp | |
| 1811 | next | |
| 1812 | case False | |
| 1813 | have \<open>4 = 2 * (2::int)\<close> | |
| 1814 | by simp | |
| 1815 | also have \<open>2 * 2 div 2 = (2::int)\<close> | |
| 1816 | by (simp only: nonzero_mult_div_cancel_left) | |
| 1817 | finally have *: \<open>4 div 2 = (2::int)\<close> . | |
| 1818 | from False obtain l where k: \<open>k = 2 * l + 1\<close> .. | |
| 1819 | then have \<open>- k - 2 = 2 * - (l + 2) + 1\<close> | |
| 1820 | by simp | |
| 1821 | then have \<open>(- k - 2) div 2 + 1 = - (k div 2) - 1\<close> | |
| 1822 | by (simp flip: mult_minus_right add: *) (simp add: k) | |
| 1823 | with False show ?thesis | |
| 1824 | by simp | |
| 1825 | qed | |
| 1826 | finally have \<open>(- k - 1) div 2 = - (k div 2) - 1\<close> . | |
| 1827 | with Suc show ?case | |
| 1828 | by (simp add: bit_Suc) | |
| 1829 | qed | |
| 1830 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1831 | lemma bit_minus_int_iff [bit_simps]: | 
| 72512 | 1832 | \<open>bit (- k) n \<longleftrightarrow> \<not> bit (k - 1) n\<close> | 
| 1833 | for k :: int | |
| 1834 | using bit_not_int_iff' [of \<open>k - 1\<close>] by simp | |
| 1835 | ||
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1836 | lemma bit_nat_iff [bit_simps]: | 
| 72227 | 1837 | \<open>bit (nat k) n \<longleftrightarrow> k \<ge> 0 \<and> bit k n\<close> | 
| 1838 | proof (cases \<open>k \<ge> 0\<close>) | |
| 71804 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1839 | case True | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1840 | moreover define m where \<open>m = nat k\<close> | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1841 | ultimately have \<open>k = int m\<close> | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1842 | by simp | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1843 | then show ?thesis | 
| 72611 
c7bc3e70a8c7
official collection for bit projection simplifications
 haftmann parents: 
72512diff
changeset | 1844 | by (simp add: bit_simps) | 
| 71804 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1845 | next | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1846 | case False | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1847 | then show ?thesis | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1848 | by simp | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1849 | qed | 
| 
6fd70ed18199
simplified construction of binary bit operations
 haftmann parents: 
71802diff
changeset | 1850 | |
| 72227 | 1851 | lemma push_bit_nat_eq: | 
| 1852 | \<open>push_bit n (nat k) = nat (push_bit n k)\<close> | |
| 1853 | by (cases \<open>k \<ge> 0\<close>) (simp_all add: push_bit_eq_mult nat_mult_distrib not_le mult_nonneg_nonpos2) | |
| 1854 | ||
| 1855 | lemma drop_bit_nat_eq: | |
| 1856 | \<open>drop_bit n (nat k) = nat (drop_bit n k)\<close> | |
| 1857 | apply (cases \<open>k \<ge> 0\<close>) | |
| 1858 | apply (simp_all add: drop_bit_eq_div nat_div_distrib nat_power_eq not_le) | |
| 1859 | apply (simp add: divide_int_def) | |
| 1860 | done | |
| 1861 | ||
| 1862 | lemma take_bit_nat_eq: | |
| 1863 | \<open>take_bit n (nat k) = nat (take_bit n k)\<close> if \<open>k \<ge> 0\<close> | |
| 1864 | using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq) | |
| 1865 | ||
| 72187 | 1866 | lemma nat_take_bit_eq: | 
| 1867 | \<open>nat (take_bit n k) = take_bit n (nat k)\<close> | |
| 1868 | if \<open>k \<ge> 0\<close> | |
| 1869 | using that by (simp add: take_bit_eq_mod nat_mod_distrib nat_power_eq) | |
| 1870 | ||
| 71802 | 1871 | lemma not_exp_less_eq_0_int [simp]: | 
| 1872 | \<open>\<not> 2 ^ n \<le> (0::int)\<close> | |
| 1873 | by (simp add: power_le_zero_eq) | |
| 1874 | ||
| 1875 | lemma half_nonnegative_int_iff [simp]: | |
| 1876 | \<open>k div 2 \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int | |
| 1877 | proof (cases \<open>k \<ge> 0\<close>) | |
| 1878 | case True | |
| 1879 | then show ?thesis | |
| 1880 | by (auto simp add: divide_int_def sgn_1_pos) | |
| 1881 | next | |
| 1882 | case False | |
| 1883 | then show ?thesis | |
| 1884 | apply (auto simp add: divide_int_def not_le elim!: evenE) | |
| 1885 | apply (simp only: minus_mult_right) | |
| 1886 | apply (subst nat_mult_distrib) | |
| 1887 | apply simp_all | |
| 1888 | done | |
| 1889 | qed | |
| 1890 | ||
| 1891 | lemma half_negative_int_iff [simp]: | |
| 1892 | \<open>k div 2 < 0 \<longleftrightarrow> k < 0\<close> for k :: int | |
| 1893 | by (subst Not_eq_iff [symmetric]) (simp add: not_less) | |
| 1894 | ||
| 67988 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1895 | lemma push_bit_of_Suc_0 [simp]: | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1896 | "push_bit n (Suc 0) = 2 ^ n" | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1897 | using push_bit_of_1 [where ?'a = nat] by simp | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1898 | |
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1899 | lemma take_bit_of_Suc_0 [simp]: | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1900 | "take_bit n (Suc 0) = of_bool (0 < n)" | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1901 | using take_bit_of_1 [where ?'a = nat] by simp | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1902 | |
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1903 | lemma drop_bit_of_Suc_0 [simp]: | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1904 | "drop_bit n (Suc 0) = of_bool (n = 0)" | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1905 | using drop_bit_of_1 [where ?'a = nat] by simp | 
| 
01c651412081
explicit simp rules for computing abstract bit operations
 haftmann parents: 
67961diff
changeset | 1906 | |
| 70911 | 1907 | lemma push_bit_minus_one: | 
| 1908 | "push_bit n (- 1 :: int) = - (2 ^ n)" | |
| 1909 | by (simp add: push_bit_eq_mult) | |
| 1910 | ||
| 71195 | 1911 | lemma minus_1_div_exp_eq_int: | 
| 1912 | \<open>- 1 div (2 :: int) ^ n = - 1\<close> | |
| 1913 | by (induction n) (use div_exp_eq [symmetric, of \<open>- 1 :: int\<close> 1] in \<open>simp_all add: ac_simps\<close>) | |
| 1914 | ||
| 1915 | lemma drop_bit_minus_one [simp]: | |
| 1916 | \<open>drop_bit n (- 1 :: int) = - 1\<close> | |
| 1917 | by (simp add: drop_bit_eq_div minus_1_div_exp_eq_int) | |
| 1918 | ||
| 72023 | 1919 | lemma take_bit_Suc_from_most: | 
| 1920 | \<open>take_bit (Suc n) k = 2 ^ n * of_bool (bit k n) + take_bit n k\<close> for k :: int | |
| 1921 | by (simp only: take_bit_eq_mod power_Suc2) (simp_all add: bit_iff_odd odd_iff_mod_2_eq_one zmod_zmult2_eq) | |
| 1922 | ||
| 71424 | 1923 | lemma take_bit_minus: | 
| 71966 | 1924 | \<open>take_bit n (- take_bit n k) = take_bit n (- k)\<close> | 
| 71195 | 1925 | for k :: int | 
| 1926 | by (simp add: take_bit_eq_mod mod_minus_eq) | |
| 1927 | ||
| 71424 | 1928 | lemma take_bit_diff: | 
| 71966 | 1929 | \<open>take_bit n (take_bit n k - take_bit n l) = take_bit n (k - l)\<close> | 
| 71195 | 1930 | for k l :: int | 
| 1931 | by (simp add: take_bit_eq_mod mod_diff_eq) | |
| 1932 | ||
| 72187 | 1933 | lemma bit_imp_take_bit_positive: | 
| 1934 | \<open>0 < take_bit m k\<close> if \<open>n < m\<close> and \<open>bit k n\<close> for k :: int | |
| 1935 | proof (rule ccontr) | |
| 1936 | assume \<open>\<not> 0 < take_bit m k\<close> | |
| 1937 | then have \<open>take_bit m k = 0\<close> | |
| 1938 | by (auto simp add: not_less intro: order_antisym) | |
| 1939 | then have \<open>bit (take_bit m k) n = bit 0 n\<close> | |
| 1940 | by simp | |
| 1941 | with that show False | |
| 1942 | by (simp add: bit_take_bit_iff) | |
| 1943 | qed | |
| 1944 | ||
| 1945 | lemma take_bit_mult: | |
| 1946 | \<open>take_bit n (take_bit n k * take_bit n l) = take_bit n (k * l)\<close> | |
| 1947 | for k l :: int | |
| 1948 | by (simp add: take_bit_eq_mod mod_mult_eq) | |
| 1949 | ||
| 71966 | 1950 | lemma (in ring_1) of_nat_nat_take_bit_eq [simp]: | 
| 1951 | \<open>of_nat (nat (take_bit n k)) = of_int (take_bit n k)\<close> | |
| 1952 | by simp | |
| 1953 | ||
| 71759 | 1954 | lemma take_bit_minus_small_eq: | 
| 1955 | \<open>take_bit n (- k) = 2 ^ n - k\<close> if \<open>0 < k\<close> \<open>k \<le> 2 ^ n\<close> for k :: int | |
| 1956 | proof - | |
| 1957 | define m where \<open>m = nat k\<close> | |
| 1958 | with that have \<open>k = int m\<close> and \<open>0 < m\<close> and \<open>m \<le> 2 ^ n\<close> | |
| 1959 | by simp_all | |
| 1960 | have \<open>(2 ^ n - m) mod 2 ^ n = 2 ^ n - m\<close> | |
| 1961 | using \<open>0 < m\<close> by simp | |
| 1962 | then have \<open>int ((2 ^ n - m) mod 2 ^ n) = int (2 ^ n - m)\<close> | |
| 1963 | by simp | |
| 1964 | then have \<open>(2 ^ n - int m) mod 2 ^ n = 2 ^ n - int m\<close> | |
| 1965 | using \<open>m \<le> 2 ^ n\<close> by (simp only: of_nat_mod of_nat_diff) simp | |
| 1966 | with \<open>k = int m\<close> have \<open>(2 ^ n - k) mod 2 ^ n = 2 ^ n - k\<close> | |
| 1967 | by simp | |
| 1968 | then show ?thesis | |
| 1969 | by (simp add: take_bit_eq_mod) | |
| 1970 | qed | |
| 1971 | ||
| 71424 | 1972 | lemma drop_bit_push_bit_int: | 
| 1973 | \<open>drop_bit m (push_bit n k) = drop_bit (m - n) (push_bit (n - m) k)\<close> for k :: int | |
| 1974 | by (cases \<open>m \<le> n\<close>) (auto simp add: mult.left_commute [of _ \<open>2 ^ n\<close>] mult.commute [of _ \<open>2 ^ n\<close>] mult.assoc | |
| 71802 | 1975 | mult.commute [of k] drop_bit_eq_div push_bit_eq_mult not_le power_add dest!: le_Suc_ex less_imp_Suc_add) | 
| 1976 | ||
| 1977 | lemma push_bit_nonnegative_int_iff [simp]: | |
| 1978 | \<open>push_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int | |
| 1979 | by (simp add: push_bit_eq_mult zero_le_mult_iff) | |
| 1980 | ||
| 1981 | lemma push_bit_negative_int_iff [simp]: | |
| 1982 | \<open>push_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int | |
| 1983 | by (subst Not_eq_iff [symmetric]) (simp add: not_less) | |
| 1984 | ||
| 1985 | lemma drop_bit_nonnegative_int_iff [simp]: | |
| 1986 | \<open>drop_bit n k \<ge> 0 \<longleftrightarrow> k \<ge> 0\<close> for k :: int | |
| 1987 | by (induction n) (simp_all add: drop_bit_Suc drop_bit_half) | |
| 1988 | ||
| 1989 | lemma drop_bit_negative_int_iff [simp]: | |
| 1990 | \<open>drop_bit n k < 0 \<longleftrightarrow> k < 0\<close> for k :: int | |
| 1991 | by (subst Not_eq_iff [symmetric]) (simp add: not_less) | |
| 71424 | 1992 | |
| 71853 | 1993 | code_identifier | 
| 1994 | code_module Parity \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith | |
| 1995 | ||
| 67816 | 1996 | end |