# HG changeset patch # User haftmann # Date 1620839129 0 # Node ID 78044b2f001cb674ad4d37d9d2f667f2693cad9d # Parent 3708884bfa8aa741a6d74012d9c33c5d2a90b2f3 explicit type class operations for type-specific implementations diff -r 3708884bfa8a -r 78044b2f001c NEWS --- a/NEWS Wed May 12 17:05:28 2021 +0000 +++ b/NEWS Wed May 12 17:05:29 2021 +0000 @@ -100,6 +100,9 @@ in separate theory "Transposition" in HOL-Combinatorics. INCOMPATIBILITY. +* Bit operations set_bit, unset_bit and flip_bit are now class +operations. INCOMPATIBILITY. + *** ML *** diff -r 3708884bfa8a -r 78044b2f001c src/HOL/Library/Bit_Operations.thy --- a/src/HOL/Library/Bit_Operations.thy Wed May 12 17:05:28 2021 +0000 +++ b/src/HOL/Library/Bit_Operations.thy Wed May 12 17:05:29 2021 +0000 @@ -16,10 +16,16 @@ and or :: \'a \ 'a \ 'a\ (infixr \OR\ 59) and xor :: \'a \ 'a \ 'a\ (infixr \XOR\ 59) and mask :: \nat \ 'a\ - assumes bit_and_iff [bit_simps]: \\n. bit (a AND b) n \ bit a n \ bit b n\ - and bit_or_iff [bit_simps]: \\n. bit (a OR b) n \ bit a n \ bit b n\ - and bit_xor_iff [bit_simps]: \\n. bit (a XOR b) n \ bit a n \ bit b n\ + and set_bit :: \nat \ 'a \ 'a\ + and unset_bit :: \nat \ 'a \ 'a\ + and flip_bit :: \nat \ 'a \ 'a\ + assumes bit_and_iff [bit_simps]: \bit (a AND b) n \ bit a n \ bit b n\ + and bit_or_iff [bit_simps]: \bit (a OR b) n \ bit a n \ bit b n\ + and bit_xor_iff [bit_simps]: \bit (a XOR b) n \ bit a n \ bit b n\ and mask_eq_exp_minus_1: \mask n = 2 ^ n - 1\ + and set_bit_eq_or: \set_bit n a = a OR push_bit n 1\ + and bit_unset_bit_iff [bit_simps]: \bit (unset_bit m a) n \ bit a n \ m \ n\ + and flip_bit_eq_xor: \flip_bit n a = a XOR push_bit n 1\ begin text \ @@ -182,6 +188,138 @@ apply (simp_all add: bit_exp_iff) done +lemmas set_bit_def = set_bit_eq_or + +lemma bit_set_bit_iff [bit_simps]: + \bit (set_bit m a) n \ bit a n \ (m = n \ 2 ^ n \ 0)\ + by (auto simp add: set_bit_def push_bit_of_1 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 even_unset_bit_iff: + \even (unset_bit m a) \ even a \ m = 0\ + using bit_unset_bit_iff [of m a 0] by auto + +lemmas flip_bit_def = flip_bit_eq_xor + +lemma bit_flip_bit_iff [bit_simps]: + \bit (flip_bit m a) n \ (m = n \ \ bit a n) \ 2 ^ n \ 0\ + by (auto simp add: flip_bit_def push_bit_of_1 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 + +lemma flip_bit_eq_if: + \flip_bit n a = (if bit a n then unset_bit else set_bit) n a\ + by (rule bit_eqI) (auto simp add: bit_set_bit_iff bit_unset_bit_iff bit_flip_bit_iff) + +lemma take_bit_set_bit_eq: + \take_bit n (set_bit m a) = (if n \ m then take_bit n a else set_bit m (take_bit n a))\ + by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_set_bit_iff) + +lemma take_bit_unset_bit_eq: + \take_bit n (unset_bit m a) = (if n \ m then take_bit n a else unset_bit m (take_bit n a))\ + by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_unset_bit_iff) + +lemma take_bit_flip_bit_eq: + \take_bit n (flip_bit m a) = (if n \ m then take_bit n a else flip_bit m (take_bit n a))\ + by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_flip_bit_iff) + + end class ring_bit_operations = semiring_bit_operations + ring_parity + @@ -352,149 +490,11 @@ \take_bit m (NOT (mask n)) = 0\ if \n \ m\ by (rule bit_eqI) (use that in \simp add: bit_take_bit_iff bit_not_iff bit_mask_iff\) -lemma take_bit_mask [simp]: - \take_bit m (mask n) = mask (min m n)\ - by (simp add: mask_eq_take_bit_minus_one) - -definition set_bit :: \nat \ 'a \ 'a\ - where \set_bit n a = a OR push_bit n 1\ - -definition unset_bit :: \nat \ 'a \ 'a\ - where \unset_bit n a = a AND NOT (push_bit n 1)\ - -definition flip_bit :: \nat \ 'a \ 'a\ - where \flip_bit n a = a XOR push_bit n 1\ - -lemma bit_set_bit_iff [bit_simps]: - \bit (set_bit m a) n \ bit a n \ (m = n \ 2 ^ n \ 0)\ - by (auto simp add: set_bit_def push_bit_of_1 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_simps]: - \bit (unset_bit m a) n \ bit a n \ m \ n\ - by (auto simp add: unset_bit_def push_bit_of_1 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_simps]: - \bit (flip_bit m a) n \ (m = n \ \ bit a n) \ 2 ^ n \ 0\ - by (auto simp add: flip_bit_def push_bit_of_1 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_eq_and_not: + \unset_bit n a = a AND NOT (push_bit n 1)\ + by (rule bit_eqI) (auto simp add: bit_simps) -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 - -lemma flip_bit_eq_if: - \flip_bit n a = (if bit a n then unset_bit else set_bit) n a\ - by (rule bit_eqI) (auto simp add: bit_set_bit_iff bit_unset_bit_iff bit_flip_bit_iff) - -lemma take_bit_set_bit_eq: - \take_bit n (set_bit m a) = (if n \ m then take_bit n a else set_bit m (take_bit n a))\ - by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_set_bit_iff) - -lemma take_bit_unset_bit_eq: - \take_bit n (unset_bit m a) = (if n \ m then take_bit n a else unset_bit m (take_bit n a))\ - by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_unset_bit_iff) - -lemma take_bit_flip_bit_eq: - \take_bit n (flip_bit m a) = (if n \ m then take_bit n a else flip_bit m (take_bit n a))\ - by (rule bit_eqI) (auto simp add: bit_take_bit_iff bit_flip_bit_iff) +lemmas unset_bit_def = unset_bit_eq_and_not end @@ -662,8 +662,17 @@ definition mask_int :: \nat \ int\ where \mask n = (2 :: int) ^ n - 1\ +definition set_bit_int :: \nat \ int \ int\ + where \set_bit n k = k OR push_bit n 1\ for k :: int + +definition unset_bit_int :: \nat \ int \ int\ + where \unset_bit n k = k AND NOT (push_bit n 1)\ for k :: int + +definition flip_bit_int :: \nat \ int \ int\ + where \flip_bit n k = k XOR push_bit n 1\ for k :: int + instance proof - fix k l :: int and n :: nat + fix k l :: int and m 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\ @@ -672,7 +681,15 @@ 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 mask_int_def) + show \bit (unset_bit m k) n \ bit k n \ m \ n\ + proof - + have \unset_bit m k = k AND NOT (push_bit m 1)\ + by (simp add: unset_bit_int_def) + also have \NOT (push_bit m 1 :: int) = - (push_bit m 1 + 1)\ + by (simp add: not_int_def) + finally show ?thesis by (simp only: bit_simps bit_and_int_iff) (auto simp add: bit_simps) + qed +qed (simp_all add: bit_not_int_iff mask_int_def set_bit_int_def flip_bit_int_def) end @@ -1592,6 +1609,15 @@ definition mask_nat :: \nat \ nat\ where \mask n = (2 :: nat) ^ n - 1\ +definition set_bit_nat :: \nat \ nat \ nat\ + where \set_bit m n = n OR push_bit m 1\ for m n :: nat + +definition unset_bit_nat :: \nat \ nat \ nat\ + where \unset_bit m n = (if bit n m then n - push_bit m 1 else n)\ for m n :: nat + +definition flip_bit_nat :: \nat \ nat \ nat\ + where \flip_bit m n = n XOR push_bit m 1\ for m n :: nat + instance proof fix m n q :: nat show \bit (m AND n) q \ bit m q \ bit n q\ @@ -1600,7 +1626,26 @@ by (simp add: or_nat_def bit_simps) show \bit (m XOR n) q \ bit m q \ bit n q\ by (simp add: xor_nat_def bit_simps) -qed (simp add: mask_nat_def) + show \bit (unset_bit m n) q \ bit n q \ m \ q\ + proof (cases \bit n m\) + case False + then show ?thesis by (auto simp add: unset_bit_nat_def) + next + case True + have \push_bit m (drop_bit m n) + take_bit m n = n\ + by (fact bits_ident) + also from \bit n m\ have \drop_bit m n = 2 * drop_bit (Suc m) n + 1\ + by (simp add: drop_bit_Suc drop_bit_half even_drop_bit_iff_not_bit ac_simps) + finally have \push_bit m (2 * drop_bit (Suc m) n) + take_bit m n + push_bit m 1 = n\ + by (simp only: push_bit_add ac_simps) + then have \n - push_bit m 1 = push_bit m (2 * drop_bit (Suc m) n) + take_bit m n\ + by simp + then have \n - push_bit m 1 = push_bit m (2 * drop_bit (Suc m) n) OR take_bit m n\ + by (simp add: or_nat_def bit_simps flip: disjunctive_add) + with \bit n m\ show ?thesis + by (auto simp add: unset_bit_nat_def or_nat_def bit_simps) + qed +qed (simp_all add: mask_nat_def set_bit_nat_def flip_bit_nat_def) end @@ -1714,9 +1759,19 @@ lift_definition mask_integer :: \nat \ integer\ is mask . +lift_definition set_bit_integer :: \nat \ integer \ integer\ + is set_bit . + +lift_definition unset_bit_integer :: \nat \ integer \ integer\ + is unset_bit . + +lift_definition flip_bit_integer :: \nat \ integer \ integer\ + is flip_bit . + instance by (standard; transfer) (simp_all add: minus_eq_not_minus_1 mask_eq_exp_minus_1 - bit_not_iff bit_and_iff bit_or_iff bit_xor_iff) + bit_not_iff bit_and_iff bit_or_iff bit_xor_iff + set_bit_def bit_unset_bit_iff flip_bit_def) end @@ -1739,8 +1794,19 @@ lift_definition mask_natural :: \nat \ natural\ is mask . +lift_definition set_bit_natural :: \nat \ natural \ natural\ + is set_bit . + +lift_definition unset_bit_natural :: \nat \ natural \ natural\ + is unset_bit . + +lift_definition flip_bit_natural :: \nat \ natural \ natural\ + is flip_bit . + instance by (standard; transfer) - (simp_all add: mask_eq_exp_minus_1 bit_and_iff bit_or_iff bit_xor_iff) + (simp_all add: mask_eq_exp_minus_1 + bit_and_iff bit_or_iff bit_xor_iff + set_bit_def bit_unset_bit_iff flip_bit_def) end diff -r 3708884bfa8a -r 78044b2f001c src/HOL/Library/Word.thy --- a/src/HOL/Library/Word.thy Wed May 12 17:05:28 2021 +0000 +++ b/src/HOL/Library/Word.thy Wed May 12 17:05:29 2021 +0000 @@ -996,9 +996,21 @@ is mask . +lift_definition set_bit_word :: \nat \ 'a word \ 'a word\ + is set_bit + by (simp add: set_bit_def) + +lift_definition unset_bit_word :: \nat \ 'a word \ 'a word\ + is unset_bit + by (simp add: unset_bit_def) + +lift_definition flip_bit_word :: \nat \ 'a word \ 'a word\ + is flip_bit + by (simp add: flip_bit_def) + instance by (standard; transfer) (auto simp add: minus_eq_not_minus_1 mask_eq_exp_minus_1 - bit_not_iff bit_and_iff bit_or_iff bit_xor_iff) + bit_simps set_bit_def flip_bit_def) end @@ -1027,6 +1039,18 @@ \Word.the_int (mask n :: 'a::len word) = mask (min LENGTH('a) n)\ by transfer simp +lemma [code]: + \set_bit n w = w OR push_bit n 1\ for w :: \'a::len word\ + by (fact set_bit_eq_or) + +lemma [code]: + \unset_bit n w = w AND NOT (push_bit n 1)\ for w :: \'a::len word\ + by (fact unset_bit_eq_and_not) + +lemma [code]: + \flip_bit n w = w XOR push_bit n 1\ for w :: \'a::len word\ + by (fact flip_bit_eq_xor) + context includes lifting_syntax begin diff -r 3708884bfa8a -r 78044b2f001c src/HOL/Library/Z2.thy --- a/src/HOL/Library/Z2.thy Wed May 12 17:05:28 2021 +0000 +++ b/src/HOL/Library/Z2.thy Wed May 12 17:05:29 2021 +0000 @@ -188,7 +188,16 @@ where [simp]: \b XOR c = of_bool (odd b \ odd c)\ for b c :: bit definition mask_bit :: \nat \ bit\ - where [simp]: \mask_bit n = of_bool (n > 0)\ + where [simp]: \mask n = (of_bool (n > 0) :: bit)\ + +definition set_bit_bit :: \nat \ bit \ bit\ + where [simp]: \set_bit n b = of_bool (n = 0 \ odd b)\ for b :: bit + +definition unset_bit_bit :: \nat \ bit \ bit\ + where [simp]: \unset_bit n b = of_bool (n > 0 \ odd b)\ for b :: bit + +definition flip_bit_bit :: \nat \ bit \ bit\ + where [simp]: \flip_bit n b = of_bool ((n = 0) \ odd b)\ for b :: bit instance by standard auto