# HG changeset patch # User haftmann # Date 1605435183 0 # Node ID c7bc3e70a8c77dc7773140b2161b8a0bb2582898 # Parent 00fce84413db8bd806976832638771d571156106 official collection for bit projection simplifications diff -r 00fce84413db -r c7bc3e70a8c7 src/HOL/Library/Bit_Operations.thy --- a/src/HOL/Library/Bit_Operations.thy Sun Nov 15 13:08:13 2020 +0000 +++ b/src/HOL/Library/Bit_Operations.thy Sun Nov 15 10:13:03 2020 +0000 @@ -16,9 +16,9 @@ and or :: \'a \ 'a \ 'a\ (infixr \OR\ 59) and xor :: \'a \ 'a \ 'a\ (infixr \XOR\ 59) and mask :: \nat \ 'a\ - 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\ + 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 mask_eq_exp_minus_1: \mask n = 2 ^ n - 1\ begin @@ -119,7 +119,7 @@ \drop_bit n (a XOR b) = drop_bit n a XOR drop_bit n b\ by (rule bit_eqI) (auto simp add: bit_drop_bit_eq bit_xor_iff) -lemma bit_mask_iff: +lemma bit_mask_iff [bit_simps]: \bit (mask m) n \ 2 ^ n \ 0 \ n < m\ by (simp add: mask_eq_exp_minus_1 bit_mask_iff) @@ -182,7 +182,7 @@ 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 bit_not_iff [bit_simps]: \\n. bit (NOT a) n \ 2 ^ n \ 0 \ \ bit a n\ assumes minus_eq_not_minus_1: \- a = NOT (a - 1)\ begin @@ -205,7 +205,7 @@ \- a = NOT a + 1\ using not_eq_complement [of a] by simp -lemma bit_minus_iff: +lemma bit_minus_iff [bit_simps]: \bit (- a) n \ 2 ^ n \ 0 \ \ bit (a - 1) n\ by (simp add: minus_eq_not_minus_1 bit_not_iff) @@ -213,7 +213,7 @@ "even (NOT a) \ odd a" using bit_not_iff [of a 0] by auto -lemma bit_not_exp_iff: +lemma bit_not_exp_iff [bit_simps]: \bit (NOT (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ by (auto simp add: bit_not_iff bit_exp_iff) @@ -221,9 +221,9 @@ \bit (- 1) n \ 2 ^ n \ 0\ by (simp add: bit_minus_iff) -lemma bit_minus_exp_iff: +lemma bit_minus_exp_iff [bit_simps]: \bit (- (2 ^ m)) n \ 2 ^ n \ 0 \ n \ m\ - oops + by (auto simp add: bit_simps simp flip: mask_eq_exp_minus_1) lemma bit_minus_2_iff [simp]: \bit (- 2) n \ 2 ^ n \ 0 \ n > 0\ @@ -361,7 +361,7 @@ definition flip_bit :: \nat \ 'a \ 'a\ where \flip_bit n a = a XOR push_bit n 1\ -lemma bit_set_bit_iff: +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) @@ -369,7 +369,7 @@ \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: +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) @@ -377,7 +377,7 @@ \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: +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) @@ -583,7 +583,7 @@ \NOT k div 2 = NOT (k div 2)\ for k :: int by (simp add: not_int_def) -lemma bit_not_int_iff: +lemma bit_not_int_iff [bit_simps]: \bit (NOT k) n \ \ bit k n\ for k :: int by (simp add: bit_not_int_iff' not_int_def) @@ -973,7 +973,7 @@ \even (of_int k) \ even k\ by (induction k rule: int_bit_induct) simp_all -lemma bit_of_int_iff: +lemma bit_of_int_iff [bit_simps]: \bit (of_int k) n \ (2::'a) ^ n \ 0 \ bit k n\ proof (cases \(2::'a) ^ n = 0\) case True @@ -1157,7 +1157,7 @@ definition concat_bit :: \nat \ int \ int \ int\ where \concat_bit n k l = take_bit n k OR push_bit n l\ -lemma bit_concat_bit_iff: +lemma bit_concat_bit_iff [bit_simps]: \bit (concat_bit m k l) n \ n < m \ bit k n \ m \ n \ bit l (n - m)\ by (simp add: concat_bit_def bit_or_iff bit_and_iff bit_take_bit_iff bit_push_bit_iff ac_simps) @@ -1259,7 +1259,7 @@ \even (signed_take_bit m a) \ even a\ by (auto simp add: signed_take_bit_def even_or_iff even_mask_iff bit_double_iff) -lemma bit_signed_take_bit_iff: +lemma bit_signed_take_bit_iff [bit_simps]: \bit (signed_take_bit m a) n \ 2 ^ n \ 0 \ bit a (min m n)\ by (simp add: signed_take_bit_def bit_take_bit_iff bit_or_iff bit_not_iff bit_mask_iff min_def not_le) (use exp_eq_0_imp_not_bit in blast) @@ -1560,11 +1560,11 @@ instance proof fix m n q :: nat show \bit (m AND n) q \ bit m q \ bit n q\ - by (auto simp add: bit_nat_iff and_nat_def bit_and_iff less_le bit_eq_iff) + by (simp add: and_nat_def bit_simps) show \bit (m OR n) q \ bit m q \ bit n q\ - by (auto simp add: bit_nat_iff or_nat_def bit_or_iff less_le bit_eq_iff) + by (simp add: or_nat_def bit_simps) show \bit (m XOR n) q \ bit m q \ bit n q\ - by (auto simp add: bit_nat_iff xor_nat_def bit_xor_iff less_le bit_eq_iff) + by (simp add: xor_nat_def bit_simps) qed (simp add: mask_nat_def) end diff -r 00fce84413db -r c7bc3e70a8c7 src/HOL/Library/Word.thy --- a/src/HOL/Library/Word.thy Sun Nov 15 13:08:13 2020 +0000 +++ b/src/HOL/Library/Word.thy Sun Nov 15 10:13:03 2020 +0000 @@ -1065,7 +1065,7 @@ context semiring_bits begin -lemma bit_unsigned_iff: +lemma bit_unsigned_iff [bit_simps]: \bit (unsigned w) n \ 2 ^ n \ 0 \ bit w n\ for w :: \'b::len word\ by (transfer fixing: bit) (simp add: bit_of_nat_iff bit_nat_iff bit_take_bit_iff) @@ -1175,7 +1175,7 @@ context ring_bit_operations begin -lemma bit_signed_iff: +lemma bit_signed_iff [bit_simps]: \bit (signed w) n \ 2 ^ n \ 0 \ bit w (min (LENGTH('b) - Suc 0) n)\ for w :: \'b::len word\ by (transfer fixing: bit) @@ -1779,10 +1779,10 @@ \shiftl1 = (*) 2\ by (rule ext, transfer) simp -lemma bit_shiftl1_iff: +lemma bit_shiftl1_iff [bit_simps]: \bit (shiftl1 w) n \ 0 < n \ n < LENGTH('a) \ bit w (n - 1)\ for w :: \'a::len word\ - by (simp add: shiftl1_eq_mult_2 bit_double_iff exp_eq_zero_iff not_le) (simp add: ac_simps) + by (simp add: shiftl1_eq_mult_2 bit_double_iff not_le) (simp add: ac_simps) lift_definition shiftr1 :: \'a::len word \ 'a word\ \ \shift right as unsigned or as signed, ie logical or arithmetic\ @@ -1793,7 +1793,7 @@ \shiftr1 w = w div 2\ by transfer simp -lemma bit_shiftr1_iff: +lemma bit_shiftr1_iff [bit_simps]: \bit (shiftr1 w) n \ bit w (Suc n)\ by transfer (auto simp flip: bit_Suc simp add: bit_take_bit_iff) @@ -1820,7 +1820,7 @@ \setBit w n = set_bit n w\ by transfer simp -lemma bit_setBit_iff: +lemma bit_setBit_iff [bit_simps]: \bit (setBit w m) n \ (m = n \ n < LENGTH('a) \ bit w n)\ for w :: \'a::len word\ by transfer (auto simp add: bit_set_bit_iff) @@ -1833,7 +1833,7 @@ \clearBit w n = unset_bit n w\ by transfer simp -lemma bit_clearBit_iff: +lemma bit_clearBit_iff [bit_simps]: \bit (clearBit w m) n \ m \ n \ bit w n\ for w :: \'a::len word\ by transfer (auto simp add: bit_unset_bit_iff) @@ -1913,7 +1913,7 @@ using signed_take_bit_decr_length_iff by (simp add: take_bit_drop_bit) force -lemma bit_signed_drop_bit_iff: +lemma bit_signed_drop_bit_iff [bit_simps]: \bit (signed_drop_bit m w) n \ bit w (if LENGTH('a) - m \ n \ n < LENGTH('a) then LENGTH('a) - 1 else m + n)\ for w :: \'a::len word\ apply transfer @@ -2025,7 +2025,7 @@ by simp qed -lemma bit_word_rotr_iff: +lemma bit_word_rotr_iff [bit_simps]: \bit (word_rotr m w) n \ n < LENGTH('a) \ bit w ((n + m) mod LENGTH('a))\ for w :: \'a::len word\ @@ -2057,13 +2057,13 @@ by simp qed -lemma bit_word_rotl_iff: +lemma bit_word_rotl_iff [bit_simps]: \bit (word_rotl m w) n \ n < LENGTH('a) \ bit w ((n + (LENGTH('a) - m mod LENGTH('a))) mod LENGTH('a))\ for w :: \'a::len word\ by (simp add: word_rotl_eq_word_rotr bit_word_rotr_iff) -lemma bit_word_roti_iff: +lemma bit_word_roti_iff [bit_simps]: \bit (word_roti k w) n \ n < LENGTH('a) \ bit w (nat ((int n + k) mod int LENGTH('a)))\ for w :: \'a::len word\ @@ -2130,7 +2130,7 @@ for a :: \'a::len word\ and b :: \'b::len word\ by transfer (simp add: concat_bit_take_bit_eq) -lemma bit_word_cat_iff: +lemma bit_word_cat_iff [bit_simps]: \bit (word_cat v w :: 'c::len word) n \ n < LENGTH('c) \ (if n < LENGTH('b) then bit w n else bit v (n - LENGTH('b)))\ for v :: \'a::len word\ and w :: \'b::len word\ by transfer (simp add: bit_concat_bit_iff bit_take_bit_iff) @@ -3623,7 +3623,7 @@ lemmas word_and_le1 = xtrans(3) [OF word_ao_absorbs (4) [symmetric] le_word_or2] lemmas word_and_le2 = xtrans(3) [OF word_ao_absorbs (8) [symmetric] le_word_or2] -lemma bit_horner_sum_bit_word_iff: +lemma bit_horner_sum_bit_word_iff [bit_simps]: \bit (horner_sum of_bool (2 :: 'a::len word) bs) n \ n < min LENGTH('a) (length bs) \ bs ! n\ by transfer (simp add: bit_horner_sum_bit_iff) @@ -3631,7 +3631,7 @@ definition word_reverse :: \'a::len word \ 'a word\ where \word_reverse w = horner_sum of_bool 2 (rev (map (bit w) [0.. -lemma bit_word_reverse_iff: +lemma bit_word_reverse_iff [bit_simps]: \bit (word_reverse w) n \ n < LENGTH('a) \ bit w (LENGTH('a) - Suc n)\ for w :: \'a::len word\ by (cases \n < LENGTH('a)\) @@ -3698,7 +3698,7 @@ apply (simp add: drop_bit_take_bit min_def) done -lemma bit_sshiftr1_iff: +lemma bit_sshiftr1_iff [bit_simps]: \bit (sshiftr1 w) n \ bit w (if n = LENGTH('a) - 1 then LENGTH('a) - 1 else Suc n)\ for w :: \'a::len word\ apply transfer @@ -3714,7 +3714,7 @@ using sint_signed_drop_bit_eq [of 1 w] by (simp add: drop_bit_Suc sshiftr1_eq_signed_drop_bit_Suc_0) -lemma bit_bshiftr1_iff: +lemma bit_bshiftr1_iff [bit_simps]: \bit (bshiftr1 b w) n \ b \ n = LENGTH('a) - 1 \ bit w (Suc n)\ for w :: \'a::len word\ apply transfer @@ -3813,7 +3813,7 @@ context begin -qualified lemma bit_mask_iff: +qualified lemma bit_mask_iff [bit_simps]: \bit (mask m :: 'a::len word) n \ n < min LENGTH('a) m\ by (simp add: bit_mask_iff exp_eq_zero_iff not_le) @@ -3945,7 +3945,7 @@ then ucast (drop_bit (LENGTH('a) - n) w) else push_bit (n - LENGTH('a)) (ucast w))\ -lemma bit_slice1_iff: +lemma bit_slice1_iff [bit_simps]: \bit (slice1 m w :: 'b::len word) n \ m - LENGTH('a) \ n \ n < min LENGTH('b) m \ bit w (n + (LENGTH('a) - m) - (m - LENGTH('a)))\ for w :: \'a::len word\ @@ -3955,7 +3955,7 @@ definition slice :: \nat \ 'a::len word \ 'b::len word\ where \slice n = slice1 (LENGTH('a) - n)\ -lemma bit_slice_iff: +lemma bit_slice_iff [bit_simps]: \bit (slice m w :: 'b::len word) n \ n < min LENGTH('b) (LENGTH('a) - m) \ bit w (n + LENGTH('a) - (LENGTH('a) - m))\ for w :: \'a::len word\ by (simp add: slice_def word_size bit_slice1_iff) @@ -4008,7 +4008,7 @@ definition revcast :: \'a::len word \ 'b::len word\ where \revcast = slice1 LENGTH('b)\ -lemma bit_revcast_iff: +lemma bit_revcast_iff [bit_simps]: \bit (revcast w :: 'b::len word) n \ LENGTH('b) - LENGTH('a) \ n \ n < LENGTH('b) \ bit w (n + (LENGTH('a) - LENGTH('b)) - (LENGTH('b) - LENGTH('a)))\ for w :: \'a::len word\ diff -r 00fce84413db -r c7bc3e70a8c7 src/HOL/Parity.thy --- a/src/HOL/Parity.thy Sun Nov 15 13:08:13 2020 +0000 +++ b/src/HOL/Parity.thy Sun Nov 15 10:13:03 2020 +0000 @@ -906,15 +906,17 @@ \a = b \ (\n. bit a n \ bit b n)\ by (auto intro: bit_eqI) -lemma bit_exp_iff: +named_theorems bit_simps \Simplification rules for \<^const>\bit\\ + +lemma bit_exp_iff [bit_simps]: \bit (2 ^ m) n \ 2 ^ m \ 0 \ m = n\ by (auto simp add: bit_iff_odd exp_div_exp_eq) -lemma bit_1_iff: +lemma bit_1_iff [bit_simps]: \bit 1 n \ 1 \ 0 \ n = 0\ using bit_exp_iff [of 0 n] by simp -lemma bit_2_iff: +lemma bit_2_iff [bit_simps]: \bit 2 n \ 2 \ 0 \ n = 1\ using bit_exp_iff [of 1 n] by auto @@ -931,7 +933,7 @@ ultimately show ?thesis by (simp add: ac_simps) qed -lemma bit_double_iff: +lemma bit_double_iff [bit_simps]: \bit (2 * a) n \ bit a (n - 1) \ n \ 0 \ 2 ^ n \ 0\ using even_mult_exp_div_exp_iff [of a 1 n] by (cases n, auto simp add: bit_iff_odd ac_simps) @@ -1193,7 +1195,7 @@ context semiring_bits begin -lemma bit_of_bool_iff: +lemma bit_of_bool_iff [bit_simps]: \bit (of_bool b) n \ b \ n = 0\ by (simp add: bit_1_iff) @@ -1201,7 +1203,7 @@ \even (of_nat n) \ even n\ by (induction n rule: nat_bit_induct) simp_all -lemma bit_of_nat_iff: +lemma bit_of_nat_iff [bit_simps]: \bit (of_nat m) n \ (2::'a) ^ n \ 0 \ bit m n\ proof (cases \(2::'a) ^ n = 0\) case True @@ -1492,15 +1494,15 @@ \even (push_bit n a) \ n \ 0 \ even a\ by (simp add: push_bit_eq_mult) auto -lemma bit_push_bit_iff: +lemma bit_push_bit_iff [bit_simps]: \bit (push_bit m a) n \ m \ n \ 2 ^ n \ 0 \ bit a (n - m)\ by (auto simp add: bit_iff_odd push_bit_eq_mult even_mult_exp_div_exp_iff) -lemma bit_drop_bit_eq: +lemma bit_drop_bit_eq [bit_simps]: \bit (drop_bit n a) = bit a \ (+) n\ by (simp add: bit_iff_odd fun_eq_iff ac_simps flip: drop_bit_eq_div) -lemma bit_take_bit_iff: +lemma bit_take_bit_iff [bit_simps]: \bit (take_bit m a) n \ n < m \ bit a n\ by (simp add: bit_iff_odd drop_bit_take_bit not_le flip: drop_bit_eq_div) @@ -1763,7 +1765,7 @@ "drop_bit n (of_nat m) = of_nat (drop_bit n m)" by (simp add: drop_bit_eq_div Parity.drop_bit_eq_div of_nat_div [of m "2 ^ n"]) -lemma bit_of_nat_iff_bit [simp]: +lemma bit_of_nat_iff_bit [bit_simps]: \bit (of_nat m) n \ bit m n\ proof - have \even (m div 2 ^ n) \ even (of_nat (m div 2 ^ n))\ @@ -1778,7 +1780,7 @@ \of_nat (drop_bit m n) = drop_bit m (of_nat n)\ by (simp add: drop_bit_eq_div semiring_bit_shifts_class.drop_bit_eq_div of_nat_div) -lemma bit_push_bit_iff_of_nat_iff: +lemma bit_push_bit_iff_of_nat_iff [bit_simps]: \bit (push_bit m (of_nat r)) n \ m \ n \ bit (of_nat r) (n - m)\ by (auto simp add: bit_push_bit_iff) @@ -1826,12 +1828,12 @@ by (simp add: bit_Suc) qed -lemma bit_minus_int_iff: +lemma bit_minus_int_iff [bit_simps]: \bit (- k) n \ \ bit (k - 1) n\ for k :: int using bit_not_int_iff' [of \k - 1\] by simp -lemma bit_nat_iff: +lemma bit_nat_iff [bit_simps]: \bit (nat k) n \ k \ 0 \ bit k n\ proof (cases \k \ 0\) case True @@ -1839,7 +1841,7 @@ ultimately have \k = int m\ by simp then show ?thesis - by (auto intro: ccontr) + by (simp add: bit_simps) next case False then show ?thesis diff -r 00fce84413db -r c7bc3e70a8c7 src/HOL/String.thy --- a/src/HOL/String.thy Sun Nov 15 13:08:13 2020 +0000 +++ b/src/HOL/String.thy Sun Nov 15 10:13:03 2020 +0000 @@ -121,7 +121,7 @@ lemma char_of_nat [simp]: \char_of (of_nat n) = char_of n\ - by (simp add: char_of_def String.char_of_def drop_bit_of_nat) + by (simp add: char_of_def String.char_of_def drop_bit_of_nat bit_simps) end