# HG changeset patch # User haftmann # Date 1592471250 0 # Node ID a4bffc0de967913a0973cf4a4d5d49e16bbf3d4c # Parent a9f913d17d00f6aafdef263bcb545a0b9d83a162 bit operations as distinctive library theory diff -r a9f913d17d00 -r a4bffc0de967 CONTRIBUTORS --- a/CONTRIBUTORS Thu Jun 18 09:07:30 2020 +0000 +++ b/CONTRIBUTORS Thu Jun 18 09:07:30 2020 +0000 @@ -6,6 +6,9 @@ Contributions to this Isabelle version -------------------------------------- +* May 2020: Florian Haftmann + HOL-Word bases on library theory of generic bit operations. + Contributions to Isabelle2020 ----------------------------- diff -r a9f913d17d00 -r a4bffc0de967 NEWS --- a/NEWS Thu Jun 18 09:07:30 2020 +0000 +++ b/NEWS Thu Jun 18 09:07:30 2020 +0000 @@ -48,13 +48,18 @@ * For the natural numbers, Sup {} = 0. +* Library theory "Bit_Operations" with generic bit operations. + +* Session HOL-Word: Bit operations are based on library +theory "Bit_Operations". INCOMPATIBILITY. + +* Session HOL-Word: Compound operation "bin_split" simplifies by default +into its components "drop_bit" and "take_bit". INCOMPATIBILITY. + * Session HOL-Word: Operations "bin_last", "bin_rest", "bin_nth", "bintrunc" and "max_word" are now mere input abbreviations. Minor INCOMPATIBILITY. -* Session HOL-Word: Compound operation "bin_split" simplifies by default -into its components "drop_bit" and "take_bit". INCOMPATIBILITY. - *** FOL *** diff -r a9f913d17d00 -r a4bffc0de967 src/HOL/Library/Bit_Operations.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Bit_Operations.thy Thu Jun 18 09:07:30 2020 +0000 @@ -0,0 +1,780 @@ +(* Author: Florian Haftmann, TUM +*) + +section \Bit operations in suitable algebraic structures\ + +theory Bit_Operations + imports + "HOL-Library.Boolean_Algebra" + Main +begin + +subsection \Bit operations\ + +class semiring_bit_operations = semiring_bit_shifts + + fixes "and" :: \'a \ 'a \ 'a\ (infixr \AND\ 64) + and or :: \'a \ 'a \ 'a\ (infixr \OR\ 59) + and xor :: \'a \ 'a \ 'a\ (infixr \XOR\ 59) + assumes bit_and_iff: \\n. bit (a AND b) n \ bit a n \ bit b n\ + and bit_or_iff: \\n. bit (a OR b) n \ bit a n \ bit b n\ + and bit_xor_iff: \\n. bit (a XOR b) n \ bit a n \ bit b n\ +begin + +text \ + We want the bitwise operations to bind slightly weaker + than \+\ and \-\. + For the sake of code generation + the operations \<^const>\and\, \<^const>\or\ and \<^const>\xor\ + are specified as definitional class operations. +\ + +sublocale "and": semilattice \(AND)\ + by standard (auto simp add: bit_eq_iff bit_and_iff) + +sublocale or: semilattice_neutr \(OR)\ 0 + by standard (auto simp add: bit_eq_iff bit_or_iff) + +sublocale xor: comm_monoid \(XOR)\ 0 + by standard (auto simp add: bit_eq_iff bit_xor_iff) + +lemma even_and_iff: + \even (a AND b) \ even a \ even b\ + using bit_and_iff [of a b 0] by auto + +lemma even_or_iff: + \even (a OR b) \ even a \ even b\ + using bit_or_iff [of a b 0] by auto + +lemma even_xor_iff: + \even (a XOR b) \ (even a \ even b)\ + using bit_xor_iff [of a b 0] by auto + +lemma zero_and_eq [simp]: + "0 AND a = 0" + by (simp add: bit_eq_iff bit_and_iff) + +lemma and_zero_eq [simp]: + "a AND 0 = 0" + by (simp add: bit_eq_iff bit_and_iff) + +lemma one_and_eq: + "1 AND a = a mod 2" + by (simp add: bit_eq_iff bit_and_iff) (auto simp add: bit_1_iff) + +lemma and_one_eq: + "a AND 1 = a mod 2" + using one_and_eq [of a] by (simp add: ac_simps) + +lemma one_or_eq: + "1 OR a = a + of_bool (even a)" + by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff) + +lemma or_one_eq: + "a OR 1 = a + of_bool (even a)" + using one_or_eq [of a] by (simp add: ac_simps) + +lemma one_xor_eq: + "1 XOR a = a + of_bool (even a) - of_bool (odd a)" + by (simp add: bit_eq_iff bit_xor_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff odd_bit_iff_bit_pred elim: oddE) + +lemma xor_one_eq: + "a XOR 1 = a + of_bool (even a) - of_bool (odd a)" + using one_xor_eq [of a] by (simp add: ac_simps) + +lemma take_bit_and [simp]: + \take_bit n (a AND b) = take_bit n a AND take_bit n b\ + by (auto simp add: bit_eq_iff bit_take_bit_iff bit_and_iff) + +lemma take_bit_or [simp]: + \take_bit n (a OR b) = take_bit n a OR take_bit n b\ + by (auto simp add: bit_eq_iff bit_take_bit_iff bit_or_iff) + +lemma take_bit_xor [simp]: + \take_bit n (a XOR b) = take_bit n a XOR take_bit n b\ + by (auto simp add: bit_eq_iff bit_take_bit_iff bit_xor_iff) + +definition mask :: \nat \ 'a\ + where mask_eq_exp_minus_1: \mask n = 2 ^ n - 1\ + +lemma bit_mask_iff: + \bit (mask m) n \ 2 ^ n \ 0 \ n < m\ + by (simp add: mask_eq_exp_minus_1 bit_mask_iff) + +lemma even_mask_iff: + \even (mask n) \ n = 0\ + using bit_mask_iff [of n 0] by auto + +lemma mask_0 [simp, code]: + \mask 0 = 0\ + by (simp add: mask_eq_exp_minus_1) + +lemma mask_Suc_exp [code]: + \mask (Suc n) = 2 ^ n OR mask n\ + by (rule bit_eqI) + (auto simp add: bit_or_iff bit_mask_iff bit_exp_iff not_less le_less_Suc_eq) + +lemma mask_Suc_double: + \mask (Suc n) = 2 * mask n OR 1\ +proof (rule bit_eqI) + fix q + assume \2 ^ q \ 0\ + show \bit (mask (Suc n)) q \ bit (2 * mask n OR 1) q\ + by (cases q) + (simp_all add: even_mask_iff even_or_iff bit_or_iff bit_mask_iff bit_exp_iff bit_double_iff not_less le_less_Suc_eq bit_1_iff, auto simp add: mult_2) +qed + +lemma take_bit_eq_mask [code]: + \take_bit n a = a AND mask n\ + by (rule bit_eqI) + (auto simp add: bit_take_bit_iff bit_and_iff bit_mask_iff) + +end + +class ring_bit_operations = semiring_bit_operations + ring_parity + + fixes not :: \'a \ 'a\ (\NOT\) + assumes bit_not_iff: \\n. bit (NOT a) n \ 2 ^ n \ 0 \ \ bit a n\ + assumes minus_eq_not_minus_1: \- a = NOT (a - 1)\ +begin + +text \ + For the sake of code generation \<^const>\not\ is specified as + definitional class operation. Note that \<^const>\not\ has no + sensible definition for unlimited but only positive bit strings + (type \<^typ>\nat\). +\ + +lemma bits_minus_1_mod_2_eq [simp]: + \(- 1) mod 2 = 1\ + by (simp add: mod_2_eq_odd) + +lemma not_eq_complement: + \NOT a = - a - 1\ + using minus_eq_not_minus_1 [of \a + 1\] by simp + +lemma minus_eq_not_plus_1: + \- a = NOT a + 1\ + using not_eq_complement [of a] by simp + +lemma bit_minus_iff: + \bit (- a) n \ 2 ^ n \ 0 \ \ bit (a - 1) n\ + by (simp add: minus_eq_not_minus_1 bit_not_iff) + +lemma even_not_iff [simp]: + "even (NOT a) \ odd a" + using bit_not_iff [of a 0] by auto + +lemma bit_not_exp_iff: + \bit (NOT (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ + by (auto simp add: bit_not_iff bit_exp_iff) + +lemma bit_minus_1_iff [simp]: + \bit (- 1) n \ 2 ^ n \ 0\ + by (simp add: bit_minus_iff) + +lemma bit_minus_exp_iff: + \bit (- (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ + oops + +lemma bit_minus_2_iff [simp]: + \bit (- 2) n \ 2 ^ n \ 0 \ n > 0\ + by (simp add: bit_minus_iff bit_1_iff) + +lemma not_one [simp]: + "NOT 1 = - 2" + by (simp add: bit_eq_iff bit_not_iff) (simp add: bit_1_iff) + +sublocale "and": semilattice_neutr \(AND)\ \- 1\ + apply standard + apply (simp add: bit_eq_iff bit_and_iff) + apply (auto simp add: exp_eq_0_imp_not_bit bit_exp_iff) + done + +sublocale bit: boolean_algebra \(AND)\ \(OR)\ NOT 0 \- 1\ + rewrites \bit.xor = (XOR)\ +proof - + interpret bit: boolean_algebra \(AND)\ \(OR)\ NOT 0 \- 1\ + apply standard + apply (simp_all add: bit_eq_iff bit_and_iff bit_or_iff bit_not_iff) + apply (auto simp add: exp_eq_0_imp_not_bit bit_exp_iff) + done + show \boolean_algebra (AND) (OR) NOT 0 (- 1)\ + by standard + show \boolean_algebra.xor (AND) (OR) NOT = (XOR)\ + apply (auto simp add: fun_eq_iff bit.xor_def bit_eq_iff bit_and_iff bit_or_iff bit_not_iff bit_xor_iff) + apply (simp_all add: bit_exp_iff, simp_all add: bit_def) + apply (metis local.bit_exp_iff local.bits_div_by_0) + apply (metis local.bit_exp_iff local.bits_div_by_0) + done +qed + +lemma and_eq_not_not_or: + \a AND b = NOT (NOT a OR NOT b)\ + by simp + +lemma or_eq_not_not_and: + \a OR b = NOT (NOT a AND NOT b)\ + by simp + +lemma push_bit_minus: + \push_bit n (- a) = - push_bit n a\ + by (simp add: push_bit_eq_mult) + +lemma take_bit_not_take_bit: + \take_bit n (NOT (take_bit n a)) = take_bit n (NOT a)\ + by (auto simp add: bit_eq_iff bit_take_bit_iff bit_not_iff) + +lemma take_bit_not_iff: + "take_bit n (NOT a) = take_bit n (NOT b) \ take_bit n a = take_bit n b" + apply (simp add: bit_eq_iff bit_not_iff bit_take_bit_iff) + apply (simp add: bit_exp_iff) + apply (use local.exp_eq_0_imp_not_bit in blast) + done + +lemma take_bit_minus_one_eq_mask: + \take_bit n (- 1) = mask n\ + by (simp add: bit_eq_iff bit_mask_iff bit_take_bit_iff conj_commute) + +lemma push_bit_minus_one_eq_not_mask: + \push_bit n (- 1) = NOT (mask n)\ +proof (rule bit_eqI) + fix m + assume \2 ^ m \ 0\ + show \bit (push_bit n (- 1)) m \ bit (NOT (mask n)) m\ + proof (cases \n \ m\) + case True + moreover define q where \q = m - n\ + ultimately have \m = n + q\ \m - n = q\ + by simp_all + with \2 ^ m \ 0\ have \2 ^ n * 2 ^ q \ 0\ + by (simp add: power_add) + then have \2 ^ q \ 0\ + using mult_not_zero by blast + with \m - n = q\ show ?thesis + by (auto simp add: bit_not_iff bit_mask_iff bit_push_bit_iff not_less) + next + case False + then show ?thesis + by (simp add: bit_not_iff bit_mask_iff bit_push_bit_iff not_le) + qed +qed + +definition set_bit :: \nat \ 'a \ 'a\ + where \set_bit n a = a OR 2 ^ n\ + +definition unset_bit :: \nat \ 'a \ 'a\ + where \unset_bit n a = a AND NOT (2 ^ n)\ + +definition flip_bit :: \nat \ 'a \ 'a\ + where \flip_bit n a = a XOR 2 ^ n\ + +lemma bit_set_bit_iff: + \bit (set_bit m a) n \ bit a n \ (m = n \ 2 ^ n \ 0)\ + by (auto simp add: set_bit_def bit_or_iff bit_exp_iff) + +lemma even_set_bit_iff: + \even (set_bit m a) \ even a \ m \ 0\ + using bit_set_bit_iff [of m a 0] by auto + +lemma bit_unset_bit_iff: + \bit (unset_bit m a) n \ bit a n \ m \ n\ + by (auto simp add: unset_bit_def bit_and_iff bit_not_iff bit_exp_iff exp_eq_0_imp_not_bit) + +lemma even_unset_bit_iff: + \even (unset_bit m a) \ even a \ m = 0\ + using bit_unset_bit_iff [of m a 0] by auto + +lemma bit_flip_bit_iff: + \bit (flip_bit m a) n \ (m = n \ \ bit a n) \ 2 ^ n \ 0\ + by (auto simp add: flip_bit_def bit_xor_iff bit_exp_iff exp_eq_0_imp_not_bit) + +lemma even_flip_bit_iff: + \even (flip_bit m a) \ \ (even a \ m = 0)\ + using bit_flip_bit_iff [of m a 0] by auto + +lemma set_bit_0 [simp]: + \set_bit 0 a = 1 + 2 * (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + then show \bit (set_bit 0 a) m = bit (1 + 2 * (a div 2)) m\ + by (simp add: bit_set_bit_iff bit_double_iff even_bit_succ_iff) + (cases m, simp_all add: bit_Suc) +qed + +lemma set_bit_Suc: + \set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + show \bit (set_bit (Suc n) a) m \ bit (a mod 2 + 2 * set_bit n (a div 2)) m\ + proof (cases m) + case 0 + then show ?thesis + by (simp add: even_set_bit_iff) + next + case (Suc m) + with * have \2 ^ m \ 0\ + using mult_2 by auto + show ?thesis + by (cases a rule: parity_cases) + (simp_all add: bit_set_bit_iff bit_double_iff even_bit_succ_iff *, + simp_all add: Suc \2 ^ m \ 0\ bit_Suc) + qed +qed + +lemma unset_bit_0 [simp]: + \unset_bit 0 a = 2 * (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + then show \bit (unset_bit 0 a) m = bit (2 * (a div 2)) m\ + by (simp add: bit_unset_bit_iff bit_double_iff) + (cases m, simp_all add: bit_Suc) +qed + +lemma unset_bit_Suc: + \unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + then show \bit (unset_bit (Suc n) a) m \ bit (a mod 2 + 2 * unset_bit n (a div 2)) m\ + proof (cases m) + case 0 + then show ?thesis + by (simp add: even_unset_bit_iff) + next + case (Suc m) + show ?thesis + by (cases a rule: parity_cases) + (simp_all add: bit_unset_bit_iff bit_double_iff even_bit_succ_iff *, + simp_all add: Suc bit_Suc) + qed +qed + +lemma flip_bit_0 [simp]: + \flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + then show \bit (flip_bit 0 a) m = bit (of_bool (even a) + 2 * (a div 2)) m\ + by (simp add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff) + (cases m, simp_all add: bit_Suc) +qed + +lemma flip_bit_Suc: + \flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\ +proof (rule bit_eqI) + fix m + assume *: \2 ^ m \ 0\ + show \bit (flip_bit (Suc n) a) m \ bit (a mod 2 + 2 * flip_bit n (a div 2)) m\ + proof (cases m) + case 0 + then show ?thesis + by (simp add: even_flip_bit_iff) + next + case (Suc m) + with * have \2 ^ m \ 0\ + using mult_2 by auto + show ?thesis + by (cases a rule: parity_cases) + (simp_all add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff, + simp_all add: Suc \2 ^ m \ 0\ bit_Suc) + qed +qed + +end + + +subsection \Instance \<^typ>\int\\ + +instantiation int :: ring_bit_operations +begin + +definition not_int :: \int \ int\ + where \not_int k = - k - 1\ + +lemma not_int_rec: + "NOT k = of_bool (even k) + 2 * NOT (k div 2)" for k :: int + by (auto simp add: not_int_def elim: oddE) + +lemma even_not_iff_int: + \even (NOT k) \ odd k\ for k :: int + by (simp add: not_int_def) + +lemma not_int_div_2: + \NOT k div 2 = NOT (k div 2)\ for k :: int + by (simp add: not_int_def) + +lemma bit_not_int_iff: + \bit (NOT k) n \ \ bit k n\ + for k :: int + by (induction n arbitrary: k) (simp_all add: not_int_div_2 even_not_iff_int bit_Suc) + +function and_int :: \int \ int \ int\ + where \(k::int) AND l = (if k \ {0, - 1} \ l \ {0, - 1} + then - of_bool (odd k \ odd l) + else of_bool (odd k \ odd l) + 2 * ((k div 2) AND (l div 2)))\ + by auto + +termination + by (relation \measure (\(k, l). nat (\k\ + \l\))\) auto + +declare and_int.simps [simp del] + +lemma and_int_rec: + \k AND l = of_bool (odd k \ odd l) + 2 * ((k div 2) AND (l div 2))\ + for k l :: int +proof (cases \k \ {0, - 1} \ l \ {0, - 1}\) + case True + then show ?thesis + by auto (simp_all add: and_int.simps) +next + case False + then show ?thesis + by (auto simp add: ac_simps and_int.simps [of k l]) +qed + +lemma bit_and_int_iff: + \bit (k AND l) n \ bit k n \ bit l n\ for k l :: int +proof (induction n arbitrary: k l) + case 0 + then show ?case + by (simp add: and_int_rec [of k l]) +next + case (Suc n) + then show ?case + by (simp add: and_int_rec [of k l] bit_Suc) +qed + +lemma even_and_iff_int: + \even (k AND l) \ even k \ even l\ for k l :: int + using bit_and_int_iff [of k l 0] by auto + +definition or_int :: \int \ int \ int\ + where \k OR l = NOT (NOT k AND NOT l)\ for k l :: int + +lemma or_int_rec: + \k OR l = of_bool (odd k \ odd l) + 2 * ((k div 2) OR (l div 2))\ + for k l :: int + using and_int_rec [of \NOT k\ \NOT l\] + by (simp add: or_int_def even_not_iff_int not_int_div_2) + (simp add: not_int_def) + +lemma bit_or_int_iff: + \bit (k OR l) n \ bit k n \ bit l n\ for k l :: int + by (simp add: or_int_def bit_not_int_iff bit_and_int_iff) + +definition xor_int :: \int \ int \ int\ + where \k XOR l = k AND NOT l OR NOT k AND l\ for k l :: int + +lemma xor_int_rec: + \k XOR l = of_bool (odd k \ odd l) + 2 * ((k div 2) XOR (l div 2))\ + for k l :: int + by (simp add: xor_int_def or_int_rec [of \k AND NOT l\ \NOT k AND l\] even_and_iff_int even_not_iff_int) + (simp add: and_int_rec [of \NOT k\ \l\] and_int_rec [of \k\ \NOT l\] not_int_div_2) + +lemma bit_xor_int_iff: + \bit (k XOR l) n \ bit k n \ bit l n\ for k l :: int + by (auto simp add: xor_int_def bit_or_int_iff bit_and_int_iff bit_not_int_iff) + +instance proof + fix k l :: int and n :: nat + show \- k = NOT (k - 1)\ + by (simp add: not_int_def) + show \bit (k AND l) n \ bit k n \ bit l n\ + by (fact bit_and_int_iff) + show \bit (k OR l) n \ bit k n \ bit l n\ + by (fact bit_or_int_iff) + show \bit (k XOR l) n \ bit k n \ bit l n\ + by (fact bit_xor_int_iff) +qed (simp_all add: bit_not_int_iff) + +end + +lemma not_nonnegative_int_iff [simp]: + \NOT k \ 0 \ k < 0\ for k :: int + by (simp add: not_int_def) + +lemma not_negative_int_iff [simp]: + \NOT k < 0 \ k \ 0\ for k :: int + by (subst Not_eq_iff [symmetric]) (simp add: not_less not_le) + +lemma and_nonnegative_int_iff [simp]: + \k AND l \ 0 \ k \ 0 \ l \ 0\ for k l :: int +proof (induction k arbitrary: l rule: int_bit_induct) + case zero + then show ?case + by simp +next + case minus + then show ?case + by simp +next + case (even k) + then show ?case + using and_int_rec [of \k * 2\ l] by (simp add: pos_imp_zdiv_nonneg_iff) +next + case (odd k) + from odd have \0 \ k AND l div 2 \ 0 \ k \ 0 \ l div 2\ + by simp + then have \0 \ (1 + k * 2) div 2 AND l div 2 \ 0 \ (1 + k * 2) div 2\ 0 \ l div 2\ + by simp + with and_int_rec [of \1 + k * 2\ l] + show ?case + by auto +qed + +lemma and_negative_int_iff [simp]: + \k AND l < 0 \ k < 0 \ l < 0\ for k l :: int + by (subst Not_eq_iff [symmetric]) (simp add: not_less) + +lemma or_nonnegative_int_iff [simp]: + \k OR l \ 0 \ k \ 0 \ l \ 0\ for k l :: int + by (simp only: or_eq_not_not_and not_nonnegative_int_iff) simp + +lemma or_negative_int_iff [simp]: + \k OR l < 0 \ k < 0 \ l < 0\ for k l :: int + by (subst Not_eq_iff [symmetric]) (simp add: not_less) + +lemma xor_nonnegative_int_iff [simp]: + \k XOR l \ 0 \ (k \ 0 \ l \ 0)\ for k l :: int + by (simp only: bit.xor_def or_nonnegative_int_iff) auto + +lemma xor_negative_int_iff [simp]: + \k XOR l < 0 \ (k < 0) \ (l < 0)\ for k l :: int + by (subst Not_eq_iff [symmetric]) (auto simp add: not_less) + +lemma set_bit_nonnegative_int_iff [simp]: + \set_bit n k \ 0 \ k \ 0\ for k :: int + by (simp add: set_bit_def) + +lemma set_bit_negative_int_iff [simp]: + \set_bit n k < 0 \ k < 0\ for k :: int + by (simp add: set_bit_def) + +lemma unset_bit_nonnegative_int_iff [simp]: + \unset_bit n k \ 0 \ k \ 0\ for k :: int + by (simp add: unset_bit_def) + +lemma unset_bit_negative_int_iff [simp]: + \unset_bit n k < 0 \ k < 0\ for k :: int + by (simp add: unset_bit_def) + +lemma flip_bit_nonnegative_int_iff [simp]: + \flip_bit n k \ 0 \ k \ 0\ for k :: int + by (simp add: flip_bit_def) + +lemma flip_bit_negative_int_iff [simp]: + \flip_bit n k < 0 \ k < 0\ for k :: int + by (simp add: flip_bit_def) + + +subsection \Instance \<^typ>\nat\\ + +instantiation nat :: semiring_bit_operations +begin + +definition and_nat :: \nat \ nat \ nat\ + where \m AND n = nat (int m AND int n)\ for m n :: nat + +definition or_nat :: \nat \ nat \ nat\ + where \m OR n = nat (int m OR int n)\ for m n :: nat + +definition xor_nat :: \nat \ nat \ nat\ + where \m XOR n = nat (int m XOR int n)\ for m n :: nat + +instance proof + fix m n q :: nat + show \bit (m AND n) q \ bit m q \ bit n q\ + by (auto simp add: and_nat_def bit_and_iff less_le bit_eq_iff) + show \bit (m OR n) q \ bit m q \ bit n q\ + by (auto simp add: or_nat_def bit_or_iff less_le bit_eq_iff) + show \bit (m XOR n) q \ bit m q \ bit n q\ + by (auto simp add: xor_nat_def bit_xor_iff less_le bit_eq_iff) +qed + +end + +lemma and_nat_rec: + \m AND n = of_bool (odd m \ odd n) + 2 * ((m div 2) AND (n div 2))\ for m n :: nat + by (simp add: and_nat_def and_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) + +lemma or_nat_rec: + \m OR n = of_bool (odd m \ odd n) + 2 * ((m div 2) OR (n div 2))\ for m n :: nat + by (simp add: or_nat_def or_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) + +lemma xor_nat_rec: + \m XOR n = of_bool (odd m \ odd n) + 2 * ((m div 2) XOR (n div 2))\ for m n :: nat + by (simp add: xor_nat_def xor_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) + +lemma Suc_0_and_eq [simp]: + \Suc 0 AND n = n mod 2\ + using one_and_eq [of n] by simp + +lemma and_Suc_0_eq [simp]: + \n AND Suc 0 = n mod 2\ + using and_one_eq [of n] by simp + +lemma Suc_0_or_eq: + \Suc 0 OR n = n + of_bool (even n)\ + using one_or_eq [of n] by simp + +lemma or_Suc_0_eq: + \n OR Suc 0 = n + of_bool (even n)\ + using or_one_eq [of n] by simp + +lemma Suc_0_xor_eq: + \Suc 0 XOR n = n + of_bool (even n) - of_bool (odd n)\ + using one_xor_eq [of n] by simp + +lemma xor_Suc_0_eq: + \n XOR Suc 0 = n + of_bool (even n) - of_bool (odd n)\ + using xor_one_eq [of n] by simp + + +subsection \Instances for \<^typ>\integer\ and \<^typ>\natural\\ + +unbundle integer.lifting natural.lifting + +context + includes lifting_syntax +begin + +lemma transfer_rule_bit_integer [transfer_rule]: + \((pcr_integer :: int \ integer \ bool) ===> (=)) bit bit\ + by (unfold bit_def) transfer_prover + +lemma transfer_rule_bit_natural [transfer_rule]: + \((pcr_natural :: nat \ natural \ bool) ===> (=)) bit bit\ + by (unfold bit_def) transfer_prover + +end + +instantiation integer :: ring_bit_operations +begin + +lift_definition not_integer :: \integer \ integer\ + is not . + +lift_definition and_integer :: \integer \ integer \ integer\ + is \and\ . + +lift_definition or_integer :: \integer \ integer \ integer\ + is or . + +lift_definition xor_integer :: \integer \ integer \ integer\ + is xor . + +instance proof + fix k l :: \integer\ and n :: nat + show \- k = NOT (k - 1)\ + by transfer (simp add: minus_eq_not_minus_1) + show \bit (NOT k) n \ (2 :: integer) ^ n \ 0 \ \ bit k n\ + by transfer (fact bit_not_iff) + show \bit (k AND l) n \ bit k n \ bit l n\ + by transfer (fact bit_and_iff) + show \bit (k OR l) n \ bit k n \ bit l n\ + by transfer (fact bit_or_iff) + show \bit (k XOR l) n \ bit k n \ bit l n\ + by transfer (fact bit_xor_iff) +qed + +end + +instantiation natural :: semiring_bit_operations +begin + +lift_definition and_natural :: \natural \ natural \ natural\ + is \and\ . + +lift_definition or_natural :: \natural \ natural \ natural\ + is or . + +lift_definition xor_natural :: \natural \ natural \ natural\ + is xor . + +instance proof + fix m n :: \natural\ and q :: nat + show \bit (m AND n) q \ bit m q \ bit n q\ + by transfer (fact bit_and_iff) + show \bit (m OR n) q \ bit m q \ bit n q\ + by transfer (fact bit_or_iff) + show \bit (m XOR n) q \ bit m q \ bit n q\ + by transfer (fact bit_xor_iff) +qed + +end + +lifting_update integer.lifting +lifting_forget integer.lifting + +lifting_update natural.lifting +lifting_forget natural.lifting + + +subsection \Key ideas of bit operations\ + +text \ + When formalizing bit operations, it is tempting to represent + bit values as explicit lists over a binary type. This however + is a bad idea, mainly due to the inherent ambiguities in + representation concerning repeating leading bits. + + Hence this approach avoids such explicit lists altogether + following an algebraic path: + + \<^item> Bit values are represented by numeric types: idealized + unbounded bit values can be represented by type \<^typ>\int\, + bounded bit values by quotient types over \<^typ>\int\. + + \<^item> (A special case are idealized unbounded bit values ending + in @{term [source] 0} which can be represented by type \<^typ>\nat\ but + only support a restricted set of operations). + + \<^item> From this idea follows that + + \<^item> multiplication by \<^term>\2 :: int\ is a bit shift to the left and + + \<^item> division by \<^term>\2 :: int\ is a bit shift to the right. + + \<^item> Concerning bounded bit values, iterated shifts to the left + may result in eliminating all bits by shifting them all + beyond the boundary. The property \<^prop>\(2 :: int) ^ n \ 0\ + represents that \<^term>\n\ is \<^emph>\not\ beyond that boundary. + + \<^item> The projection on a single bit is then @{thm bit_def [where ?'a = int, no_vars]}. + + \<^item> This leads to the most fundamental properties of bit values: + + \<^item> Equality rule: @{thm bit_eqI [where ?'a = int, no_vars]} + + \<^item> Induction rule: @{thm bits_induct [where ?'a = int, no_vars]} + + \<^item> Typical operations are characterized as follows: + + \<^item> Singleton \<^term>\n\th bit: \<^term>\(2 :: int) ^ n\ + + \<^item> Bit mask upto bit \<^term>\n\: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]} + + \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]} + + \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]} + + \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]} + + \<^item> Negation: @{thm bit_not_iff [where ?'a = int, no_vars]} + + \<^item> And: @{thm bit_and_iff [where ?'a = int, no_vars]} + + \<^item> Or: @{thm bit_or_iff [where ?'a = int, no_vars]} + + \<^item> Xor: @{thm bit_xor_iff [where ?'a = int, no_vars]} + + \<^item> Set a single bit: @{thm set_bit_def [where ?'a = int, no_vars]} + + \<^item> Unset a single bit: @{thm unset_bit_def [where ?'a = int, no_vars]} + + \<^item> Flip a single bit: @{thm flip_bit_def [where ?'a = int, no_vars]} +\ + +end diff -r a9f913d17d00 -r a4bffc0de967 src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Thu Jun 18 09:07:30 2020 +0000 +++ b/src/HOL/Library/Library.thy Thu Jun 18 09:07:30 2020 +0000 @@ -1,9 +1,10 @@ -(*<*) + (*<*) theory Library imports AList Adhoc_Overloading BigO + Bit_Operations BNF_Axiomatization BNF_Corec Boolean_Algebra diff -r a9f913d17d00 -r a4bffc0de967 src/HOL/ex/Bit_Operations.thy --- a/src/HOL/ex/Bit_Operations.thy Thu Jun 18 09:07:30 2020 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,780 +0,0 @@ -(* Author: Florian Haftmann, TUM -*) - -section \Proof of concept for purely algebraically founded lists of bits\ - -theory Bit_Operations - imports - "HOL-Library.Boolean_Algebra" - Main -begin - -subsection \Bit operations in suitable algebraic structures\ - -class semiring_bit_operations = semiring_bit_shifts + - fixes "and" :: \'a \ 'a \ 'a\ (infixr \AND\ 64) - and or :: \'a \ 'a \ 'a\ (infixr \OR\ 59) - and xor :: \'a \ 'a \ 'a\ (infixr \XOR\ 59) - assumes bit_and_iff: \\n. bit (a AND b) n \ bit a n \ bit b n\ - and bit_or_iff: \\n. bit (a OR b) n \ bit a n \ bit b n\ - and bit_xor_iff: \\n. bit (a XOR b) n \ bit a n \ bit b n\ -begin - -text \ - We want the bitwise operations to bind slightly weaker - than \+\ and \-\. - For the sake of code generation - the operations \<^const>\and\, \<^const>\or\ and \<^const>\xor\ - are specified as definitional class operations. -\ - -sublocale "and": semilattice \(AND)\ - by standard (auto simp add: bit_eq_iff bit_and_iff) - -sublocale or: semilattice_neutr \(OR)\ 0 - by standard (auto simp add: bit_eq_iff bit_or_iff) - -sublocale xor: comm_monoid \(XOR)\ 0 - by standard (auto simp add: bit_eq_iff bit_xor_iff) - -lemma even_and_iff: - \even (a AND b) \ even a \ even b\ - using bit_and_iff [of a b 0] by auto - -lemma even_or_iff: - \even (a OR b) \ even a \ even b\ - using bit_or_iff [of a b 0] by auto - -lemma even_xor_iff: - \even (a XOR b) \ (even a \ even b)\ - using bit_xor_iff [of a b 0] by auto - -lemma zero_and_eq [simp]: - "0 AND a = 0" - by (simp add: bit_eq_iff bit_and_iff) - -lemma and_zero_eq [simp]: - "a AND 0 = 0" - by (simp add: bit_eq_iff bit_and_iff) - -lemma one_and_eq: - "1 AND a = a mod 2" - by (simp add: bit_eq_iff bit_and_iff) (auto simp add: bit_1_iff) - -lemma and_one_eq: - "a AND 1 = a mod 2" - using one_and_eq [of a] by (simp add: ac_simps) - -lemma one_or_eq: - "1 OR a = a + of_bool (even a)" - by (simp add: bit_eq_iff bit_or_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff) - -lemma or_one_eq: - "a OR 1 = a + of_bool (even a)" - using one_or_eq [of a] by (simp add: ac_simps) - -lemma one_xor_eq: - "1 XOR a = a + of_bool (even a) - of_bool (odd a)" - by (simp add: bit_eq_iff bit_xor_iff add.commute [of _ 1] even_bit_succ_iff) (auto simp add: bit_1_iff odd_bit_iff_bit_pred elim: oddE) - -lemma xor_one_eq: - "a XOR 1 = a + of_bool (even a) - of_bool (odd a)" - using one_xor_eq [of a] by (simp add: ac_simps) - -lemma take_bit_and [simp]: - \take_bit n (a AND b) = take_bit n a AND take_bit n b\ - by (auto simp add: bit_eq_iff bit_take_bit_iff bit_and_iff) - -lemma take_bit_or [simp]: - \take_bit n (a OR b) = take_bit n a OR take_bit n b\ - by (auto simp add: bit_eq_iff bit_take_bit_iff bit_or_iff) - -lemma take_bit_xor [simp]: - \take_bit n (a XOR b) = take_bit n a XOR take_bit n b\ - by (auto simp add: bit_eq_iff bit_take_bit_iff bit_xor_iff) - -definition mask :: \nat \ 'a\ - where mask_eq_exp_minus_1: \mask n = 2 ^ n - 1\ - -lemma bit_mask_iff: - \bit (mask m) n \ 2 ^ n \ 0 \ n < m\ - by (simp add: mask_eq_exp_minus_1 bit_mask_iff) - -lemma even_mask_iff: - \even (mask n) \ n = 0\ - using bit_mask_iff [of n 0] by auto - -lemma mask_0 [simp, code]: - \mask 0 = 0\ - by (simp add: mask_eq_exp_minus_1) - -lemma mask_Suc_exp [code]: - \mask (Suc n) = 2 ^ n OR mask n\ - by (rule bit_eqI) - (auto simp add: bit_or_iff bit_mask_iff bit_exp_iff not_less le_less_Suc_eq) - -lemma mask_Suc_double: - \mask (Suc n) = 2 * mask n OR 1\ -proof (rule bit_eqI) - fix q - assume \2 ^ q \ 0\ - show \bit (mask (Suc n)) q \ bit (2 * mask n OR 1) q\ - by (cases q) - (simp_all add: even_mask_iff even_or_iff bit_or_iff bit_mask_iff bit_exp_iff bit_double_iff not_less le_less_Suc_eq bit_1_iff, auto simp add: mult_2) -qed - -lemma take_bit_eq_mask [code]: - \take_bit n a = a AND mask n\ - by (rule bit_eqI) - (auto simp add: bit_take_bit_iff bit_and_iff bit_mask_iff) - -end - -class ring_bit_operations = semiring_bit_operations + ring_parity + - fixes not :: \'a \ 'a\ (\NOT\) - assumes bit_not_iff: \\n. bit (NOT a) n \ 2 ^ n \ 0 \ \ bit a n\ - assumes minus_eq_not_minus_1: \- a = NOT (a - 1)\ -begin - -text \ - For the sake of code generation \<^const>\not\ is specified as - definitional class operation. Note that \<^const>\not\ has no - sensible definition for unlimited but only positive bit strings - (type \<^typ>\nat\). -\ - -lemma bits_minus_1_mod_2_eq [simp]: - \(- 1) mod 2 = 1\ - by (simp add: mod_2_eq_odd) - -lemma not_eq_complement: - \NOT a = - a - 1\ - using minus_eq_not_minus_1 [of \a + 1\] by simp - -lemma minus_eq_not_plus_1: - \- a = NOT a + 1\ - using not_eq_complement [of a] by simp - -lemma bit_minus_iff: - \bit (- a) n \ 2 ^ n \ 0 \ \ bit (a - 1) n\ - by (simp add: minus_eq_not_minus_1 bit_not_iff) - -lemma even_not_iff [simp]: - "even (NOT a) \ odd a" - using bit_not_iff [of a 0] by auto - -lemma bit_not_exp_iff: - \bit (NOT (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ - by (auto simp add: bit_not_iff bit_exp_iff) - -lemma bit_minus_1_iff [simp]: - \bit (- 1) n \ 2 ^ n \ 0\ - by (simp add: bit_minus_iff) - -lemma bit_minus_exp_iff: - \bit (- (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ - oops - -lemma bit_minus_2_iff [simp]: - \bit (- 2) n \ 2 ^ n \ 0 \ n > 0\ - by (simp add: bit_minus_iff bit_1_iff) - -lemma not_one [simp]: - "NOT 1 = - 2" - by (simp add: bit_eq_iff bit_not_iff) (simp add: bit_1_iff) - -sublocale "and": semilattice_neutr \(AND)\ \- 1\ - apply standard - apply (simp add: bit_eq_iff bit_and_iff) - apply (auto simp add: exp_eq_0_imp_not_bit bit_exp_iff) - done - -sublocale bit: boolean_algebra \(AND)\ \(OR)\ NOT 0 \- 1\ - rewrites \bit.xor = (XOR)\ -proof - - interpret bit: boolean_algebra \(AND)\ \(OR)\ NOT 0 \- 1\ - apply standard - apply (simp_all add: bit_eq_iff bit_and_iff bit_or_iff bit_not_iff) - apply (auto simp add: exp_eq_0_imp_not_bit bit_exp_iff) - done - show \boolean_algebra (AND) (OR) NOT 0 (- 1)\ - by standard - show \boolean_algebra.xor (AND) (OR) NOT = (XOR)\ - apply (auto simp add: fun_eq_iff bit.xor_def bit_eq_iff bit_and_iff bit_or_iff bit_not_iff bit_xor_iff) - apply (simp_all add: bit_exp_iff, simp_all add: bit_def) - apply (metis local.bit_exp_iff local.bits_div_by_0) - apply (metis local.bit_exp_iff local.bits_div_by_0) - done -qed - -lemma and_eq_not_not_or: - \a AND b = NOT (NOT a OR NOT b)\ - by simp - -lemma or_eq_not_not_and: - \a OR b = NOT (NOT a AND NOT b)\ - by simp - -lemma push_bit_minus: - \push_bit n (- a) = - push_bit n a\ - by (simp add: push_bit_eq_mult) - -lemma take_bit_not_take_bit: - \take_bit n (NOT (take_bit n a)) = take_bit n (NOT a)\ - by (auto simp add: bit_eq_iff bit_take_bit_iff bit_not_iff) - -lemma take_bit_not_iff: - "take_bit n (NOT a) = take_bit n (NOT b) \ take_bit n a = take_bit n b" - apply (simp add: bit_eq_iff bit_not_iff bit_take_bit_iff) - apply (simp add: bit_exp_iff) - apply (use local.exp_eq_0_imp_not_bit in blast) - done - -lemma take_bit_minus_one_eq_mask: - \take_bit n (- 1) = mask n\ - by (simp add: bit_eq_iff bit_mask_iff bit_take_bit_iff conj_commute) - -lemma push_bit_minus_one_eq_not_mask: - \push_bit n (- 1) = NOT (mask n)\ -proof (rule bit_eqI) - fix m - assume \2 ^ m \ 0\ - show \bit (push_bit n (- 1)) m \ bit (NOT (mask n)) m\ - proof (cases \n \ m\) - case True - moreover define q where \q = m - n\ - ultimately have \m = n + q\ \m - n = q\ - by simp_all - with \2 ^ m \ 0\ have \2 ^ n * 2 ^ q \ 0\ - by (simp add: power_add) - then have \2 ^ q \ 0\ - using mult_not_zero by blast - with \m - n = q\ show ?thesis - by (auto simp add: bit_not_iff bit_mask_iff bit_push_bit_iff not_less) - next - case False - then show ?thesis - by (simp add: bit_not_iff bit_mask_iff bit_push_bit_iff not_le) - qed -qed - -definition set_bit :: \nat \ 'a \ 'a\ - where \set_bit n a = a OR 2 ^ n\ - -definition unset_bit :: \nat \ 'a \ 'a\ - where \unset_bit n a = a AND NOT (2 ^ n)\ - -definition flip_bit :: \nat \ 'a \ 'a\ - where \flip_bit n a = a XOR 2 ^ n\ - -lemma bit_set_bit_iff: - \bit (set_bit m a) n \ bit a n \ (m = n \ 2 ^ n \ 0)\ - by (auto simp add: set_bit_def bit_or_iff bit_exp_iff) - -lemma even_set_bit_iff: - \even (set_bit m a) \ even a \ m \ 0\ - using bit_set_bit_iff [of m a 0] by auto - -lemma bit_unset_bit_iff: - \bit (unset_bit m a) n \ bit a n \ m \ n\ - by (auto simp add: unset_bit_def bit_and_iff bit_not_iff bit_exp_iff exp_eq_0_imp_not_bit) - -lemma even_unset_bit_iff: - \even (unset_bit m a) \ even a \ m = 0\ - using bit_unset_bit_iff [of m a 0] by auto - -lemma bit_flip_bit_iff: - \bit (flip_bit m a) n \ (m = n \ \ bit a n) \ 2 ^ n \ 0\ - by (auto simp add: flip_bit_def bit_xor_iff bit_exp_iff exp_eq_0_imp_not_bit) - -lemma even_flip_bit_iff: - \even (flip_bit m a) \ \ (even a \ m = 0)\ - using bit_flip_bit_iff [of m a 0] by auto - -lemma set_bit_0 [simp]: - \set_bit 0 a = 1 + 2 * (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - then show \bit (set_bit 0 a) m = bit (1 + 2 * (a div 2)) m\ - by (simp add: bit_set_bit_iff bit_double_iff even_bit_succ_iff) - (cases m, simp_all add: bit_Suc) -qed - -lemma set_bit_Suc: - \set_bit (Suc n) a = a mod 2 + 2 * set_bit n (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - show \bit (set_bit (Suc n) a) m \ bit (a mod 2 + 2 * set_bit n (a div 2)) m\ - proof (cases m) - case 0 - then show ?thesis - by (simp add: even_set_bit_iff) - next - case (Suc m) - with * have \2 ^ m \ 0\ - using mult_2 by auto - show ?thesis - by (cases a rule: parity_cases) - (simp_all add: bit_set_bit_iff bit_double_iff even_bit_succ_iff *, - simp_all add: Suc \2 ^ m \ 0\ bit_Suc) - qed -qed - -lemma unset_bit_0 [simp]: - \unset_bit 0 a = 2 * (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - then show \bit (unset_bit 0 a) m = bit (2 * (a div 2)) m\ - by (simp add: bit_unset_bit_iff bit_double_iff) - (cases m, simp_all add: bit_Suc) -qed - -lemma unset_bit_Suc: - \unset_bit (Suc n) a = a mod 2 + 2 * unset_bit n (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - then show \bit (unset_bit (Suc n) a) m \ bit (a mod 2 + 2 * unset_bit n (a div 2)) m\ - proof (cases m) - case 0 - then show ?thesis - by (simp add: even_unset_bit_iff) - next - case (Suc m) - show ?thesis - by (cases a rule: parity_cases) - (simp_all add: bit_unset_bit_iff bit_double_iff even_bit_succ_iff *, - simp_all add: Suc bit_Suc) - qed -qed - -lemma flip_bit_0 [simp]: - \flip_bit 0 a = of_bool (even a) + 2 * (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - then show \bit (flip_bit 0 a) m = bit (of_bool (even a) + 2 * (a div 2)) m\ - by (simp add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff) - (cases m, simp_all add: bit_Suc) -qed - -lemma flip_bit_Suc: - \flip_bit (Suc n) a = a mod 2 + 2 * flip_bit n (a div 2)\ -proof (rule bit_eqI) - fix m - assume *: \2 ^ m \ 0\ - show \bit (flip_bit (Suc n) a) m \ bit (a mod 2 + 2 * flip_bit n (a div 2)) m\ - proof (cases m) - case 0 - then show ?thesis - by (simp add: even_flip_bit_iff) - next - case (Suc m) - with * have \2 ^ m \ 0\ - using mult_2 by auto - show ?thesis - by (cases a rule: parity_cases) - (simp_all add: bit_flip_bit_iff bit_double_iff even_bit_succ_iff, - simp_all add: Suc \2 ^ m \ 0\ bit_Suc) - qed -qed - -end - - -subsubsection \Instance \<^typ>\int\\ - -instantiation int :: ring_bit_operations -begin - -definition not_int :: \int \ int\ - where \not_int k = - k - 1\ - -lemma not_int_rec: - "NOT k = of_bool (even k) + 2 * NOT (k div 2)" for k :: int - by (auto simp add: not_int_def elim: oddE) - -lemma even_not_iff_int: - \even (NOT k) \ odd k\ for k :: int - by (simp add: not_int_def) - -lemma not_int_div_2: - \NOT k div 2 = NOT (k div 2)\ for k :: int - by (simp add: not_int_def) - -lemma bit_not_int_iff: - \bit (NOT k) n \ \ bit k n\ - for k :: int - by (induction n arbitrary: k) (simp_all add: not_int_div_2 even_not_iff_int bit_Suc) - -function and_int :: \int \ int \ int\ - where \(k::int) AND l = (if k \ {0, - 1} \ l \ {0, - 1} - then - of_bool (odd k \ odd l) - else of_bool (odd k \ odd l) + 2 * ((k div 2) AND (l div 2)))\ - by auto - -termination - by (relation \measure (\(k, l). nat (\k\ + \l\))\) auto - -declare and_int.simps [simp del] - -lemma and_int_rec: - \k AND l = of_bool (odd k \ odd l) + 2 * ((k div 2) AND (l div 2))\ - for k l :: int -proof (cases \k \ {0, - 1} \ l \ {0, - 1}\) - case True - then show ?thesis - by auto (simp_all add: and_int.simps) -next - case False - then show ?thesis - by (auto simp add: ac_simps and_int.simps [of k l]) -qed - -lemma bit_and_int_iff: - \bit (k AND l) n \ bit k n \ bit l n\ for k l :: int -proof (induction n arbitrary: k l) - case 0 - then show ?case - by (simp add: and_int_rec [of k l]) -next - case (Suc n) - then show ?case - by (simp add: and_int_rec [of k l] bit_Suc) -qed - -lemma even_and_iff_int: - \even (k AND l) \ even k \ even l\ for k l :: int - using bit_and_int_iff [of k l 0] by auto - -definition or_int :: \int \ int \ int\ - where \k OR l = NOT (NOT k AND NOT l)\ for k l :: int - -lemma or_int_rec: - \k OR l = of_bool (odd k \ odd l) + 2 * ((k div 2) OR (l div 2))\ - for k l :: int - using and_int_rec [of \NOT k\ \NOT l\] - by (simp add: or_int_def even_not_iff_int not_int_div_2) - (simp add: not_int_def) - -lemma bit_or_int_iff: - \bit (k OR l) n \ bit k n \ bit l n\ for k l :: int - by (simp add: or_int_def bit_not_int_iff bit_and_int_iff) - -definition xor_int :: \int \ int \ int\ - where \k XOR l = k AND NOT l OR NOT k AND l\ for k l :: int - -lemma xor_int_rec: - \k XOR l = of_bool (odd k \ odd l) + 2 * ((k div 2) XOR (l div 2))\ - for k l :: int - by (simp add: xor_int_def or_int_rec [of \k AND NOT l\ \NOT k AND l\] even_and_iff_int even_not_iff_int) - (simp add: and_int_rec [of \NOT k\ \l\] and_int_rec [of \k\ \NOT l\] not_int_div_2) - -lemma bit_xor_int_iff: - \bit (k XOR l) n \ bit k n \ bit l n\ for k l :: int - by (auto simp add: xor_int_def bit_or_int_iff bit_and_int_iff bit_not_int_iff) - -instance proof - fix k l :: int and n :: nat - show \- k = NOT (k - 1)\ - by (simp add: not_int_def) - show \bit (k AND l) n \ bit k n \ bit l n\ - by (fact bit_and_int_iff) - show \bit (k OR l) n \ bit k n \ bit l n\ - by (fact bit_or_int_iff) - show \bit (k XOR l) n \ bit k n \ bit l n\ - by (fact bit_xor_int_iff) -qed (simp_all add: bit_not_int_iff) - -end - -lemma not_nonnegative_int_iff [simp]: - \NOT k \ 0 \ k < 0\ for k :: int - by (simp add: not_int_def) - -lemma not_negative_int_iff [simp]: - \NOT k < 0 \ k \ 0\ for k :: int - by (subst Not_eq_iff [symmetric]) (simp add: not_less not_le) - -lemma and_nonnegative_int_iff [simp]: - \k AND l \ 0 \ k \ 0 \ l \ 0\ for k l :: int -proof (induction k arbitrary: l rule: int_bit_induct) - case zero - then show ?case - by simp -next - case minus - then show ?case - by simp -next - case (even k) - then show ?case - using and_int_rec [of \k * 2\ l] by (simp add: pos_imp_zdiv_nonneg_iff) -next - case (odd k) - from odd have \0 \ k AND l div 2 \ 0 \ k \ 0 \ l div 2\ - by simp - then have \0 \ (1 + k * 2) div 2 AND l div 2 \ 0 \ (1 + k * 2) div 2\ 0 \ l div 2\ - by simp - with and_int_rec [of \1 + k * 2\ l] - show ?case - by auto -qed - -lemma and_negative_int_iff [simp]: - \k AND l < 0 \ k < 0 \ l < 0\ for k l :: int - by (subst Not_eq_iff [symmetric]) (simp add: not_less) - -lemma or_nonnegative_int_iff [simp]: - \k OR l \ 0 \ k \ 0 \ l \ 0\ for k l :: int - by (simp only: or_eq_not_not_and not_nonnegative_int_iff) simp - -lemma or_negative_int_iff [simp]: - \k OR l < 0 \ k < 0 \ l < 0\ for k l :: int - by (subst Not_eq_iff [symmetric]) (simp add: not_less) - -lemma xor_nonnegative_int_iff [simp]: - \k XOR l \ 0 \ (k \ 0 \ l \ 0)\ for k l :: int - by (simp only: bit.xor_def or_nonnegative_int_iff) auto - -lemma xor_negative_int_iff [simp]: - \k XOR l < 0 \ (k < 0) \ (l < 0)\ for k l :: int - by (subst Not_eq_iff [symmetric]) (auto simp add: not_less) - -lemma set_bit_nonnegative_int_iff [simp]: - \set_bit n k \ 0 \ k \ 0\ for k :: int - by (simp add: set_bit_def) - -lemma set_bit_negative_int_iff [simp]: - \set_bit n k < 0 \ k < 0\ for k :: int - by (simp add: set_bit_def) - -lemma unset_bit_nonnegative_int_iff [simp]: - \unset_bit n k \ 0 \ k \ 0\ for k :: int - by (simp add: unset_bit_def) - -lemma unset_bit_negative_int_iff [simp]: - \unset_bit n k < 0 \ k < 0\ for k :: int - by (simp add: unset_bit_def) - -lemma flip_bit_nonnegative_int_iff [simp]: - \flip_bit n k \ 0 \ k \ 0\ for k :: int - by (simp add: flip_bit_def) - -lemma flip_bit_negative_int_iff [simp]: - \flip_bit n k < 0 \ k < 0\ for k :: int - by (simp add: flip_bit_def) - - -subsubsection \Instance \<^typ>\nat\\ - -instantiation nat :: semiring_bit_operations -begin - -definition and_nat :: \nat \ nat \ nat\ - where \m AND n = nat (int m AND int n)\ for m n :: nat - -definition or_nat :: \nat \ nat \ nat\ - where \m OR n = nat (int m OR int n)\ for m n :: nat - -definition xor_nat :: \nat \ nat \ nat\ - where \m XOR n = nat (int m XOR int n)\ for m n :: nat - -instance proof - fix m n q :: nat - show \bit (m AND n) q \ bit m q \ bit n q\ - by (auto simp add: and_nat_def bit_and_iff less_le bit_eq_iff) - show \bit (m OR n) q \ bit m q \ bit n q\ - by (auto simp add: or_nat_def bit_or_iff less_le bit_eq_iff) - show \bit (m XOR n) q \ bit m q \ bit n q\ - by (auto simp add: xor_nat_def bit_xor_iff less_le bit_eq_iff) -qed - -end - -lemma and_nat_rec: - \m AND n = of_bool (odd m \ odd n) + 2 * ((m div 2) AND (n div 2))\ for m n :: nat - by (simp add: and_nat_def and_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) - -lemma or_nat_rec: - \m OR n = of_bool (odd m \ odd n) + 2 * ((m div 2) OR (n div 2))\ for m n :: nat - by (simp add: or_nat_def or_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) - -lemma xor_nat_rec: - \m XOR n = of_bool (odd m \ odd n) + 2 * ((m div 2) XOR (n div 2))\ for m n :: nat - by (simp add: xor_nat_def xor_int_rec [of \int m\ \int n\] zdiv_int nat_add_distrib nat_mult_distrib) - -lemma Suc_0_and_eq [simp]: - \Suc 0 AND n = n mod 2\ - using one_and_eq [of n] by simp - -lemma and_Suc_0_eq [simp]: - \n AND Suc 0 = n mod 2\ - using and_one_eq [of n] by simp - -lemma Suc_0_or_eq: - \Suc 0 OR n = n + of_bool (even n)\ - using one_or_eq [of n] by simp - -lemma or_Suc_0_eq: - \n OR Suc 0 = n + of_bool (even n)\ - using or_one_eq [of n] by simp - -lemma Suc_0_xor_eq: - \Suc 0 XOR n = n + of_bool (even n) - of_bool (odd n)\ - using one_xor_eq [of n] by simp - -lemma xor_Suc_0_eq: - \n XOR Suc 0 = n + of_bool (even n) - of_bool (odd n)\ - using xor_one_eq [of n] by simp - - -subsubsection \Instances for \<^typ>\integer\ and \<^typ>\natural\\ - -unbundle integer.lifting natural.lifting - -context - includes lifting_syntax -begin - -lemma transfer_rule_bit_integer [transfer_rule]: - \((pcr_integer :: int \ integer \ bool) ===> (=)) bit bit\ - by (unfold bit_def) transfer_prover - -lemma transfer_rule_bit_natural [transfer_rule]: - \((pcr_natural :: nat \ natural \ bool) ===> (=)) bit bit\ - by (unfold bit_def) transfer_prover - -end - -instantiation integer :: ring_bit_operations -begin - -lift_definition not_integer :: \integer \ integer\ - is not . - -lift_definition and_integer :: \integer \ integer \ integer\ - is \and\ . - -lift_definition or_integer :: \integer \ integer \ integer\ - is or . - -lift_definition xor_integer :: \integer \ integer \ integer\ - is xor . - -instance proof - fix k l :: \integer\ and n :: nat - show \- k = NOT (k - 1)\ - by transfer (simp add: minus_eq_not_minus_1) - show \bit (NOT k) n \ (2 :: integer) ^ n \ 0 \ \ bit k n\ - by transfer (fact bit_not_iff) - show \bit (k AND l) n \ bit k n \ bit l n\ - by transfer (fact bit_and_iff) - show \bit (k OR l) n \ bit k n \ bit l n\ - by transfer (fact bit_or_iff) - show \bit (k XOR l) n \ bit k n \ bit l n\ - by transfer (fact bit_xor_iff) -qed - -end - -instantiation natural :: semiring_bit_operations -begin - -lift_definition and_natural :: \natural \ natural \ natural\ - is \and\ . - -lift_definition or_natural :: \natural \ natural \ natural\ - is or . - -lift_definition xor_natural :: \natural \ natural \ natural\ - is xor . - -instance proof - fix m n :: \natural\ and q :: nat - show \bit (m AND n) q \ bit m q \ bit n q\ - by transfer (fact bit_and_iff) - show \bit (m OR n) q \ bit m q \ bit n q\ - by transfer (fact bit_or_iff) - show \bit (m XOR n) q \ bit m q \ bit n q\ - by transfer (fact bit_xor_iff) -qed - -end - -lifting_update integer.lifting -lifting_forget integer.lifting - -lifting_update natural.lifting -lifting_forget natural.lifting - - -subsection \Key ideas of bit operations\ - -text \ - When formalizing bit operations, it is tempting to represent - bit values as explicit lists over a binary type. This however - is a bad idea, mainly due to the inherent ambiguities in - representation concerning repeating leading bits. - - Hence this approach avoids such explicit lists altogether - following an algebraic path: - - \<^item> Bit values are represented by numeric types: idealized - unbounded bit values can be represented by type \<^typ>\int\, - bounded bit values by quotient types over \<^typ>\int\. - - \<^item> (A special case are idealized unbounded bit values ending - in @{term [source] 0} which can be represented by type \<^typ>\nat\ but - only support a restricted set of operations). - - \<^item> From this idea follows that - - \<^item> multiplication by \<^term>\2 :: int\ is a bit shift to the left and - - \<^item> division by \<^term>\2 :: int\ is a bit shift to the right. - - \<^item> Concerning bounded bit values, iterated shifts to the left - may result in eliminating all bits by shifting them all - beyond the boundary. The property \<^prop>\(2 :: int) ^ n \ 0\ - represents that \<^term>\n\ is \<^emph>\not\ beyond that boundary. - - \<^item> The projection on a single bit is then @{thm bit_def [where ?'a = int, no_vars]}. - - \<^item> This leads to the most fundamental properties of bit values: - - \<^item> Equality rule: @{thm bit_eqI [where ?'a = int, no_vars]} - - \<^item> Induction rule: @{thm bits_induct [where ?'a = int, no_vars]} - - \<^item> Typical operations are characterized as follows: - - \<^item> Singleton \<^term>\n\th bit: \<^term>\(2 :: int) ^ n\ - - \<^item> Bit mask upto bit \<^term>\n\: @{thm mask_eq_exp_minus_1 [where ?'a = int, no_vars]}} - - \<^item> Left shift: @{thm push_bit_eq_mult [where ?'a = int, no_vars]} - - \<^item> Right shift: @{thm drop_bit_eq_div [where ?'a = int, no_vars]} - - \<^item> Truncation: @{thm take_bit_eq_mod [where ?'a = int, no_vars]} - - \<^item> Negation: @{thm bit_not_iff [where ?'a = int, no_vars]} - - \<^item> And: @{thm bit_and_iff [where ?'a = int, no_vars]} - - \<^item> Or: @{thm bit_or_iff [where ?'a = int, no_vars]} - - \<^item> Xor: @{thm bit_xor_iff [where ?'a = int, no_vars]} - - \<^item> Set a single bit: @{thm set_bit_def [where ?'a = int, no_vars]} - - \<^item> Unset a single bit: @{thm unset_bit_def [where ?'a = int, no_vars]} - - \<^item> Flip a single bit: @{thm flip_bit_def [where ?'a = int, no_vars]} -\ - -end diff -r a9f913d17d00 -r a4bffc0de967 src/HOL/ex/Word.thy --- a/src/HOL/ex/Word.thy Thu Jun 18 09:07:30 2020 +0000 +++ b/src/HOL/ex/Word.thy Thu Jun 18 09:07:30 2020 +0000 @@ -7,7 +7,7 @@ imports Main "HOL-Library.Type_Length" - "HOL-ex.Bit_Operations" + "HOL-Library.Bit_Operations" begin subsection \Preliminaries\